view release on metacpan or  search on metacpan

lib/App/NoPAN.pm  view on Meta::CPAN

    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;