File Coverage

blib/lib/App/NoPAN.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package App::NoPAN;

use strict;
use warnings;

use base qw(Class::Accessor::Fast);
use Cwd;
use File::Temp qw(tempdir);
use HTML::LinkExtor;
use List::Util qw(first);
use LWP::Simple ();
use Scope::Guard;
use URI::Escape qw/uri_unescape/;

# FIXME find and automatically load NoPAN::Installer::*.pm
require App::NoPAN::Installer::Perl;
require App::NoPAN::Installer::Configure;
require App::NoPAN::Installer::Makefile; # should better be the last

our %Defaults = (
    opt_install => 1,
    opt_test    => undef, # tristate: 0:no, 1:yes, undef:default
);
my @Installers;

__PACKAGE__->mk_accessors(keys %Defaults);

sub new {
    my ($klass, %opts) = @_;
    bless {
        %Defaults,
        %opts,
    }, $klass;
}

sub run {
    my ($self, $url) = @_;

    die "invalid URL:$url"
        unless $url =~ m{^[a-z]+://};

    $url .= '/'
        unless $url =~ m|/$|;
    warn "downloading files from URL:$url\n";
    my @root_files = $self->files_from_dir($url);

    my $installer_class =
            first { $_->can_install($self, \@root_files) } @Installers;
    die "do not know how to install:$url" unless $installer_class;

    my $workdir = tempdir(CLEANUP => 1);
    $self->fetch_all($url, $workdir, '', \@root_files);

    {
        my $pwd = getcwd;
        my $popdir = Scope::Guard->new(sub { chdir $pwd });
        chdir $workdir
            or die "failed to change directory to:$workdir:$!";
        my $installer = $installer_class->new(
            url        =>  $url,
            root_files => \@root_files,
        );
        $installer->build($self);
        $installer->test($self);
        $installer->install($self)
            if $self->opt_install;
    }
}

sub fetch_all {
    my ($self, $base_url, $dir, $subdir, $files, $fetched) = @_;
    $fetched ||= {};
    for my $f (@$files) {
        if ($f =~ m|/$|) {
            my $d = $`;
            mkdir "$dir/$subdir$d"
                or die "failed to create dir:$dir/$subdir$d:$!";
            $self->fetch_all(
                $base_url,
                $dir,
                "$subdir$f",
                [ $self->files_from_dir("$base_url$subdir$f") ],
                $fetched,
            );
        } elsif (! $fetched->{"$subdir$f"}) {
            print "$subdir$f\n";
            my $r = LWP::Simple::mirror("$base_url$subdir$f", "$dir/$subdir$f");
            die "failed to fetch URL:$base_url$subdir$f, got $r"
                unless $r == 200;
            chmod 0755, "$dir/$subdir$f"
                or die "failed to set chmod +x on file:$dir/$subdir/$f:$!";
            $fetched->{"$subdir$f"} = 1;
        }
    }
}

sub files_from_dir {
    my ($self, $url) = @_;

    my $body = LWP::Simple::get($url)
        or die "failed to fetch URL:$url";
    return grep {
        $_ !~ m{^(\.{1,2}|)$},
    } map {
        substr($_, 0, length $url) eq $url ? (substr $_, length $url) : ()
    } map {
        my ($tag, %attr) = @$_;
        $tag eq 'a' && $attr{href} ? (uri_unescape $attr{href}) : ();
    } do {
        my $lx = HTML::LinkExtor->new(undef, $url);
        $lx->parse($body);
        $lx->links;
    };
}

sub register {
    my ($klass, $installer) = @_;
    push @Installers, $installer;
}

1;