In perl.git, the branch maint-5.10 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e77551595e1d5a685d01dd31ad3caf4377936e55?hp=5e77bb7db9a6a6cc94221f48a43233c1c52709e6>
- Log ----------------------------------------------------------------- commit e77551595e1d5a685d01dd31ad3caf4377936e55 Author: David Mitchell <[email protected]> Date: Sat Jun 27 18:05:17 2009 +0100 sync blead with Update Archive::Extract 0.34 (follow up to 198e857cc6, syncing whitespace) (cherry picked from commit ea0799344c68cf3c4274aab0c7bdf2f3a9587ed2) M Porting/Maintainers.pl M lib/Archive/Extract.pm M lib/Archive/Extract/t/01_Archive-Extract.t commit 9aad409bf8eaa180d89b8058a256f157679eed06 Author: Jos I. Boumans <[email protected]> Date: Sat Jun 27 14:33:52 2009 +0200 Update Archive::Extract to 0.34 Greetings, below are the patch notes: Changes for 0.32 Sat Jun 27 14:23:54 2009 ============================================ * Attempt to address #46948: unable to install install on win32. Binaries on Win32 are notoriously unreliable and Strawberry perl ships with all the needed perl modules, so skip failed binary tests on Win32. * Address #47053: Use Archive::Tar iter to keep from read the tar into memory. Thanks to Robert Krimen and Doug Wilson for their patches. -- Jos Boumans "Whenever you find you are on the side of the majority, it is time to pause and reflect." - Mark Twain Signed-off-by: H.Merijn Brand <[email protected]> (cherry picked from commit 198e857cc634da4de5a6389b549f5b4000dacc8e) M lib/Archive/Extract.pm M lib/Archive/Extract/t/01_Archive-Extract.t M lib/Archive/Extract/t/src/double_dir.zip.packed M lib/Archive/Extract/t/src/x.Z.packed M lib/Archive/Extract/t/src/x.bz2.packed M lib/Archive/Extract/t/src/x.gz.packed M lib/Archive/Extract/t/src/x.jar.packed M lib/Archive/Extract/t/src/x.lzma.packed M lib/Archive/Extract/t/src/x.par.packed M lib/Archive/Extract/t/src/x.tar.gz.packed M lib/Archive/Extract/t/src/x.tar.packed M lib/Archive/Extract/t/src/x.tgz.packed M lib/Archive/Extract/t/src/x.zip.packed M lib/Archive/Extract/t/src/y.jar.packed M lib/Archive/Extract/t/src/y.par.packed M lib/Archive/Extract/t/src/y.tar.bz2.packed M lib/Archive/Extract/t/src/y.tar.gz.packed M lib/Archive/Extract/t/src/y.tar.packed M lib/Archive/Extract/t/src/y.tbz.packed M lib/Archive/Extract/t/src/y.tgz.packed M lib/Archive/Extract/t/src/y.zip.packed commit 8a84a1072eba3e8073a47fff5eef62d5c1b99c59 Author: Vincent Pit <[email protected]> Date: Fri Jun 26 21:14:00 2009 +0200 One more regression test for RT #59734 (cherry picked from commit 3bce0506564aac8d4ed477fca801708e58b220ff) M t/op/re_tests commit 7b4400ffb7d050faf8519d1499a7c4f5939b5ca5 Author: Nicholas Clark <[email protected]> Date: Thu Jun 25 16:04:37 2009 +0100 Add documentation for the method resolution plugin interface. (cherry-picked from commit 15932acc618e3c642a4814dee6429b92b088b3fd) M MANIFEST M pod.lst M pod/perl.pod A pod/perlmroapi.pod M vms/descrip_mms.template M win32/pod.mak ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + Porting/Maintainers.pl | 2 +- lib/Archive/Extract.pm | 90 ++++-- lib/Archive/Extract/t/01_Archive-Extract.t | 330 ++++++++++++----------- lib/Archive/Extract/t/src/double_dir.zip.packed | 2 +- lib/Archive/Extract/t/src/x.Z.packed | 2 +- lib/Archive/Extract/t/src/x.bz2.packed | 2 +- lib/Archive/Extract/t/src/x.gz.packed | 2 +- lib/Archive/Extract/t/src/x.jar.packed | 2 +- lib/Archive/Extract/t/src/x.lzma.packed | 2 +- lib/Archive/Extract/t/src/x.par.packed | 2 +- lib/Archive/Extract/t/src/x.tar.gz.packed | 2 +- lib/Archive/Extract/t/src/x.tar.packed | 2 +- lib/Archive/Extract/t/src/x.tgz.packed | 2 +- lib/Archive/Extract/t/src/x.zip.packed | 2 +- lib/Archive/Extract/t/src/y.jar.packed | 2 +- lib/Archive/Extract/t/src/y.par.packed | 2 +- lib/Archive/Extract/t/src/y.tar.bz2.packed | 2 +- lib/Archive/Extract/t/src/y.tar.gz.packed | 2 +- lib/Archive/Extract/t/src/y.tar.packed | 2 +- lib/Archive/Extract/t/src/y.tbz.packed | 2 +- lib/Archive/Extract/t/src/y.tgz.packed | 2 +- lib/Archive/Extract/t/src/y.zip.packed | 2 +- pod.lst | 1 + pod/perl.pod | 1 + pod/perlmroapi.pod | 94 +++++++ t/op/re_tests | 1 + vms/descrip_mms.template | 10 +- win32/pod.mak | 4 + 29 files changed, 366 insertions(+), 206 deletions(-) create mode 100644 pod/perlmroapi.pod diff --git a/MANIFEST b/MANIFEST index a548195..bd285c9 100755 --- a/MANIFEST +++ b/MANIFEST @@ -3634,6 +3634,7 @@ pod/perlmodinstall.pod Perl modules: how to install from CPAN pod/perlmodlib.PL Generate pod/perlmodlib.pod pod/perlmod.pod Perl modules: how they work pod/perlmodstyle.pod Perl modules: how to write modules with style +pod/perlmroapi.pod Perl method resolution plugin interface pod/perlnewmod.pod Perl modules: preparing a new module for distribution pod/perlnumber.pod Perl number semantics pod/perlobj.pod Perl objects diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 4705654..28045a0 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 ad3be80..2c9331e 100644 --- a/lib/Archive/Extract.pm +++ b/lib/Archive/Extract.pm @@ -38,15 +38,16 @@ use constant Z => 'Z'; use constant LZMA => 'lzma'; use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG - $_ALLOW_BIN $_ALLOW_PURE_PERL + $_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER ]; -$VERSION = '0.32'; +$VERSION = '0.34'; $PREFER_BIN = 0; $WARN = 1; $DEBUG = 0; $_ALLOW_PURE_PERL = 1; # allow pure perl extractors $_ALLOW_BIN = 1; # allow binary extractors +$_ALLOW_TAR_ITER = 1; # try to use Archive::Tar->iter if available # same as all constants my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); @@ -782,43 +783,72 @@ sub _untar_at { $fh_to_read = $bz; } - ### $Archive::Tar::WARN is 1 by default in Archive::Tar, but we've - ### localized $Archive::Tar::WARN already. - $Archive::Tar::WARN = $Archive::Extract::WARN; + my @files; + { + ### $Archive::Tar::WARN is 1 by default in Archive::Tar, but we've + ### localized $Archive::Tar::WARN already. + $Archive::Tar::WARN = $Archive::Extract::WARN; - my $tar = Archive::Tar->new(); + ### only tell it it's compressed if it's a .tgz, as we give it a file + ### handle if it's a .tbz + my @read = ( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ); - ### only tell it it's compressed if it's a .tgz, as we give it a file - ### handle if it's a .tbz - unless( $tar->read( $fh_to_read, ( $self->is_tgz ? 1 : 0 ) ) ) { - return $self->_error(loc("Unable to read '%1': %2", $self->archive, - $Archive::Tar::error)); - } + ### for version of Archive::Tar > 1.04 + local $Archive::Tar::CHOWN = 0; - ### workaround to prevent Archive::Tar from setting uid, which - ### is a potential security hole. -autrijus - ### have to do it here, since A::T needs to be /loaded/ first ### - { no strict 'refs'; local $^W; + ### use the iterator if we can. it's a feature of A::T 1.40 and up + if ( $_ALLOW_TAR_ITER && Archive::Tar->can( 'iter' ) ) { - ### older versions of archive::tar <= 0.23 - *Archive::Tar::chown = sub {}; - } + my $next; + unless ( $next = Archive::Tar->iter( @read ) ) { + return $self->_error(loc( + "Unable to read '%1': %2", $self->archive, + $Archive::Tar::error)); + } - ### for version of Archive::Tar > 1.04 - local $Archive::Tar::CHOWN = 0; + while ( my $file = $next->() ) { + push @files, $file->full_path; + + $file->extract or return $self->_error(loc( + "Unable to read '%1': %2", + $self->archive, + $Archive::Tar::error)); + } + + ### older version, read the archive into memory + } else { - { local $^W; # quell 'splice() offset past end of array' warnings - # on older versions of A::T + my $tar = Archive::Tar->new(); - ### 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", - $self->archive, $Archive::Tar::error )); + unless( $tar->read( @read ) ) { + return $self->_error(loc("Unable to read '%1': %2", + $self->archive, $Archive::Tar::error)); + } + + ### workaround to prevent Archive::Tar from setting uid, which + ### is a potential security hole. -autrijus + ### have to do it here, since A::T needs to be /loaded/ first ### + { no strict 'refs'; local $^W; + + ### older versions of archive::tar <= 0.23 + *Archive::Tar::chown = sub {}; + } + + { local $^W; # quell 'splice() offset past end of array' warnings + # on older versions of A::T + + ### 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", + $self->archive, $Archive::Tar::error )); + } + + @files = $tar->list_files; + } } - my @files = $tar->list_files; - my $dir = $self->__get_extract_dir( \...@files ); + my $dir = $self->__get_extract_dir( \...@files ); ### store the files that are in the archive ### $self->files(\...@files); diff --git a/lib/Archive/Extract/t/01_Archive-Extract.t b/lib/Archive/Extract/t/01_Archive-Extract.t index 63a956b..52decf6 100644 --- a/lib/Archive/Extract/t/01_Archive-Extract.t +++ b/lib/Archive/Extract/t/01_Archive-Extract.t @@ -305,178 +305,202 @@ for my $switch ( [0,1], [1,0] ) { for my $archive (keys %$tmpl) { - diag("Extracting $archive in config $cfg") if $Debug; - ### check first if we can do the proper my $ae = Archive::Extract->new( archive => File::Spec->catfile($SrcDir,$archive) ); - isa_ok( $ae, $Class ); - - my $method = $tmpl->{$archive}->{method}; - ok( $ae->$method(), "Archive type recognized properly" ); - - ### 10 tests from here on down ### - SKIP: { - 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( - grep { defined } $OutDir, $dir ); - my $nix_path = File::Spec::Unix->catfile( - grep { defined } $dir, $file ); - - ### check if we can run this test ### - my $pgm_fail; my $mod_fail; - for my $pgm ( @{$tmpl->{$archive}->{programs}} ) { - ### no binary extract method - $pgm_fail++, next unless $pgm; - - ### we dont have the program - $pgm_fail++ unless $Archive::Extract::PROGRAMS->{$pgm} && - $Archive::Extract::PROGRAMS->{$pgm}; - - } - - for my $mod ( @{$tmpl->{$archive}->{modules}} ) { - ### no module extract method - $mod_fail++, next unless $mod; - - ### we dont have the module - $mod_fail++ unless check_install( module => $mod ); - } - - ### where to extract to -- try both dir and file for gz files - ### 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) - : ($OutDir); - - skip "No binaries or modules to extract ".$archive, - (10 * scalar @outs) if - ($mod_fail && ($pgm_fail || !$Archive::Extract::_ALLOW_BIN)) || - ($pgm_fail && ($mod_fail || !$Archive::Extract::_ALLOW_PURE_PERL)); - - ### we dont warnings spewed about missing modules, that might - ### be a problem... - local $IPC::Cmd::WARN = 0; - local $IPC::Cmd::WARN = 0; + ### Do an extra run with _ALLOW_TAR_ITER = 0 if it's a tar file of some + ### sort + my @with_tar_iter = ( 1 ); + push @with_tar_iter, 0 if grep { $ae->$_ } qw[is_tbz is_tgz is_tar]; + + for my $tar_iter (@with_tar_iter) { SKIP: { + + ### Doesn't matter unless .tar, .tbz, .tgz + local $Archive::Extract::_ALLOW_TAR_ITER = $tar_iter; - for my $use_buffer ( IPC::Cmd->can_capture_buffer , 0 ) { + diag("Archive::Tar->iter: $tar_iter") if $Debug; - ### test buffers ### - my $turn_off = !$use_buffer && !$pgm_fail && - $Archive::Extract::_ALLOW_BIN; + isa_ok( $ae, $Class ); - ### whitebox test ### - ### stupid warnings ### - local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off; - local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off; - local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off; - local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off; + 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( + grep { defined } $OutDir, $dir ); + my $nix_path = File::Spec::Unix->catfile( + grep { defined } $dir, $file ); + + ### check if we can run this test ### + my $pgm_fail; my $mod_fail; + for my $pgm ( @{$tmpl->{$archive}->{programs}} ) { + ### no binary extract method + $pgm_fail++, next unless $pgm; + + ### we dont have the program + $pgm_fail++ unless $Archive::Extract::PROGRAMS->{$pgm} && + $Archive::Extract::PROGRAMS->{$pgm}; - ### try extracting ### - for my $to ( @outs ) { + } - 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 - if ( $turn_off || !IPC::Cmd->can_capture_buffer) - && $err =~ $re; - - ### skip tests if we dont have an extractor - skip "No extractor available", 8 - if $err =~ /Extract failed; no extractors available/; - - 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 - ### a dir too - my $files = $ae->files || []; - my $file_cnt = grep { defined } $file, $dir; - is( scalar @$files, $file_cnt, - "Found correct number of output files (@$files)" ); - - ### due to prototypes on is(), if there's no -1 index on - ### the array ref, it'll give a fatal exception: - ### "Modification of non-creatable array value attempted, - ### 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, - "Extract dir found" ); - ok( -d $ae->extract_path, - "Extract dir exists" ); - is( $ae->extract_path, $abs_dir, - "Extract dir is expected '$abs_dir'" ); - } + for my $mod ( @{$tmpl->{$archive}->{modules}} ) { + ### no module extract method + $mod_fail++, next unless $mod; + + ### we dont have the module + $mod_fail++ unless check_install( module => $mod ); + } - SKIP: { - skip "Unlink tests are unreliable on Win32", 3 if IS_WIN32; + ### where to extract to -- try both dir and file for gz files + ### 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) + : ($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, + (10 * scalar @outs); + } + + ### we dont warnings spewed about missing modules, that might + ### 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 ### + my $turn_off = !$use_buffer && !$pgm_fail && + $Archive::Extract::_ALLOW_BIN; + + ### whitebox test ### + ### stupid warnings ### + local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off; + local $IPC::Cmd::USE_IPC_RUN = 0 if $turn_off; + local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off; + local $IPC::Cmd::USE_IPC_OPEN3 = 0 if $turn_off; - 1 while unlink $abs_path; - ok( !(-e $abs_path), "Output file successfully removed" ); + + ### try extracting ### + for my $to ( @outs ) { + + diag("Extracting to: $to") if $Debug; + diag("Buffers enabled: ".!$turn_off) if $Debug; + + my $rv = $ae->extract( to => $to ); SKIP: { - skip "No extract path captured, can't remove paths", 2 - unless $ae->extract_path; + 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 + if ( $turn_off || !IPC::Cmd->can_capture_buffer) + && $err =~ $re; + + ### skip tests if we dont have an extractor + 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 + ### 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 + and IS_WIN32; - ### 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> - ### is part of C</disk1/foo/bar/baz>. Except in VMS - ### 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 - ### 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; + 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 + ### a dir too + my $files = $ae->files || []; + my $file_cnt = grep { defined } $file, $dir; + is( scalar @$files, $file_cnt, + "Found correct number of output files (@$files)" ); - if( $ae->extract_path !~ /^$out_re/ ) { - ok( 0, "Extractpath WRONG (".$ae->extract_path.")"); - skip( "Unsafe operation -- skip cleanup!!!" ), 1; - } + ### due to prototypes on is(), if there's no -1 index on + ### the array ref, it'll give a fatal exception: + ### "Modification of non-creatable array value attempted, + ### subscript -1 at -e line 1." So wrap it in do { } + is( do { $files->[-1] }, $nix_path, + "Found correct output file '$nix_path'" ); - eval { rmtree( $ae->extract_path ) }; - ok( !$@, " rmtree gave no error" ); - ok( !(-d $ae->extract_path ), - " Extract dir succesfully removed" ); + ok( -e $abs_path, + "Output file '$abs_path' exists" ); + ok( $ae->extract_path, + "Extract dir found" ); + ok( -d $ae->extract_path, + "Extract dir exists" ); + is( $ae->extract_path, $abs_dir, + "Extract dir is expected '$abs_dir'" ); + } + + SKIP: { + skip "Unlink tests are unreliable on Win32", 3 if IS_WIN32; + + 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> + ### is part of C</disk1/foo/bar/baz>. Except in VMS + ### 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 + ### 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.")"); + skip( "Unsafe operation -- skip cleanup!!!" ), 1; + } + + eval { rmtree( $ae->extract_path ) }; + ok( !$@, " rmtree gave no error" ); + ok( !(-d $ae->extract_path ), + " Extract dir succesfully removed" ); + } } } } - } - } } + } } + } } diff --git a/lib/Archive/Extract/t/src/double_dir.zip.packed b/lib/Archive/Extract/t/src/double_dir.zip.packed index ad32858..719fe7a 100644 --- a/lib/Archive/Extract/t/src/double_dir.zip.packed +++ b/lib/Archive/Extract/t/src/double_dir.zip.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/double_dir.zip lib/Archive/Extract/t/src/double_dir.zip.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M4$L#!`H``````&QH,S0````````````````%`!4`>"]Y+WI55`D``PR`ST,, diff --git a/lib/Archive/Extract/t/src/x.Z.packed b/lib/Archive/Extract/t/src/x.Z.packed index ec86948..ddaa214 100644 --- a/lib/Archive/Extract/t/src/x.Z.packed +++ b/lib/Archive/Extract/t/src/x.Z.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.Z lib/Archive/Extract/t/src/x.Z.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ ''YV0>`(J```` diff --git a/lib/Archive/Extract/t/src/x.bz2.packed b/lib/Archive/Extract/t/src/x.bz2.packed index 84a65f8..edf372f 100644 --- a/lib/Archive/Extract/t/src/x.bz2.packed +++ b/lib/Archive/Extract/t/src/x.bz2.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.bz2 lib/Archive/Extract/t/src/x.bz2.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ .0EIH.1=R13A0D``````` diff --git a/lib/Archive/Extract/t/src/x.gz.packed b/lib/Archive/Extract/t/src/x.gz.packed index db23ee5..df0dbec 100644 --- a/lib/Archive/Extract/t/src/x.gz.packed +++ b/lib/Archive/Extract/t/src/x.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.gz lib/Archive/Extract/t/src/x.gz.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ 6'XL("+F;6d8...@``p`````````````` diff --git a/lib/Archive/Extract/t/src/x.jar.packed b/lib/Archive/Extract/t/src/x.jar.packed index 8b471b8..4b93172 100644 --- a/lib/Archive/Extract/t/src/x.jar.packed +++ b/lib/Archive/Extract/t/src/x.jar.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.jar lib/Archive/Extract/t/src/x.jar.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4! diff --git a/lib/Archive/Extract/t/src/x.lzma.packed b/lib/Archive/Extract/t/src/x.lzma.packed index 7f3ea01..a01ee4e 100644 --- a/lib/Archive/Extract/t/src/x.lzma.packed +++ b/lib/Archive/Extract/t/src/x.lzma.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.lzma lib/Archive/Extract/t/src/x.lzma.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ 27...@``````````````````` diff --git a/lib/Archive/Extract/t/src/x.par.packed b/lib/Archive/Extract/t/src/x.par.packed index a91ee73..a2145ab 100644 --- a/lib/Archive/Extract/t/src/x.par.packed +++ b/lib/Archive/Extract/t/src/x.par.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.par lib/Archive/Extract/t/src/x.par.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4! diff --git a/lib/Archive/Extract/t/src/x.tar.gz.packed b/lib/Archive/Extract/t/src/x.tar.gz.packed index a0d1aa4..6112abf 100644 --- a/lib/Archive/Extract/t/src/x.tar.gz.packed +++ b/lib/Archive/Extract/t/src/x.tar.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.tar.gz lib/Archive/Extract/t/src/x.tar.gz.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@ diff --git a/lib/Archive/Extract/t/src/x.tar.packed b/lib/Archive/Extract/t/src/x.tar.packed index faf077d..113e5ab 100644 --- a/lib/Archive/Extract/t/src/x.tar.packed +++ b/lib/Archive/Extract/t/src/x.tar.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.tar lib/Archive/Extract/t/src/x.tar.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M80`````````````````````````````````````````````````````````` diff --git a/lib/Archive/Extract/t/src/x.tgz.packed b/lib/Archive/Extract/t/src/x.tgz.packed index e6ab62d..273e66c 100644 --- a/lib/Archive/Extract/t/src/x.tgz.packed +++ b/lib/Archive/Extract/t/src/x.tgz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.tgz lib/Archive/Extract/t/src/x.tgz.packed -Created at Fri Jun 12 13:25:59 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M'XL(`````````^W.NPW"0!!%T2EE2YC%:[N>#7""1,"G?QM##!&.SDE&(]W@ diff --git a/lib/Archive/Extract/t/src/x.zip.packed b/lib/Archive/Extract/t/src/x.zip.packed index 1f249ef..1c781b1 100644 --- a/lib/Archive/Extract/t/src/x.zip.packed +++ b/lib/Archive/Extract/t/src/x.zip.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/x.zip lib/Archive/Extract/t/src/x.zip.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M4$L#!`H```````MAQ3`````````````````!`!``8558#`!)`B%!EIO!0/4! diff --git a/lib/Archive/Extract/t/src/y.jar.packed b/lib/Archive/Extract/t/src/y.jar.packed index e50bbc0..95af825 100644 --- a/lib/Archive/Extract/t/src/y.jar.packed +++ b/lib/Archive/Extract/t/src/y.jar.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.jar lib/Archive/Extract/t/src/y.jar.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U diff --git a/lib/Archive/Extract/t/src/y.par.packed b/lib/Archive/Extract/t/src/y.par.packed index ff774eb..c1b2b07 100644 --- a/lib/Archive/Extract/t/src/y.par.packed +++ b/lib/Archive/Extract/t/src/y.par.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.par lib/Archive/Extract/t/src/y.par.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:25 2009 ######################################################################### __UU__ M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U diff --git a/lib/Archive/Extract/t/src/y.tar.bz2.packed b/lib/Archive/Extract/t/src/y.tar.bz2.packed index 34e0847..d0715ea 100644 --- a/lib/Archive/Extract/t/src/y.tar.bz2.packed +++ b/lib/Archive/Extract/t/src/y.tar.bz2.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.tar.bz2 lib/Archive/Extract/t/src/y.tar.bz2.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:26 2009 ######################################################################### __UU__ M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4] diff --git a/lib/Archive/Extract/t/src/y.tar.gz.packed b/lib/Archive/Extract/t/src/y.tar.gz.packed index 084e89e..18a4820 100644 --- a/lib/Archive/Extract/t/src/y.tar.gz.packed +++ b/lib/Archive/Extract/t/src/y.tar.gz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.tar.gz lib/Archive/Extract/t/src/y.tar.gz.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:26 2009 ######################################################################### __UU__ M'XL(`````````^W1,0Z#,`R%81\E-R"F><EY&,i2j4.!`4y...@5j4,JH?[? diff --git a/lib/Archive/Extract/t/src/y.tar.packed b/lib/Archive/Extract/t/src/y.tar.packed index 0ac9f0f..ffc3706 100644 --- a/lib/Archive/Extract/t/src/y.tar.packed +++ b/lib/Archive/Extract/t/src/y.tar.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.tar lib/Archive/Extract/t/src/y.tar.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:26 2009 ######################################################################### __UU__ M>2\````````````````````````````````````````````````````````` diff --git a/lib/Archive/Extract/t/src/y.tbz.packed b/lib/Archive/Extract/t/src/y.tbz.packed index 37be772..1418335 100644 --- a/lib/Archive/Extract/t/src/y.tbz.packed +++ b/lib/Archive/Extract/t/src/y.tbz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.tbz lib/Archive/Extract/t/src/y.tbz.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:26 2009 ######################################################################### __UU__ M0EIH.3%!6293636W".T``+)[E,B``$!``/>```-B"1XP!```0``((`"2A*4] diff --git a/lib/Archive/Extract/t/src/y.tgz.packed b/lib/Archive/Extract/t/src/y.tgz.packed index 1489095..389625e 100644 --- a/lib/Archive/Extract/t/src/y.tgz.packed +++ b/lib/Archive/Extract/t/src/y.tgz.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.tgz lib/Archive/Extract/t/src/y.tgz.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:26 2009 ######################################################################### __UU__ M'XL(`````````^W1,0Z#,`R%81\E-R"F><EY&,i2j4.!`4y...@5j4,JH?[? diff --git a/lib/Archive/Extract/t/src/y.zip.packed b/lib/Archive/Extract/t/src/y.zip.packed index 82b5545..b5677ef 100644 --- a/lib/Archive/Extract/t/src/y.zip.packed +++ b/lib/Archive/Extract/t/src/y.zip.packed @@ -10,7 +10,7 @@ To recreate it use the following command: uupacktool.pl -p lib/Archive/Extract/t/src/y.zip lib/Archive/Extract/t/src/y.zip.packed -Created at Fri Jun 12 13:26:00 2009 +Created at Sat Jun 27 14:27:26 2009 ######################################################################### __UU__ M4$L#!`H``````,NBB#$````````````````"`!``>2]56`P`M%6W06Y4MT'U diff --git a/pod.lst b/pod.lst index be6141e..de32a96 100644 --- a/pod.lst +++ b/pod.lst @@ -113,6 +113,7 @@ h Internals and C Language Interface perlclib Internal replacements for standard C library functions perlguts Perl internal functions for those doing extensions perlcall Perl calling conventions from C + perlmroapi Perl method resolution plugin interface perlreapi Perl regular expression plugin interface perlreguts Perl regular expression engine internals diff --git a/pod/perl.pod b/pod/perl.pod index 64dd9a0..939c683 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -128,6 +128,7 @@ For ease of access, the Perl manual has been split up into several sections. perlclib Internal replacements for standard C library functions perlguts Perl internal functions for those doing extensions perlcall Perl calling conventions from C + perlmroapi Perl method resolution plugin interface perlreapi Perl regular expression plugin interface perlreguts Perl regular expression engine internals diff --git a/pod/perlmroapi.pod b/pod/perlmroapi.pod new file mode 100644 index 0000000..2200bec --- /dev/null +++ b/pod/perlmroapi.pod @@ -0,0 +1,94 @@ +=head1 NAME + +perlmroapi - Perl method resolution plugin interface + +=head1 DESCRIPTION + +As of Perl 5.10.1 there is a new interface for plugging and using method +resolution orders other than the default (linear depth first search). +The C3 method resolution order added in 5.10.0 has been re-implemented as +a plugin, without changing its Perl-space interface. + +Each plugin should register itself with C<Perl_mro_register> by providing +the following structure + + struct mro_alg { + AV *(*resolve)(pTHX_ HV *stash, U32 level); + const char *name; + U16 length; + U16 kflags; + U32 hash; + }; + +=over 4 + +=item resolve + +Pointer to the linearisation function, described below. + +=item name + +Name of the MRO, either in ISO-8859-1 or UTF-8. + +=item length + +Length of the name. + +=item kflags + +If the name is given in UTF-8, set this to C<HVhek_UTF8>. The value is passed +direct as the parameter I<kflags> to C<hv_common()>. + +=item hash + +A precomputed hash value for the MRO's name, or 0. + +=back + +=head1 Callbacks + +The C<resolve> function is called to generate a linearised ISA for the +given stash, using this MRO. It is called with a pointer to the stash, and +a I<level> of 0. The core always sets I<level> to 0 when it calls your +function - the parameter is provided to allow your implementation to track +depth if it needs to recurse. + +The function should return a reference to an array containing the parent +classes in order. The caller is responsible for incrementing the reference +count if it wants to keep the structure. Hence if you have created a +temporary value that you keep no pointer to, C<sv_2mortal()> to ensure that +it is disposed of correctly. If you have cached your return value, then +return a pointer to it without changing the reference count. + +=head1 Caching + +Computing MROs can be expensive. The implementation provides a cache, in +which you can store a single C<SV *>, or anything that can be cast to +C<SV *>, such as C<AV *>. To read your private value, use the macro +C<MRO_GET_PRIVATE_DATA()>, passing it the C<mro_meta> structure from the +stash, and a pointer to your C<mro_alg> structure: + + meta = HvMROMETA(stash); + private_sv = MRO_GET_PRIVATE_DATA(meta, &my_mro_alg); + +To set your private value, call C<Perl_mro_set_private_data()>: + + Perl_mro_set_private_data(aTHX_ meta, &c3_alg, private_sv); + +The private data cache will take ownership of a reference to private_sv, +much the same way that C<hv_store()> takes ownership of a reference to the +value that you pass it. + +=head1 Examples + +For examples of MRO implementations, see C<S_mro_get_linear_isa_c3()> +and the C<BOOT:> section of F<mro/mro.xs>, and C<S_mro_get_linear_isa_dfs()> +in F<mro.c> + +=head1 AUTHORS + +The implementation of the C3 MRO and switchable MROs within the perl core was +written by Brandon L Black. Nicholas Clark created the pluggable interface, +refactored Brandon's implementation to work with it, and wrote this document. + +=cut diff --git a/t/op/re_tests b/t/op/re_tests index f65b6b9..dddce07 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -1286,6 +1286,7 @@ a*(*F) aaaab n - - X(\w+)(?=\s)|X(\w+) Xab y [$1-$2] [-ab] #check that branch reset works ok. +(?|(a)) a y $1-$+-$^N a-a-a (?|a(.)b|d(.(o).)d|i(.)(.)j)(.) d!o!da y $1-$2-$3 !o!-o-a (?|a(.)b|d(.(o).)d|i(.)(.)j)(.) aabc y $1-$2-$3 a--c (?|a(.)b|d(.(o).)d|i(.)(.)j)(.) ixyjp y $1-$2-$3 x-y-p diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index c668d36..6f1b037 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -418,9 +418,9 @@ pod14 = [.lib.pods]perlglossary.pod [.lib.pods]perlgpl.pod [.lib.pods]perlguts.p pod15 = [.lib.pods]perlhpux.pod [.lib.pods]perlhurd.pod [.lib.pods]perlintern.pod [.lib.pods]perlintro.pod [.lib.pods]perliol.pod [.lib.pods]perlipc.pod pod16 = [.lib.pods]perlirix.pod [.lib.pods]perljp.pod [.lib.pods]perlko.pod [.lib.pods]perllexwarn.pod [.lib.pods]perllinux.pod [.lib.pods]perllocale.pod pod17 = [.lib.pods]perllol.pod [.lib.pods]perlmachten.pod [.lib.pods]perlmacos.pod [.lib.pods]perlmacosx.pod [.lib.pods]perlmint.pod [.lib.pods]perlmod.pod -pod18 = [.lib.pods]perlmodinstall.pod [.lib.pods]perlmodlib.pod [.lib.pods]perlmodstyle.pod [.lib.pods]perlmpeix.pod [.lib.pods]perlnetware.pod -pod19 = [.lib.pods]perlnewmod.pod [.lib.pods]perlnumber.pod [.lib.pods]perlobj.pod [.lib.pods]perlop.pod [.lib.pods]perlopenbsd.pod -pod20 = [.lib.pods]perlopentut.pod [.lib.pods]perlos2.pod [.lib.pods]perlos390.pod [.lib.pods]perlos400.pod [.lib.pods]perlothrtut.pod +pod18 = [.lib.pods]perlmodinstall.pod [.lib.pods]perlmodlib.pod [.lib.pods]perlmodstyle.pod [.lib.pods]perlmpeix.pod [.lib.pods]perlmroapi.pod +pod19 = [.lib.pods]perlnetware.pod [.lib.pods]perlnewmod.pod [.lib.pods]perlnumber.pod [.lib.pods]perlobj.pod [.lib.pods]perlop.pod +pod20 = [.lib.pods]perlopenbsd.pod [.lib.pods]perlopentut.pod [.lib.pods]perlos2.pod [.lib.pods]perlos390.pod [.lib.pods]perlos400.pod [.lib.pods]perlothrtut.pod pod21 = [.lib.pods]perlpacktut.pod [.lib.pods]perlperf.pod [.lib.pods]perlplan9.pod [.lib.pods]perlpod.pod [.lib.pods]perlpodspec.pod [.lib.pods]perlport.pod pod22 = [.lib.pods]perlpragma.pod [.lib.pods]perlqnx.pod [.lib.pods]perlre.pod [.lib.pods]perlreapi.pod [.lib.pods]perlrebackslash.pod pod23 = [.lib.pods]perlrecharclass.pod [.lib.pods]perlref.pod [.lib.pods]perlreftut.pod [.lib.pods]perlreguts.pod [.lib.pods]perlrepository.pod @@ -1163,6 +1163,10 @@ makeppport : $(MINIPERL_EXE) $(ARCHDIR)Config.pm @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods] Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods] +[.lib.pods]perlmroapi.pod : [.pod]perlmroapi.pod + @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods] + Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods] + [.lib.pods]perlnetware.pod : [.pod]perlnetware.pod @ If F$Search("[.lib]pods.dir").eqs."" Then Create/Directory [.lib.pods] Copy/NoConfirm/Log $(MMS$SOURCE) [.lib.pods] diff --git a/win32/pod.mak b/win32/pod.mak index 26ff52e..3c94557 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -94,6 +94,7 @@ POD = \ perlmodinstall.pod \ perlmodlib.pod \ perlmodstyle.pod \ + perlmroapi.pod \ perlnewmod.pod \ perlnumber.pod \ perlobj.pod \ @@ -219,6 +220,7 @@ MAN = \ perlmodinstall.man \ perlmodlib.man \ perlmodstyle.man \ + perlmroapi.man \ perlnewmod.man \ perlnumber.man \ perlobj.man \ @@ -344,6 +346,7 @@ HTML = \ perlmodinstall.html \ perlmodlib.html \ perlmodstyle.html \ + perlmroapi.html \ perlnewmod.html \ perlnumber.html \ perlobj.html \ @@ -469,6 +472,7 @@ TEX = \ perlmodinstall.tex \ perlmodlib.tex \ perlmodstyle.tex \ + perlmroapi.tex \ perlnewmod.tex \ perlnumber.tex \ perlobj.tex \ -- Perl5 Master Repository
