summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm82
1 files changed, 41 insertions, 41 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm
index f30911bab88..2f8b730ca54 100644
--- a/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm
+++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Internals/Extract.pm
@@ -19,21 +19,21 @@ local $Params::Check::VERBOSE = 1;
=head1 NAME
-CPANPLUS::Internals::Extract
+CPANPLUS::Internals::Extract - internals for archive extraction
=head1 SYNOPSIS
### for source files ###
$self->_gunzip( file => 'foo.gz', output => 'blah.txt' );
-
+
### for modules/packages ###
- $dir = $self->_extract( module => $modobj,
+ $dir = $self->_extract( module => $modobj,
extractdir => '/some/where' );
=head1 DESCRIPTION
CPANPLUS::Internals::Extract extracts compressed files for CPANPLUS.
-It can do this by either a pure perl solution (preferred) with the
+It can do this by either a pure perl solution (preferred) with the
use of C<Archive::Tar> and C<Compress::Zlib>, or with binaries, like
C<gzip> and C<tar>.
@@ -47,7 +47,7 @@ The flow looks like this:
=head2 $dir = _extract( module => $modobj, [perl => '/path/to/perl', extractdir => '/path/to/extract/to', prefer_bin => BOOL, verbose => BOOL, force => BOOL] )
C<_extract> will take a module object and extract it to C<extractdir>
-if provided, or the default location which is obtained from your
+if provided, or the default location which is obtained from your
config.
The file name is obtained by looking at C<< $modobj->status->fetch >>
@@ -67,7 +67,7 @@ A C<CPANPLUS::Module> object. This is required.
=item extractdir
-The directory to extract the archive to. By default this looks
+The directory to extract the archive to. By default this looks
something like:
/CPANPLUS_BASE/PERL_VERSION/BUILD/MODULE_NAME
@@ -105,26 +105,26 @@ sub _extract {
my $self = shift;
my $conf = $self->configure_object;
my %hash = @_;
-
+
local $Params::Check::ALLOW_UNKNOWN = 1;
-
+
my( $mod, $verbose, $force );
my $tmpl = {
- force => { default => $conf->get_conf('force'),
+ force => { default => $conf->get_conf('force'),
store => \$force },
- verbose => { default => $conf->get_conf('verbose'),
+ verbose => { default => $conf->get_conf('verbose'),
store => \$verbose },
prefer_bin => { default => $conf->get_conf('prefer_bin') },
extractdir => { default => $conf->get_conf('extractdir') },
module => { required => 1, allow => IS_MODOBJ, store => \$mod },
perl => { default => $^X },
};
-
+
my $args = check( $tmpl, \%hash ) or return;
-
+
### did we already extract it ? ###
my $loc = $mod->status->extract();
-
+
if( $loc && !$force ) {
msg(loc("Already extracted '%1' to '%2'. ".
"Won't extract again without force",
@@ -135,7 +135,7 @@ sub _extract {
### did we already fetch the file? ###
my $file = $mod->status->fetch();
unless( -s $file ) {
- error( loc( "File '%1' has zero size: cannot extract", $file ) );
+ error( loc( "File '%1' has zero size: cannot extract", $file ) );
return;
}
@@ -146,7 +146,7 @@ sub _extract {
$self->_perl_version( perl => $args->{'perl'} ),
$conf->_get_build('moddir'),
);
-
+
### delegate to Archive::Extract ###
### set up some flags for archive::extract ###
local $Archive::Extract::PREFER_BIN = $args->{'prefer_bin'};
@@ -160,7 +160,7 @@ sub _extract {
$file, $to, $ae->error ) );
return;
}
-
+
### if ->files is not filled, we dont know what the hell was
### extracted.. try to offer a suggestion and bail :(
unless ( $ae->files ) {
@@ -168,65 +168,65 @@ sub _extract {
"files from the archive. Install '%2' and ensure ".
"it works properly and try again",
$ae->is_zip ? 'Archive::Zip' : 'Archive::Tar' ) );
- return;
- }
-
-
- ### print out what files we extracted ###
- msg(loc("Extracted '%1'",$_),$verbose) for @{$ae->files};
-
+ return;
+ }
+
+
+ ### print out what files we extracted ###
+ msg(loc("Extracted '%1'",$_),$verbose) for @{$ae->files};
+
### set them all to be +w for the owner, so we don't get permission
### denied for overwriting files that are just +r
-
+
### this is too rigorous -- just change to +w for the owner [cpan #13358]
#chmod 0755, map { File::Spec->rel2abs( File::Spec->catdir($to, $_) ) }
# @{$ae->files};
-
- for my $file ( @{$ae->files} ) {
+
+ for my $file ( @{$ae->files} ) {
my $path = File::Spec->rel2abs( File::Spec->catfile($to, $file) );
-
+
$self->_mode_plus_w( file => $path );
}
-
+
### check the return value for the extracted path ###
### Make an educated guess if we didn't get an extract_path
### back
- ### XXX apparently some people make their own dists and they
- ### pack up '.' which means the leading directory is '.'
+ ### XXX apparently some people make their own dists and they
+ ### pack up '.' which means the leading directory is '.'
### and only the second directory is the actual module directory
- ### so, we'll have to check if our educated guess exists first,
+ ### so, we'll have to check if our educated guess exists first,
### then see if the extract path works.. and if nothing works...
### well, then we really don't know.
my $dir;
for my $try (
- File::Spec->rel2abs(
- ### _safe_path must be called before catdir because catdir on
+ File::Spec->rel2abs(
+ ### _safe_path must be called before catdir because catdir on
### VMS currently will not handle the extra dots in the directories.
- File::Spec->catdir( $self->_safe_path( path => $to ) ,
+ File::Spec->catdir( $self->_safe_path( path => $to ) ,
$self->_safe_path( path =>
- $mod->package_name .'-'.
+ $mod->package_name .'-'.
$mod->package_version
) ) ) ,
File::Spec->rel2abs( $ae->extract_path ),
) {
($dir = $try) && last if -d $try;
}
-
+
### test if the dir exists ###
unless( $dir && -d $dir ) {
error(loc("Unable to determine extract dir for '%1'",$mod->module));
return;
-
- } else {
+
+ } else {
msg(loc("Extracted '%1' to '%2'", $mod->module, $dir), $verbose);
-
+
### register where we extracted the files to,
### also store what files were extracted
- $mod->status->extract( $dir );
+ $mod->status->extract( $dir );
$mod->status->files( $ae->files );
}
-
+
### also, figure out what kind of install we're dealing with ###
$mod->get_installer_type();