view release on metacpan or  search on metacpan

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

package App::CPAN::Fresh;

use strict;
use 5.008_001;
our $VERSION = '0.12';

use base qw(App::Cmd::Simple);

use Carp;
use Time::Piece;
use File::Temp;
use JSON;
use LWP::UserAgent;
use URI;

my $duration = 2 * 24 * 60 * 60;

sub opt_spec {
    return (
        [ "install|i", "install the module" ],
        [ "list|l", "list the recent uploads" ],
        [ "test|t", "test the dist" ],
        [ "force|f", "force install" ],
        [ "devel|d", "install even if it's a devel release" ],
        [ "minus|m", "use cpanminus" ],
        [ "help|h", "displays usage info" ],
    );
}

sub execute {
    my($self, $opt, $args) = @_;

    if ($opt->{list} && $args->[0]) {
        $self->search($args->[0]);
    } elsif ($opt->{list}) {
        $self->recent;
    } elsif ($opt->{help} || !@$args) {
        $self->usage;
    } else {
        $self->handle($opt, $args);
    }
}

sub recent {
    my $self = shift;
    my $res = $self->call("/feed/cpan");
    $self->display_results($res);
}

sub search {
    my($self, $q) = @_;
    my $res = $self->call("/search", { q => "$q group:cpan" });
    $self->display_results($res);
}

sub usage {
    require Pod::Usage;
    Pod::Usage::pod2usage(0);
}

sub handle {
    my($self, $opt, $dists) = @_;

    my @install;
    for my $dist (@$dists) {
        my $path = $self->inject($dist, $opt);
        if ($path) {
            push @install, $path;
        } else {
            print "$dist is not found or not in the fresh uploads. Falling back to your mirror.\n";
            push @install, $dist;
        }
    }

    my $method = "install";
    $method = "test" if $opt->{test};

    if (@install) {
        if ($opt->{minus}) {
            system "cpanm", ($opt->{force} ? "-f" : ()), @install;
        } else {
            require CPAN;
            if ($opt->{force}) {
                CPAN::Shell->force($method, @install);
            } else {
                CPAN::Shell->$method(@install);
            }
        }
    }
}

sub inject {
    my($self, $dist, $opt) = @_;
    $dist =~ s/::/-/g;

    for my $method ([ "/feed/cpan" ], [ "/search", { q => "$dist group:cpan" } ]) {
        my $res = $self->call($method->[0], $method->[1]);
        for my $entry (@{$res->{entries}}) {
            my $info = $self->parse_entry($entry->{body}, $entry->{date}) or next;
            if ($info->{dist} eq $dist) {
                if ($info->{version} =~ /_|-TRIAL/ && !$opt->{devel}) {
                    warn "$info->{dist}-$info->{version} found: No -d option, skipping\n";
                    return;
                }
                return $self->do_inject($info, $opt);
            }
        }
    }

    return;
}

sub do_inject {
    my($self, $info, $opt) = @_;

    if ($opt->{minus}) {
        return $info->{url};
    }

    my $dir = File::Temp::tempdir(CLEANUP => 1);
    my $local = "$dir/$info->{dist}-$info->{version}.tar.gz";

    print "Fetching $info->{url}\n";
    my $res = $self->new_ua->mirror($info->{url}, $local);
    if ($res->is_error) {
        croak "Fetching $info->{url} failed: ", $res->status_line;
    }

    require CPAN::Inject;
    CPAN::Inject->from_cpan_config->add(file => $local);