Front page | perl.perl5.changes |
Postings from June 2009
[perl.git] branch blead, updated. GitLive-blead-1466-gea07993
From:
David Mitchell
Date:
June 27, 2009 10:07
Subject:
[perl.git] branch blead, updated. GitLive-blead-1466-gea07993
Message ID:
E1MKbMk-0000ZH-HY@camel.booking.com
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/ea0799344c68cf3c4274aab0c7bdf2f3a9587ed2?hp=fbad106ea7f26c14f996d4ff2eb920ccffc44821>
- Log -----------------------------------------------------------------
commit ea0799344c68cf3c4274aab0c7bdf2f3a9587ed2
Author: David Mitchell <davem@iabyn.com>
Date: Sat Jun 27 18:05:17 2009 +0100
sync blead with Update Archive::Extract 0.34
(follow up to 198e857cc6, syncing whitespace)
-----------------------------------------------------------------------
Summary of changes:
Porting/Maintainers.pl | 2 +-
lib/Archive/Extract.pm | 14 +++---
lib/Archive/Extract/t/01_Archive-Extract.t | 66 ++++++++++++++--------------
3 files changed, 41 insertions(+), 41 deletions(-)
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index ca9a89c..b83f8ee 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -170,7 +170,7 @@ package Maintainers;
'Archive::Extract' =>
{
'MAINTAINER' => 'kane',
- 'DISTRIBUTION' => 'KANE/Archive-Extract-0.32.tar.gz',
+ 'DISTRIBUTION' => 'KANE/Archive-Extract-0.34.tar.gz',
'FILES' => q[lib/Archive/Extract.pm lib/Archive/Extract],
'CPAN' => 1,
'UPSTREAM' => 'cpan',
diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index 9bb4a06..2c9331e 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -802,26 +802,26 @@ sub _untar_at {
my $next;
unless ( $next = Archive::Tar->iter( @read ) ) {
return $self->_error(loc(
- "Unable to read '%1': %2", $self->archive,
+ "Unable to read '%1': %2", $self->archive,
$Archive::Tar::error));
}
while ( my $file = $next->() ) {
push @files, $file->full_path;
-
+
$file->extract or return $self->_error(loc(
- "Unable to read '%1': %2",
+ "Unable to read '%1': %2",
$self->archive,
$Archive::Tar::error));
}
-
- ### older version, read the archive into memory
+
+ ### older version, read the archive into memory
} else {
my $tar = Archive::Tar->new();
unless( $tar->read( @read ) ) {
- return $self->_error(loc("Unable to read '%1': %2",
+ return $self->_error(loc("Unable to read '%1': %2",
$self->archive, $Archive::Tar::error));
}
@@ -837,7 +837,7 @@ sub _untar_at {
{ local $^W; # quell 'splice() offset past end of array' warnings
# on older versions of A::T
- ### older archive::tar always returns $self, return value
+ ### older archive::tar always returns $self, return value
### slightly fux0r3d because of it.
$tar->extract or return $self->_error(loc(
"Unable to extract '%1': %2",
diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t
index 9b4de26..52decf6 100644
--- a/lib/Archive/Extract/t/01_Archive-Extract.t
+++ b/lib/Archive/Extract/t/01_Archive-Extract.t
@@ -318,8 +318,8 @@ for my $switch ( [0,1], [1,0] ) {
for my $tar_iter (@with_tar_iter) { SKIP: {
### Doesn't matter unless .tar, .tbz, .tgz
- local $Archive::Extract::_ALLOW_TAR_ITER = $tar_iter;
-
+ local $Archive::Extract::_ALLOW_TAR_ITER = $tar_iter;
+
diag("Archive::Tar->iter: $tar_iter") if $Debug;
isa_ok( $ae, $Class );
@@ -327,12 +327,12 @@ for my $switch ( [0,1], [1,0] ) {
my $method = $tmpl->{$archive}->{method};
ok( $ae->$method(), "Archive type recognized properly" );
-
+
my $file = $tmpl->{$archive}->{outfile};
my $dir = $tmpl->{$archive}->{outdir}; # can be undef
my $rel_path = File::Spec->catfile( grep { defined } $dir, $file );
my $abs_path = File::Spec->catfile( $OutDir, $rel_path );
- my $abs_dir = File::Spec->catdir(
+ my $abs_dir = File::Spec->catdir(
grep { defined } $OutDir, $dir );
my $nix_path = File::Spec::Unix->catfile(
grep { defined } $dir, $file );
@@ -361,15 +361,15 @@ for my $switch ( [0,1], [1,0] ) {
### XXX test me!
#my @outs = $ae->is_gz ? ($abs_path, $OutDir) : ($OutDir);
my @outs = $ae->is_gz || $ae->is_bz2 || $ae->is_Z || $ae->is_lzma
- ? ($abs_path)
+ ? ($abs_path)
: ($OutDir);
### 10 tests from here on down ###
if( ($mod_fail && ($pgm_fail || !$Archive::Extract::_ALLOW_BIN))
||
($pgm_fail && ($mod_fail || !$Archive::Extract::_ALLOW_PURE_PERL))
- ) {
- skip "No binaries or modules to extract ".$archive,
+ ) {
+ skip "No binaries or modules to extract ".$archive,
(10 * scalar @outs);
}
@@ -377,7 +377,7 @@ for my $switch ( [0,1], [1,0] ) {
### be a problem...
local $IPC::Cmd::WARN = 0;
local $IPC::Cmd::WARN = 0;
-
+
for my $use_buffer ( IPC::Cmd->can_capture_buffer , 0 ) {
### test buffers ###
@@ -397,13 +397,13 @@ for my $switch ( [0,1], [1,0] ) {
diag("Extracting to: $to") if $Debug;
diag("Buffers enabled: ".!$turn_off) if $Debug;
-
+
my $rv = $ae->extract( to => $to );
SKIP: {
my $re = qr/^No buffer captured/;
my $err = $ae->error || '';
-
+
### skip buffer tests if we dont have buffers or
### explicitly turned them off
skip "No buffers available", 8
@@ -411,29 +411,29 @@ for my $switch ( [0,1], [1,0] ) {
&& $err =~ $re;
### skip tests if we dont have an extractor
- skip "No extractor available", 8
+ skip "No extractor available", 8
if $err =~ /Extract failed; no extractors available/;
-
+
### win32 + bin utils is notorious, and none of them are
- ### officially supported by strawberry. So if we
- ### encounter an error while extracting whlie running
+ ### officially supported by strawberry. So if we
+ ### encounter an error while extracting whlie running
### with $PREFER_BIN on win32, just skip the tests.
### See rt#46948: unable to install install on win32
### for details on the pain
skip "Binary tools on Win32 are very unreliable", 8
- if $err and $Archive::Extract::_ALLOW_BIN
+ if $err and $Archive::Extract::_ALLOW_BIN
and IS_WIN32;
ok( $rv, "extract() for '$archive' reports success ($cfg)");
-
+
diag("Extractor was: " . $ae->_extractor) if $Debug;
-
+
### if we /should/ have buffers, there should be
### no errors complaining we dont have them...
unlike( $err, $re,
"No errors capturing buffers" );
-
- ### might be 1 or 2, depending wether we extracted
+
+ ### might be 1 or 2, depending wether we extracted
### a dir too
my $files = $ae->files || [];
my $file_cnt = grep { defined } $file, $dir;
@@ -446,7 +446,7 @@ for my $switch ( [0,1], [1,0] ) {
### subscript -1 at -e line 1." So wrap it in do { }
is( do { $files->[-1] }, $nix_path,
"Found correct output file '$nix_path'" );
-
+
ok( -e $abs_path,
"Output file '$abs_path' exists" );
ok( $ae->extract_path,
@@ -462,15 +462,15 @@ for my $switch ( [0,1], [1,0] ) {
1 while unlink $abs_path;
ok( !(-e $abs_path), "Output file successfully removed" );
-
+
SKIP: {
skip "No extract path captured, can't remove paths", 2
unless $ae->extract_path;
-
+
### if something went wrong with determining the out
### path, don't go deleting stuff.. might be Really Bad
my $out_re = quotemeta( $OutDir );
-
+
### VMS directory layout is different. Craig Berry
### explains:
### the test is trying to determine if C</disk1/foo/bar>
@@ -478,22 +478,22 @@ for my $switch ( [0,1], [1,0] ) {
### syntax, that would mean trying to determine whether
### C<disk1:[foo.bar]> is part of C<disk1:[foo.bar.baz]>
### Because we have both a directory delimiter
- ### (dot) and a directory spec terminator (right
- ### bracket), we have to trim the right bracket from
+ ### (dot) and a directory spec terminator (right
+ ### bracket), we have to trim the right bracket from
### the first one to make it successfully match the
### second one. Since we're asserting the same truth --
### that one path spec is the leading part of the other
### -- it seems to me ok to have this in the test only.
- ###
+ ###
### so we strip the ']' of the back of the regex
- $out_re =~ s/\\\]// if IS_VMS;
-
- if( $ae->extract_path !~ /^$out_re/ ) {
- ok( 0, "Extractpath WRONG (".$ae->extract_path.")");
+ $out_re =~ s/\\\]// if IS_VMS;
+
+ if( $ae->extract_path !~ /^$out_re/ ) {
+ ok( 0, "Extractpath WRONG (".$ae->extract_path.")");
skip( "Unsafe operation -- skip cleanup!!!" ), 1;
- }
-
- eval { rmtree( $ae->extract_path ) };
+ }
+
+ eval { rmtree( $ae->extract_path ) };
ok( !$@, " rmtree gave no error" );
ok( !(-d $ae->extract_path ),
" Extract dir succesfully removed" );
--
Perl5 Master Repository
-
[perl.git] branch blead, updated. GitLive-blead-1466-gea07993
by David Mitchell