App-cpantimes
view release on metacpan or search on metacpan
1.501900 2012-01-02
- based on cpanminus 1.5019
1.501901 2012-01-07
- check availability of LWP::Protocol::https (RT#82505)
1.502100 2012-01-31
- based on cpanminus 1.5021
1.502101 2012-01-31
- mention cpanm's new "--verify" option in help output
- fix fatpacking
skip_satisfied => 0,
auto_cleanup => 7, # days
pod2man => 1,
installed_dists => 0,
showdeps => 0,
scandeps => 0,
scandeps_tree => [],
format => 'tree',
save_dists => undef,
skip_configure => 0,
verify => 0,
@_,
}, $class;
}
sub env {
my($self, $key) = @_;
$ENV{"PERL_CPANM_" . $key};
}
sub parse_options {
push @ARGV, split /\s+/, $self->env('OPT');
push @ARGV, @_;
Getopt::Long::Configure("bundling");
Getopt::Long::GetOptions(
'f|force' => sub { $self->{skip_installed} = 0; $self->{force} = 1 },
'n|notest!' => \$self->{notest},
'test-only' => sub { $self->{notest} = 0; $self->{skip_installed} = 0; $self->{test_only} = 1 },
'S|sudo!' => \$self->{sudo},
'v|verbose' => sub { $self->{verbose} = $self->{interactive} = 1 },
'verify!' => \$self->{verify},
'q|quiet!' => \$self->{quiet},
'h|help' => sub { $self->{action} = 'show_help' },
'V|version' => sub { $self->{action} = 'show_version' },
'perl=s' => \$self->{perl},
'l|local-lib=s' => sub { $self->{local_lib} = $self->maybe_abs($_[1]) },
'L|local-lib-contained=s' => sub {
$self->{local_lib} = $self->maybe_abs($_[1]);
$self->{self_contained} = 1;
$self->{pod2man} = undef;
},
return if $self->{_checked}++;
$self->bootstrap_local_lib;
if (@{$self->{bootstrap_deps} || []}) {
local $self->{notest} = 1; # test failure in bootstrap should be tolerated
local $self->{scandeps} = 0;
$self->install_deps(Cwd::cwd, 0, @{$self->{bootstrap_deps}});
}
}
sub setup_verify {
my $self = shift;
my $has_modules = eval { require Module::Signature; require Digest::SHA; 1 };
$self->{cpansign} = $self->which('cpansign');
unless ($has_modules && $self->{cpansign}) {
warn "WARNING: Module::Signature and Digest::SHA is required for distribution verifications.\n";
$self->{verify} = 0;
}
}
sub doit {
my $self = shift;
$self->setup_home;
$self->init_tools;
$self->setup_verify if $self->{verify};
if (my $action = $self->{action}) {
$self->$action() and return 1;
}
$self->show_help(1)
unless @{$self->{argv}} or $self->{load_from_stdin};
$self->configure_mirrors;
File::Copy::copy($file, $path) or warn $!;
}
return $dist, $dir;
}
}
sub unpack {
my($self, $file, $uri, $dist) = @_;
if ($self->{verify}) {
$self->verify_archive($file, $uri, $dist) or return;
}
$self->chat("Unpacking $file\n");
my $dir = $file =~ /\.zip/i ? $self->unzip($file) : $self->untar($file);
unless ($dir) {
$self->diag_fail("Failed to unpack $file: no directory");
}
return $dir;
}
sub verify_checksums_signature {
my($self, $chk_file) = @_;
require Module::Signature;
$self->chat("Verifying the signature of CHECKSUMS\n");
my $rv = eval {
local $SIG{__WARN__} = sub {}; # suppress warnings
my $v = Module::Signature::_verify($chk_file);
$v == Module::Signature::SIGNATURE_OK();
};
if ($rv) {
$self->chat("Verified OK!\n");
} else {
$self->diag_fail("Verifying CHECKSUMS signature failed: $rv\n");
return;
}
return 1;
}
sub verify_archive {
my($self, $file, $uri, $dist) = @_;
unless ($dist->{cpanid}) {
$self->chat("Archive '$file' does not seem to be from PAUSE. Skip verification.\n");
}
(my $mirror = $uri) =~ s!/authors/id.*$!!;
(my $chksum_uri = $uri) =~ s!/[^/]*$!/CHECKSUMS!;
my $chk_file = $self->source_for($mirror) . "/$dist->{cpanid}.CHECKSUMS";
$self->diag_progress("Fetching $chksum_uri");
$self->mirror($chksum_uri, $chk_file);
unless (-e $chk_file) {
$self->diag_fail("Fetching $chksum_uri failed.\n");
return;
}
$self->diag_ok;
$self->verify_checksums_signature($chk_file) or return;
$self->verify_checksum($file, $chk_file);
}
sub verify_checksum {
my($self, $file, $chk_file) = @_;
$self->chat("Verifying the SHA1 for $file\n");
open my $fh, "<$chk_file" or die "$chk_file: $!";
my $data = join '', <$fh>;
$data =~ s/\015?\012/\n/g;
require Safe;
my $chksum = Safe->new->reval($data);
open my $fh, "<", $file or die "$file: $!";
my $dg = Digest::SHA->new(256);
my($data);
while (read($fh, $data, 4096)) {
$dg->add($data);
}
return $dg->hexdigest;
}
sub verify_signature {
my($self, $dist) = @_;
$self->diag_progress("Verifying the SIGNATURE file");
my $out = `$self->{cpansign} -v --skip 2>&1`;
$self->log($out);
if ($out =~ /Signature verified OK/) {
$self->diag_ok("Verified OK");
return 1;
} else {
return;
}
}
return 1;
}
sub build_stuff {
my($self, $stuff, $dist, $depth) = @_;
if ($self->{verify} && -e 'SIGNATURE') {
$self->verify_signature($dist) or return;
}
my @config_deps;
if (!%{$dist->{meta} || {}} && -e 'META.yml') {
$self->chat("Checking configure dependencies from META.yml\n");
$dist->{meta} = $self->parse_meta('META.yml');
}
if (!$dist->{meta} && $dist->{source} eq 'cpan') {
$self->chat("META.yml not found or unparsable. Fetching META.yml from search.cpan.org\n");
--test-only Run tests only, do not install
-S,--sudo sudo to run install commands
--installdeps Only install dependencies
--showdeps Only display direct dependencies
--reinstall Reinstall the distribution even if you already have the latest version installed
--mirror Specify the base URL for the mirror (e.g. http://cpan.cpantesters.org/)
--mirror-only Use the mirror's index file instead of the CPAN Meta DB
--prompt Prompt when configure/build/test fails
-l,--local-lib Specify the install base to install modules
-L,--local-lib-contained Specify the install base to install all non-core modules
--verify Verify the integrity of distribution files. Defaults to false
--auto-cleanup Number of days that cpant's work directories expire in. Defaults to 7
Commands:
--self-upgrade upgrades itself
--info Displays distribution info on CPAN
--look Opens the distribution with your SHELL
-V,--version Displays software version
Examples:
my ($class, %args) = @_;
return bless {
rbuf => '',
timeout => 60,
max_line_size => 16384,
max_header_lines => 64,
%args
}, $class;
}
my $ssl_verify_args = {
check_cn => "when_only",
wildcards_in_alt => "anywhere",
wildcards_in_cn => "anywhere"
};
sub connect {
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
my ($self, $scheme, $host, $port) = @_;
if ( $scheme eq 'https' ) {
Timeout => $self->{timeout}
) or croak(qq/Could not connect to '$host:$port': $@/);
binmode($self->{fh})
or croak(qq/Could not binmode() socket: '$!'/);
if ( $scheme eq 'https') {
IO::Socket::SSL->start_SSL($self->{fh});
ref($self->{fh}) eq 'IO::Socket::SSL'
or die(qq/SSL connection failed for $host\n/);
$self->{fh}->verify_hostname( $host, $ssl_verify_args )
or die(qq/SSL certificate not valid for $host\n/);
}
$self->{host} = $host;
$self->{port} = $port;
return $self;
}
sub close {
}
return ($self);
}
*parse = \&new;
sub numify
{
my ($self) = @_;
unless (_verify($self)) {
require Carp;
Carp::croak("Invalid version object");
}
my $width = $self->{width} || 3;
my $alpha = $self->{alpha} || "";
my $len = $#{$self->{version}};
my $digit = $self->{version}[0];
my $string = sprintf("%d.", $digit );
for ( my $i = 1 ; $i < $len ; $i++ ) {
{
$string .= sprintf("000");
}
return $string;
}
sub normal
{
my ($self) = @_;
unless (_verify($self)) {
require Carp;
Carp::croak("Invalid version object");
}
my $alpha = $self->{alpha} || "";
my $len = $#{$self->{version}};
my $digit = $self->{version}[0];
my $string = sprintf("v%d", $digit );
for ( my $i = 1 ; $i < $len ; $i++ ) {
$digit = $self->{version}[$i];
$string .= sprintf(".%0d", 0);
}
}
return $string;
}
sub stringify
{
my ($self) = @_;
unless (_verify($self)) {
require Carp;
Carp::croak("Invalid version object");
}
return exists $self->{original}
? $self->{original}
: exists $self->{qv}
? $self->normal
: $self->numify;
}
require UNIVERSAL;
my ($left,$right,$swap) = @_;
my $class = ref($left);
unless ( UNIVERSAL::isa($right, $class) ) {
$right = $class->new($right);
}
if ( $swap ) {
($left, $right) = ($right, $left);
}
unless (_verify($left)) {
require Carp;
Carp::croak("Invalid version object");
}
unless (_verify($right)) {
require Carp;
Carp::croak("Invalid version object");
}
my $l = $#{$left->{version}};
my $r = $#{$right->{version}};
my $m = $l < $r ? $l : $r;
my $lalpha = $left->is_alpha;
my $ralpha = $right->is_alpha;
my $retval = 0;
my $i = 0;
}
*declare = \&qv;
sub is_qv {
my ($self) = @_;
return (exists $self->{qv});
}
sub _verify {
my ($self) = @_;
if ( ref($self)
&& eval { exists $self->{version} }
&& ref($self->{version}) eq 'ARRAY'
) {
return 1;
}
else {
return 0;
}
( run in 2.364 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )