1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
|
#line 1
package Module::Install::PAR;
use strict;
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.63';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub par_base {
my ($self, $base, $file) = @_;
my $class = ref($self);
my $inc_class = join('::', @{$self->_top}{qw(prefix name)});
my $ftp_base;
if ( defined $base and length $base ) {
if ( $base =~ m!^(([A-Z])[A-Z])[-_A-Z]+\Z! ) {
$self->{mailto} = "$base\@cpan.org";
$ftp_base = "ftp://ftp.cpan.org/pub/CPAN/authors/id/$2/$1/$base";
$base = "http://www.cpan.org/authors/id/$2/$1/$base";
} elsif ( $base !~ m!^(\w+)://! ) {
die "Cannot recognize path '$base'; please specify an URL or CPAN ID";
}
$base .= '/' unless $base =~ m!/\Z!;
$ftp_base .= '/' unless $ftp_base =~ m!/\Z!;
}
require Config;
my $suffix = "$Config::Config{archname}-$Config::Config{version}.par";
unless ( $file ||= $self->{file} ) {
my $name = $self->name or return;
my $version = $self->version or return;
$name =~ s!::!-!g;
$self->{file} = $file = "$name-$version-$suffix";
}
my $perl = $^X;
$perl = Win32::GetShortPathName($perl)
if $perl =~ / / and defined &Win32::GetShortPathName;
$self->preamble(<<"END_MAKEFILE") if $base;
# --- $class section:
all ::
\t\$(NOECHO) $perl -M$inc_class -e \"extract_par(q($file))\"
END_MAKEFILE
$self->postamble(<<"END_MAKEFILE");
# --- $class section:
$file: all test
\t\$(NOECHO) \$(PERL) -M$inc_class -e \"make_par(q($file))\"
par :: $file
\t\$(NOECHO) \$(NOOP)
par-upload :: $file
\tcpan-upload -verbose $file
END_MAKEFILE
$self->{url} = $base;
$self->{ftp_url} = $ftp_base;
$self->{suffix} = $suffix;
return $self;
}
sub fetch_par {
my ($self, $url, $file, $quiet) = @_;
$url = $self->{url} || $self->par_base($url)->{url};
my $ftp_url = $self->{ftp_url};
$file ||= $self->{file};
return $file if -f $file or $self->get_file(
url => "$url$file",
ftp_url => "$ftp_url$file"
);
require Config;
print <<"END_MESSAGE" if $self->{mailto} and ! $quiet;
*** No installation package available for your architecture.
However, you may wish to generate one with '$Config::Config{make} par' and send
it to <$self->{mailto}>, so other people on the same platform
can benefit from it.
*** Proceeding with normal installation...
END_MESSAGE
return;
}
sub extract_par {
my ($self, $file) = @_;
return unless -f $file;
if ( eval { require Archive::Zip; 1 } ) {
my $zip = Archive::Zip->new;
return unless $zip->read($file) == Archive::Zip::AZ_OK()
and $zip->extractTree('', 'blib/') == Archive::Zip::AZ_OK();
} elsif ( $self->can_run('unzip') ) {
return if system( unzip => $file, qw(-d blib) );
}
local *PM_TO_BLIB;
open PM_TO_BLIB, '> pm_to_blib' or die $!;
close PM_TO_BLIB;
}
sub make_par {
my ($self, $file) = @_;
unlink $file if -f $file;
unless ( eval { require PAR::Dist; PAR::Dist->VERSION >= 0.03 } ) {
warn "Please install PAR::Dist 0.03 or above first.";
return;
}
return PAR::Dist::blib_to_par( dist => $file );
}
1;
|