File Coverage

blib/lib/PAR/Dist/InstallPPD.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package PAR::Dist::InstallPPD;

use 5.006;
use strict;
use warnings;

use PAR::Dist::FromPPD ();
use PAR::Dist ();
use File::Temp ();
use File::Spec;
use File::Path;
use Cwd;

require Config;
require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
    par_install_ppd
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
    par_install_ppd
);

our $VERSION = '0.02';

our $VERBOSE = 0;


sub _verbose {
    $VERBOSE = shift if (@_);
    return $VERBOSE
}

sub _diag {
    my $msg = shift;
    return unless _verbose();
    print $msg ."\n";
}

sub par_install_ppd {
    die "Uneven number of arguments to 'par_install_ppd'." if @_ % 2;
    my %args = @_;

    _verbose($args{'verbose'});

    _diag "Creating temporary directory for temporary .par";

    my $tdir = $args{out} = File::Temp::tempdir(
        CLEANUP => 1,
        DIR => File::Spec->tmpdir(),
    );

    _diag "Preparing meta data for temporary .par";

    # should be figured out by ::FromPPD
    delete $args{$_} for qw(
        distversion perlversion
    );
    # just need to be defined.
    $args{arch} = $Config::Config{archname};
    $args{perlversion} = sprintf('%vd', $^V);

    # Accept running perl version (5.8.8)
    # or main perl version (5.8)
    # or any other subversions (5.8.6)
    my $perlver = sprintf('%vd', $^V);
    my $mainperlver = $perlver;
    $mainperlver =~ s/^(\d+)\.(\d+)\..*$/$1.$2/;
    _diag "Setting perl version to ($perlver|$mainperlver|$mainperlver\\.\\d+)"
      if not defined $args{selectperl};
    $args{selectperl} ||= qr/^(?:$perlver|$mainperlver|$mainperlver\.\d+)$/;


    # Accept running arch
    my $arch = quotemeta( $Config::Config{archname} );
    _diag "Setting architecture to $Config::Config{archname}"
      if not defined $args{selectarch};
    my $perlver_nodots = $mainperlver;
    $perlver_nodots =~ s/\.//g;
    $args{selectarch} ||= qr/^(?:$arch-?(?:$perlver_nodots\d*|$mainperlver(?:\.\d+)?)|$arch)$/;

    _diag "Using temporary directory $tdir.";
    _diag "Invoking PAR::Dist::FromPPD to create the .par file.";

    PAR::Dist::FromPPD::ppd_to_par(%args);

    _diag "Searching for generated .par file.";

    _diag "chdir() to '$tdir'";
    my $cwd = Cwd::cwd();
    chdir($tdir);

    opendir my $dh, '.' or die $!;

    my @par_files = grep {-f $_ and /\.par$/i} readdir($dh);

    _diag "Found PAR files: @par_files.";

    _diag "Installing PAR files.";

    foreach my $file (@par_files) {
        _diag "Installing file '$file' with PAR::Dist::install_par().";
        PAR::Dist::install_par($file);
    }

    _diag "Done installing PAR files.";

    chdir($cwd);
    File::Path::rmtree([$tdir]);
    return(1);
}




1;
__END__