File: PAR.pm

package info (click to toggle)
libpar-perl 0.952-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,068 kB
  • ctags: 512
  • sloc: perl: 14,520; ansic: 870; makefile: 57
file content (126 lines) | stat: -rw-r--r-- 3,346 bytes parent folder | download
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;