diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Module/Plan')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Module/Plan/Archive.pm | 115 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Module/Plan/Base.pm | 399 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Module/Plan/Lite.pm | 137 |
3 files changed, 651 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Module/Plan/Archive.pm b/Master/tlpkg/tlperl/lib/Module/Plan/Archive.pm new file mode 100755 index 00000000000..2e228a065e2 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Module/Plan/Archive.pm @@ -0,0 +1,115 @@ +package Module::Plan::Archive; + +# Simple module for creating Module::Build::Plan archives, which are +# single-file packaged sets of tarballs with a build in p5i script. + +use 5.005; +use strict; +use Carp 'croak'; +use Params::Util '_INSTANCE', + '_STRING'; +use Archive::Tar (); +use Module::Plan::Base (); + +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.16'; +} + + + + + +##################################################################### +# Constructor and Accessors + +sub new { + my $class = shift; + my $self = bless { @_ }, $class; + + # Check params + unless ( _INSTANCE($self->plan, 'Module::Plan::Base') ) { + Carp("Did not provide a Module::Plan::Base object to Archive contructor"); + } + unless ( $self->plan->can('fetch') ) { + Carp("The plan does not implement a 'fetch' method"); + } + + return $self; +} + +sub from_p5i { + my $class = shift; + + # Create an archive from a file name + my $file = shift; + unless ( _STRING($file) and -f $file ) { + Carp('Missing or invalid file name'); + } + + # Create the plan, and from that the archive + return $class->new( + plan => Module::Plan::Base->read( $file, @_ ), + ); +} + +sub plan { + $_[0]->{plan}; +} + +sub no_inject { + $_[0]->plan->no_inject; +} + + + + + +##################################################################### +# Archive Generation + +sub save { + my $self = shift; + my $file = shift; + my $archive = $self->archive; + my $rv = $archive->write( $file, 9 ); + return 1; +} + +sub archive { + my $self = shift; + my $plan = $self->plan; + + # Create the tarball and add the plan + my $tar = Archive::Tar->new; + $tar->add_data( 'default.p5i', $self->default_p5i ); + + # Add the files + foreach my $name ( $plan->names ) { + unless ( $plan->dists_hash->{$name} ) { + $plan->_fetch_uri($name); + } + + # Read the dist into memory and add to tarball + my $file = $plan->dists_hash->{$name}; + my $buffer = ''; + SCOPE: { + local $/ = undef; + open( DIST, $file ) or die "open: $!"; + defined($buffer = <DIST>) or die "read: $!"; + close( DIST ) or die "close: $!"; + } + $tar->add_data( $name, $buffer ); + } + + return $tar; +} + +# Generate the new default.p5i plan file for the archive +sub default_p5i { + my $self = shift; + my $class = $self->can('ref') ? $self->ref : ref($self); + return join '', map { "$_\n" } ( $class, "", $self->plan->names ); +} + +1; diff --git a/Master/tlpkg/tlperl/lib/Module/Plan/Base.pm b/Master/tlpkg/tlperl/lib/Module/Plan/Base.pm new file mode 100755 index 00000000000..4c920bdc794 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Module/Plan/Base.pm @@ -0,0 +1,399 @@ +package Module::Plan::Base; + +=pod + +=head1 NAME + +Module::Plan::Base - Base class for Module::Plan classes + +=head1 DESCRIPTION + +B<Module::Plan::Base> provides the underlying basic functionality. That is, +taking a file, injecting it into CPAN, and the installing it via the L<CPAN> +module. + +It also provides for a basic "phase" system, that allows steps to be taken +in the appropriate order. This is very simple for now, but may be upgraded +later into a dependency-based system. + +This class is undocumented for the moment. + +See L<pip> for the front-end console application for this module. + +=cut + +use 5.005; +use strict; +use Carp 'croak'; +use File::Spec (); +use File::Temp (); +use File::Basename (); +use Params::Util qw{ _STRING _CLASS _INSTANCE }; +use URI (); +use URI::file (); +#use LWP::Simple (); # Loaded on-demand with require +#use CPAN::Inject (); # Loaded on-demand with require +#use PAR::Dist (); # Loaded on-demand with require +BEGIN { + # Versions of CPAN older than 1.88 strip off '.' from @INC, + # breaking stuff. At 1.88 CPAN changed to converting them + # to absolute paths via rel2abs instead. + # This is an exact copy of the code that does this, which + # will allow Module::Plan::Base to work with versions of CPAN.pm + # older than 1.88 without being impacted by the bug. + # This is mainly good, because forcing CPAN.pm to be upgraded + # has problems of it's own, and so by using this hack we can + # install correctly with the version of CPAN.pm bundled with + # older versions of Perl. + for my $inc (@INC) { + $inc = File::Spec->rel2abs($inc) unless ref $inc; + } +} +use CPAN; + +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.16'; +} + + + + + +##################################################################### +# Constructor and Accessors + +sub new { + my $class = shift; + my $self = bless { @_ }, $class; + + # Create internal state variables + $self->{names} = [ ]; + $self->{uris} = { }; + $self->{dists} = { }; + $self->{cpan_path} = { }; + + # Precalculate the various paths for the P5I file + $self->{p5i_uri} = $self->_p5i_uri( $self->p5i ); + $self->{p5i_dir} = $self->_p5i_dir( $self->p5i_uri ); + $self->{dir} = File::Temp::tempdir( CLEANUP => 1 ); + + # Check the no_inject option + $self->{no_inject} = !! $self->{no_inject}; + + # Create the CPAN injector + unless ( $self->no_inject ) { + require CPAN::Inject; + $self->{inject} ||= CPAN::Inject->from_cpan_config; + unless ( _INSTANCE($self->{inject}, 'CPAN::Inject') ) { + croak("Did not provide a valid 'param' CPAN::Inject object"); + } + } + + $self; +} + +# Which params do we allow to read +my %READ_ALLOW = ( no_inject => 1 ); + +sub read { + my $class = shift; + + # Check the file + my $p5i = shift or croak( 'You did not specify a file name' ); + croak( "File '$p5i' does not exist" ) unless -e $p5i; + croak( "'$p5i' is a directory, not a file" ) unless -f _; + croak( "Insufficient permissions to read '$p5i'" ) unless -r _; + + # Get a filtered set of params to pass through + my %params = @_; + %params = map { $_ => $params{$_} } + grep { $READ_ALLOW{$_} } + sort keys %params; + + # Slurp in the file + my $contents; + SCOPE: { + local $/ = undef; + open CFG, $p5i or croak( "Failed to open file '$p5i': $!" ); + $contents = <CFG>; + close CFG; + } + + # Split and find the header line for the type + my @lines = split /(?:\015{1,2}\012|\015|\012)/, $contents; + my $header = shift @lines; + unless ( _CLASS($header) ) { + croak("Invalid header '$header', not a class name"); + } + + # Load the class + require join('/', split /::/, $header) . '.pm'; + unless ( $header->VERSION and $header->isa($class) ) { + croak("Invalid header '$header', class is not a Module::Plan::Base subclass"); + } + + # MSWIN32: we want this because URI encodes backslashes + # and encoded backslashes make File::Spec (and later LWP::Simple) + # confuse afterwords. + $p5i =~ s{\\}{/}g; + + # Class looks good, create our object and hand off + return $header->new( + p5i => $p5i, + lines => \@lines, + %params, + ); +} + +sub p5i { + $_[0]->{p5i}; +} + +sub p5i_uri { + $_[0]->{p5i_uri}; +} + +sub p5i_dir { + $_[0]->{p5i_dir}; +} + +sub dir { + $_[0]->{dir}; +} + +sub lines { + @{ $_[0]->{lines} }; +} + +sub names { + @{ $_[0]->{names} }; +} + +sub dists { + %{ $_[0]->{dists} }; +} + +sub dists_hash { + $_[0]->{dists}; +} + +sub uris { + my $self = shift; + my %copy = %{ $self->{uris} }; + foreach my $key ( keys %copy ) { + $copy{$key} = $copy{$key}->clone; + } + %copy; +} + +sub no_inject { + $_[0]->{no_inject}; +} + +sub inject { + $_[0]->{inject}; +} + +# Generate the plan file from the plan object +sub as_string { + return join '', + map { "$_\n" } + $_[0]->can('ref') + ? $_[0]->ref + : ref $_[0], + "", + $_[0]->lines; +} + + + + + +##################################################################### +# Files and Installation + +sub add_file { + my $self = shift; + my $file = _STRING(shift) or croak("Did not provide a file name"); + + # Handle relative and absolute paths + $file = File::Spec->rel2abs( $file, $self->dir ); + my (undef, undef, $name) = File::Spec->splitpath( $file ); + + # Check for duplicates + if ( scalar grep { $name eq $_ } @{$self->{names}} ) { + croak("Duplicate file $name in plan"); + } + + # Add the name and the file name + push @{ $self->{names} }, $name; + $self->{dists}->{$name} = $file; + + return 1; +} + +sub add_uri { + my $self = shift; + my $uri = _INSTANCE(shift, 'URI') or croak("Did not provide a URI"); + unless ( $uri->can('path') ) { + croak("URI is not have a ->path method"); + } + + # Split into segments to get the file + my @segments = $uri->path_segments; + my $name = $segments[-1]; + + # Check for duplicates + if ( scalar grep { $name eq $_ } @{$self->{names}} ) { + croak("Duplicate file $name in plan"); + } + + # Add the name and the file name + push @{ $self->{names} }, $name; + $self->{uris}->{$name} = $uri; + + return 1; +} + +sub run { + die ref($_[0]) . " does not implement 'run'"; +} + +sub _fetch_uri { + my $self = shift; + my $name = shift; + my $uri = $self->{uris}->{$name}; + unless ( $uri ) { + die("Unknown uri for $name"); + } + + # Determine the dists file name + my $file = File::Spec->catfile( $self->{dir}, $name ); + if ( -f $file ) { + die("File $file already exists"); + } + $self->{dists}->{$name} = $file; + + # Download the URI to the destination + require LWP::Simple; + my $content = LWP::Simple::get( $uri ); + unless ( defined $content ) { + croak("Failed to download $uri"); + } + + # Save the file + unless ( open( DOWNLOAD, '>', $file ) ) { + croak("Failed to open $file to write"); + } + binmode( DOWNLOAD ); + unless ( print DOWNLOAD $content ) { + croak("Failed to write to $file"); + } + unless ( close( DOWNLOAD ) ) { + croak("Failed to close $file"); + } + + return 1; +} + +sub _cpan_inject { + my $self = shift; + my $name = shift; + my $file = $self->{dists}->{$name}; + unless ( $file ) { + die("Unknown file $name"); + } + + # Inject the file into the CPAN cache + $self->{cpan_path}->{$name} = $self->inject->add( file => $file ); + + 1; +} + +sub _cpan_install { + my $self = shift; + my $name = shift; + my $distro = $self->{cpan_path}->{$name}; + unless ( $distro ) { + die("Unknown file $name"); + } + + # Install via the CPAN::Shell + CPAN::Shell->install($distro); +} + +sub _par_install { + my $self = shift; + my $name = shift; + my $uri = $self->{uris}->{$name}; + unless ( $uri ) { + die("Unknown uri for $name"); + } + + # Install entirely using PAR::Dist + require PAR::Dist; + PAR::Dist::install_par( $uri->as_string ); +} + +# Takes arbitrary param, returns URI to the P5I file +sub _p5i_uri { + my $uri = _INSTANCE($_[1], 'URI') ? $_[1] + : _STRING($_[1]) ? URI->new($_[1]) + : undef + or croak("Not a valid P5I path"); + + # Convert generics to file URIs + unless ( $uri->scheme ) { + # It's a raw filename + $uri = URI::file->new($uri->as_string) or croak("Not a valid P5I path"); + } + + # Make any file paths absolute + if ( $uri->isa('URI::file') ) { + my $file = File::Spec->rel2abs( $uri->path ); + $uri = URI::file->new($file); + } + + $uri; +} + +sub _p5i_dir { + my $uri = _INSTANCE($_[1], 'URI') + or croak("Did not pass a URI to p5i_dir"); + + # Use a naive method for the moment + my $string = $uri->as_string; + $string =~ s/\/[^\/]+$//; + + # Return the modified version + URI->new( $string, $uri->scheme ); +} + +1; + +=pod + +=head1 SUPPORT + +See the main L<pip> module for support information. + +=head1 AUTHORS + +Adam Kennedy E<lt>adamk@cpan.orgE<gt> + +=head1 SEE ALSO + +L<pip>, L<Module::Plan>, L<Module::Inspector> + +=head1 COPYRIGHT + +Copyright 2006 - 2009 Adam Kennedy. + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +The full text of the license can be found in the +LICENSE file included with this module. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Module/Plan/Lite.pm b/Master/tlpkg/tlperl/lib/Module/Plan/Lite.pm new file mode 100755 index 00000000000..9c98627e2f6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Module/Plan/Lite.pm @@ -0,0 +1,137 @@ +package Module::Plan::Lite; + +=pod + +=head1 NAME + +Module::Plan::Lite - Lite installation scripts for third-party modules + +=head1 SYNOPSIS + +The following is the contents of your default.pip file. + + Module::Plan::Lite + + # Everything in the plan file is installed in order + + # Supported file forms + Install-This-First-1.00.tar.gz + Install-This-Second.1.31.tar.gz + extensions/This-This-0.02.tar.gz + /absolute/Module-Location-4.12.tar.gz + + # Supported URI types + ftp://foo.com/pip-0.13.tar.gz + http://foo.com/pip-0.13.tar.gz + + # Support for PAR installation and conventions + http://foo.com/DBI-1.37-MSWin32-5.8.0.par + http://foo.com/DBI-1.37 + cpan://SMUELLER/PAR-Packer-0.975 + +=cut + +use strict; +use URI (); +use Module::Plan::Base (); + +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '1.16'; + @ISA = 'Module::Plan::Base'; +} + + + + + +##################################################################### +# Constructor + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + + # Parsing here isn't the best, but this is Lite after all + foreach ( $self->lines ) { + # Strip whitespace and comments + next if /^\s*(?:\#|$)/; + + # Create the URI + my $uri = URI->new_abs( $_, $self->p5i_uri ); + unless ( $uri ) { + croak("Failed to get the URI for $_"); + } + + # Add the uri + $self->add_uri( $uri ); + } + + $self; +} + +sub fetch { + my $self = shift; + + # Download the needed modules + foreach my $name ( $self->names ) { + next if $self->{dists}->{$name}; + $self->_fetch_uri($name); + } + + return 1; +} + +sub run { + my $self = shift; + + # Download the needed modules + foreach my $name ( $self->names ) { + next if $name =~ /(\.par|[\d.]+)$/; + next if $self->{dists}->{$name}; + $self->_fetch_uri($name); + } + + # Inject them into CPAN and install + foreach my $name ( $self->names ) { + # Install via PAR::Dist + if ( $name =~ /(\.par|[\d.]+)$/ ) { + $self->_par_install($name); + next; + } + + # Install via CPAN.pm + $self->_cpan_inject($name); + $self->_cpan_install($name); + } + + return 1; +} + +1; + +=pod + +=head1 SUPPORT + +See the main L<pip> module for support information. + +=head1 AUTHORS + +Adam Kennedy E<lt>adamk@cpan.orgE<gt> + +=head1 SEE ALSO + +L<pip>, L<Module::Plan> + +=head1 COPYRIGHT + +Copyright 2006 - 2009 Adam Kennedy. + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +The full text of the license can be found in the +LICENSE file included with this module. + +=cut |