diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Module/Plan/Archive.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Module/Plan/Archive.pm | 115 |
1 files changed, 115 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; |