From f8c9502fc8230d581bd1d7a3e56b7df16bcdedf9 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Tue, 22 Nov 2011 19:18:53 +0000 Subject: [PATCH] Update Archive-Tar to CPAN version 1.82 [DELTA] * important changes in version 1.82 21/11/2011 (CDRAKE) - Adjustments to handle files >8gb (>0777777777777 octal) - Feature to return the MD5SUM of files in the archive --- Porting/Maintainers.pl | 2 +- cpan/Archive-Tar/lib/Archive/Tar.pm | 26 +++++++++++--- cpan/Archive-Tar/lib/Archive/Tar/Constant.pm | 4 +-- cpan/Archive-Tar/lib/Archive/Tar/File.pm | 51 +++++++++++++++++----------- pod/perldelta.pod | 5 ++- 5 files changed, 61 insertions(+), 27 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index e2426c7..27c2a59 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -209,7 +209,7 @@ use File::Glob qw(:case); 'Archive::Tar' => { 'MAINTAINER' => 'kane', - 'DISTRIBUTION' => 'BINGOS/Archive-Tar-1.80.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Archive-Tar-1.82.tar.gz', 'FILES' => q[cpan/Archive-Tar], 'EXCLUDED' => [ qw(Makefile.PL) ], 'UPSTREAM' => 'cpan', diff --git a/cpan/Archive-Tar/lib/Archive/Tar.pm b/cpan/Archive-Tar/lib/Archive/Tar.pm index 65efb71..4ed3ae0 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar.pm @@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "1.80"; +$VERSION = "1.82"; $CHOWN = 1; $CHMOD = 1; $SAME_PERMISSIONS = $> == 0 ? 1 : 0; @@ -171,6 +171,14 @@ very big archives, and are only interested in the first few files. Can be set to a regular expression. Only files with names that match the expression will be read. +=item md5 + +Set to 1 and the md5sum of files will be returned (instead of file data) + my $iter = Archive::Tar->iter( $file, 1, {md5 => 1} ); + while( my $f = $iter->() ) { + print $f->data . "\t" . $f->full_path . $/; + } + =item extract If set to true, immediately extract entries when reading them. This @@ -309,6 +317,7 @@ sub _read_tar { my $count = $opts->{limit} || 0; my $filter = $opts->{filter}; + my $md5 = $opts->{md5} || 0; # cdrake my $filter_cb = $opts->{filter_cb}; my $extract = $opts->{extract} || 0; @@ -402,8 +411,14 @@ sub _read_tar { $data = $entry->get_content_by_ref; my $skip = 0; + my $ctx; # cdrake ### skip this entry if we're filtering - if ($filter && $entry->name !~ $filter) { + + if($md5) { # cdrake + $ctx = Digest::MD5->new; # cdrake + $skip=5; # cdrake + + } elsif ($filter && $entry->name !~ $filter) { $skip = 1; ### skip this entry if it's a pax header. This is a special file added @@ -423,6 +438,7 @@ sub _read_tar { # longlink and it won't get skipped after all # my $amt = $block; + my $fsz=$entry->size; # cdrake while ($amt > 0) { $$data = ''; my $this = 64 * BLOCK; @@ -433,9 +449,11 @@ sub _read_tar { next LOOP; } $amt -= $this; + $fsz -= $this; # cdrake + substr ($$data, $fsz) = "" if ($fsz<0); # remove external junk prior to md5 # cdrake + $ctx->add($$data) if($skip==5); # cdrake } - ### throw away trailing garbage ### - substr ($$data, $entry->size) = "" if defined $$data && $block < 64 * BLOCK; + $$data = $ctx->hexdigest if($skip==5 && !$entry->is_longlink && !$entry->is_unknown && !$entry->is_label ) ; # cdrake } else { ### just read everything into memory diff --git a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm index a01963f..1bea5ce 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm @@ -3,7 +3,7 @@ package Archive::Tar::Constant; BEGIN { require Exporter; - $VERSION = '1.80'; + $VERSION = '1.82'; @ISA = qw[Exporter]; require Time::Local if $^O eq "MacOS"; @@ -51,7 +51,7 @@ use constant MODE => do { 0666 & (0777 & ~umask) }; use constant STRIP_MODE => sub { shift() & 0777 }; use constant CHECK_SUM => " "; -use constant UNPACK => 'A100 A8 A8 A8 A12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12'; +use constant UNPACK => 'A100 A8 A8 A8 a12 A12 A8 A1 A100 A6 A2 A32 A32 A8 A8 A155 x12'; # cdrake - size must be a12 - not A12 - or else screws up huge file sizes (>8gb) use constant PACK => 'a100 a8 a8 a8 a12 a12 A8 a1 a100 a6 a2 a32 a32 a8 a8 a155 x12'; use constant NAME_LENGTH => 100; use constant PREFIX_LENGTH => 155; diff --git a/cpan/Archive-Tar/lib/Archive/Tar/File.pm b/cpan/Archive-Tar/lib/Archive/Tar/File.pm index 3b6e26d..9067de1 100644 --- a/cpan/Archive-Tar/lib/Archive/Tar/File.pm +++ b/cpan/Archive-Tar/lib/Archive/Tar/File.pm @@ -13,26 +13,27 @@ use Archive::Tar::Constant; use vars qw[@ISA $VERSION]; #@ISA = qw[Archive::Tar]; -$VERSION = '1.80'; +$VERSION = '1.82'; ### set value to 1 to oct() it during the unpack ### + my $tmpl = [ - name => 0, # string - mode => 1, # octal - uid => 1, # octal - gid => 1, # octal - size => 1, # octal - mtime => 1, # octal - chksum => 1, # octal - type => 0, # character - linkname => 0, # string - magic => 0, # string - version => 0, # 2 bytes - uname => 0, # string - gname => 0, # string - devmajor => 1, # octal - devminor => 1, # octal - prefix => 0, + name => 0, # string A100 + mode => 1, # octal A8 + uid => 1, # octal A8 + gid => 1, # octal A8 + size => 0, # octal # cdrake - not *always* octal.. A12 + mtime => 1, # octal A12 + chksum => 1, # octal A8 + type => 0, # character A1 + linkname => 0, # string A100 + magic => 0, # string A6 + version => 0, # 2 bytes A2 + uname => 0, # string A32 + gname => 0, # string A32 + devmajor => 1, # octal A8 + devminor => 1, # octal A8 + prefix => 0, # A155 x 12 ### end UNPACK items ### raw => 0, # the raw data chunk @@ -214,8 +215,20 @@ sub _new_from_chunk { ### makes it start at 0 actually... :) ### my $i = -1; my %entry = map { - $tmpl->[++$i] => $tmpl->[++$i] ? oct $_ : $_ - } map { /^([^\0]*)/ } unpack( UNPACK, $chunk ); + my ($s,$v)=($tmpl->[++$i],$tmpl->[++$i]); # cdrake + ($_)=($_=~/^([^\0]*)/) unless($s eq 'size'); # cdrake + $s=> $v ? oct $_ : $_ # cdrake + # $tmpl->[++$i] => $tmpl->[++$i] ? oct $_ : $_ # removed by cdrake - mucks up binary sizes >8gb + } unpack( UNPACK, $chunk ); # cdrake + # } map { /^([^\0]*)/ } unpack( UNPACK, $chunk ); # old - replaced now by cdrake + + + if(substr($entry{'size'}, 0, 1) eq "\x80") { # binary size extension for files >8gigs (> octal 77777777777777) # cdrake + my @sz=unpack("aCSNN",$entry{'size'}); $entry{'size'}=$sz[4]+(2**32)*$sz[3]+$sz[2]*(2**64); # Use the low 80 bits (should use the upper 15 as well, but as at year 2011, that seems unlikley to ever be needed - the numbers are just too big...) # cdrake + } else { # cdrake + ($entry{'size'})=($entry{'size'}=~/^([^\0]*)/); $entry{'size'}=oct $entry{'size'}; # cdrake + } # cdrake + my $obj = bless { %entry, %args }, $class; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 5d8418b..7e484bf 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -96,7 +96,10 @@ XXX =item * -L has been upgraded from version 0.69 to version 0.70. +L has been upgraded from version 1.80 to version 1.82. + +Adjustments to handle files >8gb (>0777777777777 octal) and a feature to +return the MD5SUM of files in the archive. =back -- 2.7.4