view release on metacpan or  search on metacpan

local/lib/perl5/Module/Install/PAR.pm  view on Meta::CPAN

The second argument could be used to fetch platform-agnostic
binaries:

  par_base 'SMUELLER', "Some-Distribution-0.01.par";

(Documentation TODO: Use the previously defined distribution
name and version in example.)

=cut

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;
}

=head2 fetch_par

Fetches the .par file previously referenced in the documentation
of the C<par_base> directive.

C<fetch_par> can be used without arguments given the C<par_base>
directive was used before. It will return the name of the file it
fetched.

If the first argument is an URL or a CPAN user ID, the file is
fetched from that directory unless an URL has been previously set.
(Read that again.)

If the second argument is a file name
it is used as the name of the file to download.

If the file could not be fetched, a suitable error message
about no package being available, yada yada yada, is printed.
You can turn this off by specifying a true third argument.

  # Try to fetch the package (see par_base) but
  # don't be verbose about failures
  my $file = fetch_par('', '', undef);

=cut

sub fetch_par {
    my ($self, $url, $file, $quiet) = @_;
    $url = '' if not defined $url;
    $file = '' if not defined $file;
    
    $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;
}