diff options
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/PAR/Dist/InstallPPD.pm')
-rwxr-xr-x | Master/tlpkg/tlperl.straw/lib/PAR/Dist/InstallPPD.pm | 215 |
1 files changed, 215 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/PAR/Dist/InstallPPD.pm b/Master/tlpkg/tlperl.straw/lib/PAR/Dist/InstallPPD.pm new file mode 100755 index 00000000000..e159caadcb4 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/PAR/Dist/InstallPPD.pm @@ -0,0 +1,215 @@ +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__ + +=head1 NAME + +PAR::Dist::InstallPPD - Installs PPM packages the PAR way + +=head1 SYNOPSIS + + use PAR::Dist::InstallPPD; + + # Creates a .par distribution of the Tk module in the + # current directory based on the Tk.ppd file from the excellent + # bribes.org PPM repository. + par_install_ppd(uri => 'http://www.bribes.org/perl/ppm/Tk.ppd'); + + # You could download the .ppd and .tar.gz files first and then do: + par_install_ppd(uri => 'Tk.ppd', verbose => 1); + +=head1 DESCRIPTION + +This module creates PAR distributions from PPD XML documents which +are used by ActiveState's "Perl Package Manager", short PPM. +Then, it installs these newly created temporary F<.par> files in the +default location using L<PAR::Dist>'s C<install_par> routine. + +Yes, that means you can install packages for the PPM without PPM. + +The module uses L<PAR::Dist::FromPPD> to create the F<.par> files. + +Please note that this code I<works for me> but hasn't been tested +to full extent. + +=head2 EXPORT + +By default, the C<par_install_ppd> subroutine is exported to the caller's +namespace. + +=head1 SUBROUTINES + +This is a list of all public subroutines in the module. + +=head2 par_install_ppd + +This routine takes the same arguments as C<ppd_to_par> from +L<PAR::Dist::FromPPD> except for the output directory and the +options that set the meta data for the produced F<.par> file. +The details are reproduced below. + +The only mandatory parameter is an URI for the PPD file to parse. + +Arguments: + + uri => 'ftp://foo/bar' or 'file:///home/you/file.ppd', ... + verbose => 1/0 (verbose mode on/off) + selectarch => Regular Expression. + selectperl => Regular Expression. + +If a regular expression is specified using C<selectarch>, that expression is +matched against the architecture settings of each implementation. The first +matching implementation is chosen. If none matches, the implementations +are tried in order of appearance. + +C<selectperl> works the same as C<selectarch>, but operates on the (minimum) +perl version of an implementation. If both C<selectperl> and C<selectarch> +are present, C<selectperl> operates on the implementations matched by +C<selectarch>. That means C<selectarch> takes precedence. + +=head1 SEE ALSO + +The L<PAR::Dist> module is used to create L<.par> distributions and install +them. The L<PAR::Dist::FromPPD> module converts the PPD package descriptions. + +PAR has a mailing list, <par@perl.org>, that you can write to; send an empty mail to <par-subscribe@perl.org> to join the list and participate in the discussion. + +Please send bug reports to <bug-par-dist-fromcpan@rt.cpan.org>. + +The official PAR website may be of help, too: http://par.perl.org + +For details on the I<Perl Package Manager>, please refer to ActiveState's +website at L<http://activestate.com>. + +=head1 AUTHOR + +Steffen Mueller, E<lt>smueller at cpan dot orgE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2006 by Steffen Mueller + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.6 or, +at your option, any later version of Perl 5 you may have available. + +=cut |