diff options
Diffstat (limited to 'gnu/usr.bin')
132 files changed, 2979 insertions, 7693 deletions
diff --git a/gnu/usr.bin/perl/cpan/Archive-Extract/lib/Archive/Extract.pm b/gnu/usr.bin/perl/cpan/Archive-Extract/lib/Archive/Extract.pm index ae3af3edf82..08676fb1e08 100644 --- a/gnu/usr.bin/perl/cpan/Archive-Extract/lib/Archive/Extract.pm +++ b/gnu/usr.bin/perl/cpan/Archive-Extract/lib/Archive/Extract.pm @@ -1,5 +1,4 @@ package Archive::Extract; -use if $] > 5.017, 'deprecate'; use strict; @@ -16,10 +15,6 @@ use Locale::Maketext::Simple Style => 'gettext'; ### solaris has silly /bin/tar output ### use constant ON_SOLARIS => $^O eq 'solaris' ? 1 : 0; -use constant ON_NETBSD => $^O eq 'netbsd' ? 1 : 0; -use constant ON_OPENBSD => $^O eq 'openbsd' ? 1 : 0; -use constant ON_FREEBSD => $^O =~ m!^(free|midnight)bsd$! ? 1 : 0; -use constant ON_LINUX => $^O eq 'linux' ? 1 : 0; use constant FILE_EXISTS => sub { -e $_[0] ? 1 : 0 }; ### VMS may require quoting upper case command options @@ -30,7 +25,7 @@ use constant ON_WIN32 => $^O eq 'MSWin32' ? 1 : 0; ### we can't use this extraction method, because of missing ### modules/binaries: -use constant METHOD_NA => []; +use constant METHOD_NA => []; ### If these are changed, update @TYPES and the new() POD use constant TGZ => 'tgz'; @@ -41,14 +36,12 @@ use constant BZ2 => 'bz2'; use constant TBZ => 'tbz'; use constant Z => 'Z'; use constant LZMA => 'lzma'; -use constant XZ => 'xz'; -use constant TXZ => 'txz'; -use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG +use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG $_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER ]; -$VERSION = '0.68'; +$VERSION = '0.38'; $PREFER_BIN = 0; $WARN = 1; $DEBUG = 0; @@ -57,7 +50,7 @@ $_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, XZ, TXZ ); +my @Types = ( TGZ, TAR, GZ, ZIP, BZ2, TBZ, Z, LZMA ); local $Params::Check::VERBOSE = $Params::Check::VERBOSE = 1; @@ -98,8 +91,6 @@ Archive::Extract - A generic archive extracting mechanism $ae->is_bz2; # is it a .bz2 file? $ae->is_tbz; # is it a .tar.bz2 or .tbz file? $ae->is_lzma; # is it a .lzma file? - $ae->is_xz; # is it a .xz file? - $ae->is_txz; # is it a .tar.xz or .txz file? ### absolute path to the archive you provided ### $ae->archive; @@ -110,16 +101,14 @@ Archive::Extract - A generic archive extracting mechanism $ae->bin_unzip # path to /bin/unzip, if found $ae->bin_bunzip2 # path to /bin/bunzip2 if found $ae->bin_unlzma # path to /bin/unlzma if found - $ae->bin_unxz # path to /bin/unxz if found =head1 DESCRIPTION Archive::Extract is a generic archive extraction mechanism. It allows you to extract any archive file of the type .tar, .tar.gz, -.gz, .Z, tar.bz2, .tbz, .bz2, .zip, .xz,, .txz, .tar.xz or .lzma -without having to worry how it -does so, or use different interfaces for each type by using either +.gz, .Z, tar.bz2, .tbz, .bz2, .zip or .lzma without having to worry how it +does so, or use different interfaces for each type by using either perl modules, or commandline tools on your system. See the C<HOW IT WORKS> section further down for details. @@ -129,23 +118,7 @@ See the C<HOW IT WORKS> section further down for details. ### see what /bin/programs are available ### $PROGRAMS = {}; -CMD: for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma unxz]) { - if ( $pgm eq 'unzip' and ( ON_NETBSD or ON_FREEBSD ) ) { - local $IPC::Cmd::INSTANCES = 1; - ($PROGRAMS->{$pgm}) = grep { ON_NETBSD ? m!/usr/pkg/! : m!/usr/local! } can_run($pgm); - next CMD; - } - if ( $pgm eq 'unzip' and ON_LINUX ) { - # Check if 'unzip' is busybox masquerading - local $IPC::Cmd::INSTANCES = 1; - my $opt = ON_VMS ? '"-Z"' : '-Z'; - ($PROGRAMS->{$pgm}) = grep { scalar run(command=> [ $_, $opt, '-1' ]) } can_run($pgm); - next CMD; - } - if ( $pgm eq 'tar' and ON_OPENBSD || ON_SOLARIS ) { - # try gtar first - next CMD if $PROGRAMS->{$pgm} = can_run('gtar'); - } +for my $pgm (qw[tar unzip gzip bunzip2 uncompress unlzma]) { $PROGRAMS->{$pgm} = can_run($pgm); } @@ -159,11 +132,9 @@ my $Mapping = { # binary program # pure perl module is_bz2 => { bin => '_bunzip2_bin', pp => '_bunzip2_bz2'}, is_Z => { bin => '_uncompress_bin', pp => '_gunzip_cz' }, is_lzma => { bin => '_unlzma_bin', pp => '_unlzma_cz' }, - is_xz => { bin => '_unxz_bin', pp => '_unxz_cz' }, - is_txz => { bin => '_untar_bin', pp => '_untar_at' }, }; -{ ### use subs so we re-generate array refs etc for the no-override flags +{ ### use subs so we re-generate array refs etc for the no-overide flags ### if we don't, then we reuse the same arrayref, meaning objects store ### previous errors my $tmpl = { @@ -173,8 +144,8 @@ my $Mapping = { # binary program # pure perl module _error_msg_long => sub { { no_override => 1, default => [] } }, }; - ### build accessors ### - for my $method( keys %$tmpl, + ### build accesssors ### + for my $method( keys %$tmpl, qw[_extractor _gunzip_to files extract_path], ) { no strict 'refs'; @@ -230,7 +201,7 @@ Corresponds to a C<.bz2> suffix. =item tbz -Bzip2 compressed tar file, as produced by, for example C</bin/tar -j>. +Bzip2 compressed tar file, as produced by, for exmample C</bin/tar -j>. Corresponds to a C<.tbz> or C<.tar.bz2> suffix. =item lzma @@ -238,16 +209,6 @@ Corresponds to a C<.tbz> or C<.tar.bz2> suffix. Lzma compressed file, as produced by C</bin/lzma>. Corresponds to a C<.lzma> suffix. -=item xz - -Xz compressed file, as produced by C</bin/xz>. -Corresponds to a C<.xz> suffix. - -=item txz - -Xz compressed tar file, as produced by, for example C</bin/tar -J>. -Corresponds to a C<.txz> or C<.tar.xz> suffix. - =back Returns a C<Archive::Extract> object on success, or false on failure. @@ -258,7 +219,7 @@ Returns a C<Archive::Extract> object on success, or false on failure. sub new { my $class = shift; my %hash = @_; - + ### see above why we use subs here and generate the template; ### it's basically to not re-use arrayrefs my %utmpl = map { $_ => $tmpl->{$_}->() } keys %$tmpl; @@ -271,23 +232,21 @@ Returns a C<Archive::Extract> object on success, or false on failure. ### figure out the type, if it wasn't already specified ### unless ( $parsed->{type} ) { $parsed->{type} = - $ar =~ /.+?\.(?:tar\.gz|tgz)$/i ? TGZ : - $ar =~ /.+?\.gz$/i ? GZ : - $ar =~ /.+?\.tar$/i ? TAR : - $ar =~ /.+?\.(zip|jar|ear|war|par)$/i ? ZIP : - $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ : - $ar =~ /.+?\.bz2$/i ? BZ2 : - $ar =~ /.+?\.Z$/ ? Z : - $ar =~ /.+?\.lzma$/ ? LZMA : - $ar =~ /.+?\.(?:txz|tar\.xz)$/i ? TXZ : - $ar =~ /.+?\.xz$/ ? XZ : + $ar =~ /.+?\.(?:tar\.gz|tgz)$/i ? TGZ : + $ar =~ /.+?\.gz$/i ? GZ : + $ar =~ /.+?\.tar$/i ? TAR : + $ar =~ /.+?\.(zip|jar|par)$/i ? ZIP : + $ar =~ /.+?\.(?:tbz2?|tar\.bz2?)$/i ? TBZ : + $ar =~ /.+?\.bz2$/i ? BZ2 : + $ar =~ /.+?\.Z$/ ? Z : + $ar =~ /.+?\.lzma$/ ? LZMA : ''; } bless $parsed, $class; - ### don't know what type of file it is + ### don't know what type of file it is ### XXX this *has* to be an object call, not a package call return $parsed->_error(loc("Cannot determine file type for '%1'", $parsed->{archive} )) unless $parsed->{type}; @@ -301,11 +260,11 @@ Extracts the archive represented by the C<Archive::Extract> object to the path of your choice as specified by the C<to> argument. Defaults to C<cwd()>. -Since C<.gz> files never hold a directory, but only a single file; if -the C<to> argument is an existing directory, the file is extracted -there, with its C<.gz> suffix stripped. -If the C<to> argument is not an existing directory, the C<to> argument -is understood to be a filename, if the archive type is C<gz>. +Since C<.gz> files never hold a directory, but only a single file; if +the C<to> argument is an existing directory, the file is extracted +there, with its C<.gz> suffix stripped. +If the C<to> argument is not an existing directory, the C<to> argument +is understood to be a filename, if the archive type is C<gz>. In the case that you did not specify a C<to> argument, the output file will be the name of the archive file, stripped from its C<.gz> suffix, in the current working directory. @@ -354,20 +313,20 @@ sub extract { check( $tmpl, \%hash ) or return; - ### so 'to' could be a file or a dir, depending on whether it's a .gz + ### so 'to' could be a file or a dir, depending on whether it's a .gz ### file, or basically anything else. ### so, check that, then act accordingly. ### set an accessor specifically so _gunzip can know what file to extract ### to. my $dir; { ### a foo.gz file - if( $self->is_gz or $self->is_bz2 or $self->is_Z or $self->is_lzma or $self->is_xz ) { - - my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z|lzma|xz)$//i; - + if( $self->is_gz or $self->is_bz2 or $self->is_Z or $self->is_lzma ) { + + my $cp = $self->archive; $cp =~ s/\.(?:gz|bz2?|Z|lzma)$//i; + ### to is a dir? if ( -d $to ) { - $dir = $to; + $dir = $to; $self->_gunzip_to( basename($cp) ); ### then it's a filename @@ -408,7 +367,7 @@ sub extract { ### ../lib/Archive/Extract.pm line 742. (rt #19815) $self->files( [] ); - ### find out the dispatch methods needed for this type of + ### find out the dispatch methods needed for this type of ### archive. Do a $self->is_XXX to figure out the type, then ### get the hashref with bin + pure perl dispatchers. my ($map) = map { $Mapping->{$_} } grep { $self->$_ } keys %$Mapping; @@ -417,30 +376,30 @@ sub extract { my @methods; push @methods, $map->{'pp'} if $_ALLOW_PURE_PERL; push @methods, $map->{'bin'} if $_ALLOW_BIN; - + ### reverse it if we prefer bin extractors @methods = reverse @methods if $PREFER_BIN; my($na, $fail); for my $method (@methods) { - $self->debug( "# Extracting with ->$method\n" ); - + print "# Extracting with ->$method\n" if $DEBUG; + my $rv = $self->$method; - + ### a positive extraction if( $rv and $rv ne METHOD_NA ) { - $self->debug( "# Extraction succeeded\n" ); + print "# Extraction succeeded\n" if $DEBUG; $self->_extractor($method); last; - + ### method is not available - } elsif ( $rv and $rv eq METHOD_NA ) { - $self->debug( "# Extraction method not available\n" ); - $na++; + } elsif ( $rv and $rv eq METHOD_NA ) { + print "# Extraction method not available\n" if $DEBUG; + $na++; } else { - $self->debug( "# Extraction method failed\n" ); + print "# Extraction method failed\n" if $DEBUG; $fail++; - } + } } ### warn something went wrong if we didn't get an extractor @@ -448,10 +407,10 @@ sub extract { my $diag = $fail ? loc("Extract failed due to errors") : $na ? loc("Extract failed; no extractors available") : ''; - + $self->_error($diag); $ok = 0; - } + } } ### and chdir back ### @@ -532,11 +491,6 @@ See the C<new()> method for details. Returns true if the file is of type C<.lzma>. See the C<new()> method for details. -=head2 $ae->is_xz - -Returns true if the file is of type C<.xz>. -See the C<new()> method for details. - =cut ### quick check methods ### @@ -548,8 +502,6 @@ sub is_tbz { return $_[0]->type eq TBZ } sub is_bz2 { return $_[0]->type eq BZ2 } sub is_Z { return $_[0]->type eq Z } sub is_lzma { return $_[0]->type eq LZMA } -sub is_xz { return $_[0]->type eq XZ } -sub is_txz { return $_[0]->type eq TXZ } =pod @@ -569,10 +521,6 @@ Returns the full path to your unzip binary, if found Returns the full path to your unlzma binary, if found -=head2 $ae->bin_unxz - -Returns the full path to your unxz binary, if found - =cut ### paths to commandline tools ### @@ -580,10 +528,9 @@ sub bin_gzip { return $PROGRAMS->{'gzip'} if $PROGRAMS->{'gzip'} } sub bin_unzip { return $PROGRAMS->{'unzip'} if $PROGRAMS->{'unzip'} } sub bin_tar { return $PROGRAMS->{'tar'} if $PROGRAMS->{'tar'} } sub bin_bunzip2 { return $PROGRAMS->{'bunzip2'} if $PROGRAMS->{'bunzip2'} } -sub bin_uncompress { return $PROGRAMS->{'uncompress'} +sub bin_uncompress { return $PROGRAMS->{'uncompress'} if $PROGRAMS->{'uncompress'} } sub bin_unlzma { return $PROGRAMS->{'unlzma'} if $PROGRAMS->{'unlzma'} } -sub bin_unxz { return $PROGRAMS->{'unxz'} if $PROGRAMS->{'unxz'} } =head2 $bool = $ae->have_old_bunzip2 @@ -600,7 +547,7 @@ sub have_old_bunzip2 { ### no bunzip2? no old bunzip2 either :) return unless $self->bin_bunzip2; - ### if we can't run this, we can't be sure if it's too old or not + ### if we can't run this, we can't be sure if it's too old or not ### XXX stupid stupid stupid bunzip2 doesn't understand --version ### is not a request to extract data: ### $ bunzip2 --version @@ -611,7 +558,7 @@ sub have_old_bunzip2 { ### $ echo $? ### 1 ### HATEFUL! - + ### double hateful: bunzip2 --version also hangs if input is a pipe ### See #32370: Archive::Extract will hang if stdin is a pipe [+PATCH] ### So, we have to provide *another* argument which is a fake filename, @@ -619,7 +566,7 @@ sub have_old_bunzip2 { ### *sigh* ### Even if the file exists, it won't clobber or change it. my $buffer; - scalar run( + scalar run( command => [$self->bin_bunzip2, '--version', 'NoSuchFile'], verbose => 0, buffer => \$buffer @@ -627,7 +574,7 @@ sub have_old_bunzip2 { ### no output return unless $buffer; - + my ($version) = $buffer =~ /version \s+ (\d+)/ix; return 1 if $version < 1; @@ -650,77 +597,69 @@ sub have_old_bunzip2 { ### if this is gnu tar we are running, we need to use --force-local push @ExtraTarFlags, '--force-local' if `$cmd --version` =~ /gnu tar/i; - } + } ### use /bin/tar to extract ### sub _untar_bin { my $self = shift; - + ### check for /bin/tar ### ### check for /bin/gzip if we need it ### ### if any of the binaries are not available, return NA - { my $diag = !$self->bin_tar ? + { my $diag = not $self->bin_tar ? loc("No '%1' program found", '/bin/tar') : - $self->is_tgz && !$self->bin_gzip ? + $self->is_tgz && !$self->bin_gzip ? loc("No '%1' program found", '/bin/gzip') : $self->is_tbz && !$self->bin_bunzip2 ? loc("No '%1' program found", '/bin/bunzip2') : - $self->is_txz && !$self->bin_unxz ? - loc("No '%1' program found", '/bin/unxz') : ''; - + if( $diag ) { $self->_error( $diag ); return METHOD_NA; } - } - + } + ### XXX figure out how to make IPC::Run do this in one call -- ### currently i don't know how to get output of a command after a pipe ### trapped in a scalar. Mailed barries about this 5th of june 2004. - + ### see what command we should run, based on whether ### it's a .tgz or .tar - - ### GNU tar can't handled VMS filespecs, but VMSTAR can handle Unix filespecs. - my $archive = $self->archive; - $archive = VMS::Filespec::unixify($archive) if ON_VMS; - + ### XXX solaris tar and bsdtar are having different outputs ### depending whether you run with -x or -t ### compensate for this insanity by running -t first, then -x - { my $cmd = - $self->is_tgz ? [$self->bin_gzip, '-cdf', $archive, '|', + { my $cmd = + $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|', $self->bin_tar, '-tf', '-'] : - $self->is_tbz ? [$self->bin_bunzip2, '-cd', $archive, '|', + $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|', $self->bin_tar, '-tf', '-'] : - $self->is_txz ? [$self->bin_unxz, '-cd', $archive, '|', - $self->bin_tar, '-tf', '-'] : - [$self->bin_tar, @ExtraTarFlags, '-tf', $archive]; - - ### run the command + [$self->bin_tar, @ExtraTarFlags, '-tf', $self->archive]; + + ### run the command ### newer versions of 'tar' (1.21 and up) now print record size - ### to STDERR as well if v OR t is given (used to be both). This + ### to STDERR as well if v OR t is given (used to be both). This ### is a 'feature' according to the changelog, so we must now only ### inspect STDOUT, otherwise, failures like these occur: - ### http://www.cpantesters.org/cpan/report/3230366 + ### nntp.perl.org/group/perl.cpan.testers/2009/02/msg3230366.html my $buffer = ''; my @out = run( command => $cmd, buffer => \$buffer, verbose => $DEBUG ); - ### command was unsuccessful - unless( $out[0] ) { + ### command was unsuccessful + unless( $out[0] ) { return $self->_error(loc( "Error listing contents of archive '%1': %2", - $archive, $buffer )); + $self->archive, $buffer )); } - + ### no buffers available? if( !IPC::Cmd->can_capture_buffer and !$buffer ) { - $self->_error( $self->_no_buffer_files( $archive ) ); - + $self->_error( $self->_no_buffer_files( $self->archive ) ); + } else { ### if we're on solaris we /might/ be using /bin/tar, which has ### a weird output format... we might also be using @@ -733,46 +672,44 @@ sub have_old_bunzip2 { \s+ [\d,.]+ \s bytes, \s+ [\d,.]+ \s tape \s blocks |x ? $1 : $_); - - ### only STDOUT, see above. Sometimes, extra whitespace + + ### only STDOUT, see above. Sometims, extra whitespace ### is present, so make sure we only pick lines with ### a length - } grep { length } map { split $/, $_ } join '', @{$out[3]}; - + } grep { length } map { split $/, $_ } @{$out[3]}; + ### store the files that are in the archive ### $self->files(\@files); } } - + ### now actually extract it ### - { my $cmd = - $self->is_tgz ? [$self->bin_gzip, '-cdf', $archive, '|', - $self->bin_tar, '-xf', '-'] : - $self->is_tbz ? [$self->bin_bunzip2, '-cd', $archive, '|', + { my $cmd = + $self->is_tgz ? [$self->bin_gzip, '-cdf', $self->archive, '|', $self->bin_tar, '-xf', '-'] : - $self->is_txz ? [$self->bin_unxz, '-cd', $archive, '|', + $self->is_tbz ? [$self->bin_bunzip2, '-cd', $self->archive, '|', $self->bin_tar, '-xf', '-'] : - [$self->bin_tar, @ExtraTarFlags, '-xf', $archive]; - + [$self->bin_tar, @ExtraTarFlags, '-xf', $self->archive]; + my $buffer = ''; unless( scalar run( command => $cmd, buffer => \$buffer, verbose => $DEBUG ) ) { return $self->_error(loc("Error extracting archive '%1': %2", - $archive, $buffer )); + $self->archive, $buffer )); } - + ### we might not have them, due to lack of buffers if( $self->files ) { ### now that we've extracted, figure out where we extracted to my $dir = $self->__get_extract_dir( $self->files ); - + ### store the extraction dir ### $self->extract_path( $dir ); } } - + ### we got here, no error happened return 1; } @@ -791,7 +728,7 @@ sub _untar_at { ### so users don't have to even think about this variable. If they ### do, they still get their set value outside of this call. local $Archive::Tar::WARN = $Archive::Tar::WARN; - + ### we definitely need Archive::Tar, so load that first { my $use_list = { 'Archive::Tar' => '0.0' }; @@ -800,7 +737,7 @@ sub _untar_at { $self->_error(loc("You do not have '%1' installed - " . "Please install it as soon as possible.", 'Archive::Tar')); - + return METHOD_NA; } } @@ -822,7 +759,7 @@ sub _untar_at { "You do not have '%1' installed - Please ". "install it as soon as possible.", $which) ); - + return METHOD_NA; } @@ -831,10 +768,10 @@ sub _untar_at { unless( can_load( modules => $use_list ) ) { $self->_error(loc( "You do not have '%1' installed - Please " . - "install it as soon as possible.", + "install it as soon as possible.", 'IO::Uncompress::Bunzip2') ); - + return METHOD_NA; } @@ -844,24 +781,6 @@ sub _untar_at { $IO::Uncompress::Bunzip2::Bunzip2Error)); $fh_to_read = $bz; - } elsif ( $self->is_txz ) { - my $use_list = { 'IO::Uncompress::UnXz' => '0.0' }; - unless( can_load( modules => $use_list ) ) { - $self->_error(loc( - "You do not have '%1' installed - Please " . - "install it as soon as possible.", - 'IO::Uncompress::UnXz') - ); - - return METHOD_NA; - } - - my $xz = IO::Uncompress::UnXz->new( $self->archive ) or - return $self->_error(loc("Unable to open '%1': %2", - $self->archive, - $IO::Uncompress::UnXz::UnXzError)); - - $fh_to_read = $xz; } my @files; @@ -883,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)); } @@ -918,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", @@ -1081,15 +1000,15 @@ sub _unzip_bin { unless( $self->bin_unzip ) { $self->_error(loc("No '%1' program found", '/bin/unzip')); return METHOD_NA; - } + } ### first, get the files.. it must be 2 different commands with 'unzip' :( { ### on VMS, capital letter options have to be quoted. This is - ### reported by John Malmberg on P5P Tue 21 Aug 2007 05:05:11 + ### peported by John Malmberg on P5P Tue 21 Aug 2007 05:05:11 ### Subject: [patch@31735]Archive Extract fix on VMS. my $opt = ON_VMS ? '"-Z"' : '-Z'; my $cmd = [ $self->bin_unzip, $opt, '-1', $self->archive ]; - + my $buffer = ''; unless( scalar run( command => $cmd, verbose => $DEBUG, @@ -1104,10 +1023,6 @@ sub _unzip_bin { $self->_error( $self->_no_buffer_files( $self->archive ) ); } else { - ### Annoyingly, pesky MSWin32 can either have 'native' tools - ### which have \r\n line endings or Cygwin-based tools which - ### have \n line endings. Jan Dubois suggested using this fix - local $/ = ON_WIN32 ? qr/\r?\n/ : "\n"; $self->files( [split $/, $buffer] ); } } @@ -1142,7 +1057,7 @@ sub _unzip_az { unless( can_load( modules => $use_list ) ) { $self->_error(loc("You do not have '%1' installed - Please " . "install it as soon as possible.", 'Archive::Zip')); - return METHOD_NA; + return METHOD_NA; } my $zip = Archive::Zip->new(); @@ -1152,8 +1067,8 @@ sub _unzip_az { } my @files; - - + + ### Address: #43278: Explicitly tell Archive::Zip where to put the files: ### "In my BackPAN indexing, Archive::Zip was extracting things ### in my script's directory instead of the current working directory. @@ -1161,21 +1076,21 @@ sub _unzip_az { ### eventually calls File::Spec::Win32::rel2abs which on Windows might ### call Cwd::getdcwd. getdcwd returns the wrong directory in my ### case, even though I think I'm on the same drive. - ### + ### ### To fix this, I pass the optional second argument to ### extractMember using the cwd from Archive::Extract." --bdfoy ## store cwd() before looping; calls to cwd() can be expensive, and ### it won't change during the loop my $extract_dir = cwd(); - + ### have to extract every member individually ### for my $member ($zip->members) { push @files, $member->{fileName}; - ### file to extract to, to avoid the above problem + ### file to extact to, to avoid the above problem my $to = File::Spec->catfile( $extract_dir, $member->{fileName} ); - + unless( $zip->extractMember($member, $to) == &Archive::Zip::AZ_OK ) { return $self->_error(loc("Extraction of '%1' from '%2' failed", $member->{fileName}, $self->archive )); @@ -1207,27 +1122,27 @@ sub __get_extract_dir { ### which was the problem in bug #23999 my $res = -d $files->[$pos] ? File::Spec->catdir( $files->[$pos], '' ) - : File::Spec->catdir( dirname( $files->[$pos] ) ); + : File::Spec->catdir( dirname( $files->[$pos] ) ); $$dir = $res; } - ### if the first and last dir don't match, make sure the + ### if the first and last dir don't match, make sure the ### dirname is not set wrongly my $dir; - + ### dirs are the same, so we know for sure what the extract dir is if( $dir1 eq $dir2 ) { $dir = $dir1; - + ### dirs are different.. do they share the base dir? ### if so, use that, if not, fall back to '.' } else { my $base1 = [ File::Spec->splitdir( $dir1 ) ]->[0]; my $base2 = [ File::Spec->splitdir( $dir2 ) ]->[0]; - - $dir = File::Spec->rel2abs( $base1 eq $base2 ? $base1 : '.' ); - } + + $dir = File::Spec->rel2abs( $base1 eq $base2 ? $base1 : '.' ); + } return File::Spec->rel2abs( $dir ); } @@ -1245,12 +1160,12 @@ sub _bunzip2_bin { unless( $self->bin_bunzip2 ) { $self->_error(loc("No '%1' program found", '/bin/bunzip2')); return METHOD_NA; - } + } my $fh = FileHandle->new('>'. $self->_gunzip_to) or return $self->_error(loc("Could not open '%1' for writing: %2", $self->_gunzip_to, $! )); - + ### guard against broken bunzip2. See ->have_old_bunzip2() ### for details if( $self->have_old_bunzip2 and $self->archive !~ /\.bz2$/i ) { @@ -1274,7 +1189,7 @@ sub _bunzip2_bin { if( !IPC::Cmd->can_capture_buffer and !$buffer ) { $self->_error( $self->_no_buffer_content( $self->archive ) ); } - + $self->_print($fh, $buffer) if defined $buffer; close $fh; @@ -1290,31 +1205,31 @@ sub _bunzip2_bin { ### extractor.. # sub _bunzip2_cz1 { # my $self = shift; -# +# # my $use_list = { 'IO::Uncompress::Bunzip2' => '0.0' }; # unless( can_load( modules => $use_list ) ) { # return $self->_error(loc("You do not have '%1' installed - Please " . # "install it as soon as possible.", # 'IO::Uncompress::Bunzip2')); # } -# +# # my $bz = IO::Uncompress::Bunzip2->new( $self->archive ) or # return $self->_error(loc("Unable to open '%1': %2", # $self->archive, # $IO::Uncompress::Bunzip2::Bunzip2Error)); -# +# # my $fh = FileHandle->new('>'. $self->_gunzip_to) or # return $self->_error(loc("Could not open '%1' for writing: %2", # $self->_gunzip_to, $! )); -# +# # my $buffer; # $fh->print($buffer) while $bz->read($buffer) > 0; # $fh->close; -# +# # ### set what files where extract, and where they went ### # $self->files( [$self->_gunzip_to] ); # $self->extract_path( File::Spec->rel2abs(cwd()) ); -# +# # return 1; # } @@ -1326,7 +1241,7 @@ sub _bunzip2_bz2 { $self->_error(loc("You do not have '%1' installed - Please " . "install it as soon as possible.", 'IO::Uncompress::Bunzip2')); - return METHOD_NA; + return METHOD_NA; } IO::Uncompress::Bunzip2::bunzip2($self->archive => $self->_gunzip_to) @@ -1341,75 +1256,6 @@ sub _bunzip2_bz2 { return 1; } -################################# -# -# UnXz code -# -################################# - -sub _unxz_bin { - my $self = shift; - - ### check for /bin/unxz -- we need it ### - unless( $self->bin_unxz ) { - $self->_error(loc("No '%1' program found", '/bin/unxz')); - return METHOD_NA; - } - - my $fh = FileHandle->new('>'. $self->_gunzip_to) or - return $self->_error(loc("Could not open '%1' for writing: %2", - $self->_gunzip_to, $! )); - - my $cmd = [ $self->bin_unxz, '-cdf', $self->archive ]; - - my $buffer; - unless( scalar run( command => $cmd, - verbose => $DEBUG, - buffer => \$buffer ) - ) { - return $self->_error(loc("Unable to unxz '%1': %2", - $self->archive, $buffer)); - } - - ### no buffers available? - if( !IPC::Cmd->can_capture_buffer and !$buffer ) { - $self->_error( $self->_no_buffer_content( $self->archive ) ); - } - - $self->_print($fh, $buffer) if defined $buffer; - - close $fh; - - ### set what files where extract, and where they went ### - $self->files( [$self->_gunzip_to] ); - $self->extract_path( File::Spec->rel2abs(cwd()) ); - - return 1; -} - -sub _unxz_cz { - my $self = shift; - - my $use_list = { 'IO::Uncompress::UnXz' => '0.0' }; - unless( can_load( modules => $use_list ) ) { - $self->_error(loc("You do not have '%1' installed - Please " . - "install it as soon as possible.", - 'IO::Uncompress::UnXz')); - return METHOD_NA; - } - - IO::Uncompress::UnXz::unxz($self->archive => $self->_gunzip_to) - or return $self->_error(loc("Unable to uncompress '%1': %2", - $self->archive, - $IO::Uncompress::UnXz::UnXzError)); - - ### set what files where extract, and where they went ### - $self->files( [$self->_gunzip_to] ); - $self->extract_path( File::Spec->rel2abs(cwd()) ); - - return 1; -} - ################################# # @@ -1424,7 +1270,7 @@ sub _unlzma_bin { unless( $self->bin_unlzma ) { $self->_error(loc("No '%1' program found", '/bin/unlzma')); return METHOD_NA; - } + } my $fh = FileHandle->new('>'. $self->_gunzip_to) or return $self->_error(loc("Could not open '%1' for writing: %2", @@ -1460,37 +1306,27 @@ sub _unlzma_bin { sub _unlzma_cz { my $self = shift; - my $use_list1 = { 'IO::Uncompress::UnLzma' => '0.0' }; - my $use_list2 = { 'Compress::unLZMA' => '0.0' }; - - if (can_load( modules => $use_list1 ) ) { - IO::Uncompress::UnLzma::unlzma($self->archive => $self->_gunzip_to) - or return $self->_error(loc("Unable to uncompress '%1': %2", - $self->archive, - $IO::Uncompress::UnLzma::UnLzmaError)); + my $use_list = { 'Compress::unLZMA' => '0.0' }; + unless( can_load( modules => $use_list ) ) { + $self->_error(loc("You do not have '%1' installed - Please " . + "install it as soon as possible.", 'Compress::unLZMA')); + return METHOD_NA; } - elsif (can_load( modules => $use_list2 ) ) { - my $fh = FileHandle->new('>'. $self->_gunzip_to) or - return $self->_error(loc("Could not open '%1' for writing: %2", - $self->_gunzip_to, $! )); + my $fh = FileHandle->new('>'. $self->_gunzip_to) or + return $self->_error(loc("Could not open '%1' for writing: %2", + $self->_gunzip_to, $! )); - my $buffer; - $buffer = Compress::unLZMA::uncompressfile( $self->archive ); - unless ( defined $buffer ) { - return $self->_error(loc("Could not unlzma '%1': %2", - $self->archive, $@)); - } + my $buffer; + $buffer = Compress::unLZMA::uncompressfile( $self->archive ); + unless ( defined $buffer ) { + return $self->_error(loc("Could not unlzma '%1': %2", + $self->archive, $@)); + } - $self->_print($fh, $buffer) if defined $buffer; + $self->_print($fh, $buffer) if defined $buffer; - close $fh; - } - else { - $self->_error(loc("You do not have '%1' or '%2' installed - Please " . - "install it as soon as possible.", 'Compress::unLZMA', 'IO::Uncompress::UnLzma')); - return METHOD_NA; - } + close $fh; ### set what files where extract, and where they went ### $self->files( [$self->_gunzip_to] ); @@ -1521,7 +1357,7 @@ sub _error { push @{$self->_error_msg}, $error; push @{$self->_error_msg_long}, $lerror; - + ### set $Archive::Extract::WARN to 0 to disable printing ### of errors if( $WARN ) { @@ -1535,30 +1371,15 @@ sub error { my $self = shift; ### make sure we have a fallback aref - my $aref = do { - shift() - ? $self->_error_msg_long - : $self->_error_msg + my $aref = do { + shift() + ? $self->_error_msg_long + : $self->_error_msg } || []; - + return join $/, @$aref; } -=head2 debug( MESSAGE ) - -This method outputs MESSAGE to the default filehandle if C<$DEBUG> is -true. It's a small method, but it's here if you'd like to subclass it -so you can so something else with any debugging output. - -=cut - -### this is really a stub for subclassing -sub debug { - return unless $DEBUG; - - print $_[1]; -} - sub _no_buffer_files { my $self = shift; my $file = shift or return; @@ -1600,7 +1421,7 @@ C<Archive::Extract> will not be able to extract the archive for you. =head2 Supporting Very Large Files C<Archive::Extract> can use either pure perl modules or command line -programs under the hood. Some of the pure perl modules (like +programs under the hood. Some of the pure perl modules (like C<Archive::Tar> and Compress::unLZMA) take the entire contents of the archive into memory, which may not be feasible on your system. Consider setting the global variable C<$Archive::Extract::PREFER_BIN> to C<1>, which will prefer @@ -1610,7 +1431,7 @@ See the C<GLOBAL VARIABLES> section below for details. =head2 Bunzip2 support of arbitrary extensions. -Older versions of C</bin/bunzip2> do not support arbitrary file +Older versions of C</bin/bunzip2> do not support arbitrary file extensions and insist on a C<.bz2> suffix. Although we do our best to guard against this, if you experience a bunzip2 error, it may be related to this. For details, please see the C<have_old_bunzip2> @@ -1661,14 +1482,14 @@ the type, rather than blindly trust the suffix. =item Thread safety Currently, C<Archive::Extract> does a C<chdir> to the extraction dir before -extraction, and a C<chdir> back again after. This is not necessarily +extraction, and a C<chdir> back again after. This is not necessarily thread safe. See C<rt.cpan.org> bug C<#45671> for details. =back =head1 BUG REPORTS -Please report bugs or other issues to E<lt>bug-archive-extract@rt.cpan.orgE<gt>. +Please report bugs or other issues to E<lt>bug-archive-extract@rt.cpan.org<gt>. =head1 AUTHOR @@ -1676,7 +1497,7 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut diff --git a/gnu/usr.bin/perl/cpan/Archive-Extract/t/01_Archive-Extract.t b/gnu/usr.bin/perl/cpan/Archive-Extract/t/01_Archive-Extract.t index cb67d277562..93c90266106 100755 --- a/gnu/usr.bin/perl/cpan/Archive-Extract/t/01_Archive-Extract.t +++ b/gnu/usr.bin/perl/cpan/Archive-Extract/t/01_Archive-Extract.t @@ -1,8 +1,15 @@ +BEGIN { + if( $ENV{PERL_CORE} ) { + chdir '../lib/Archive/Extract' if -d '../lib/Archive/Extract'; + unshift @INC, '../../..', '../../../..'; + } +} + BEGIN { chdir 't' if -d 't' }; BEGIN { mkdir 'out' unless -d 'out' }; ### left behind, at least on Win32. See core patch #31904 -END { rmtree('out') }; +END { rmtree('out') }; use strict; use lib qw[../lib]; @@ -41,13 +48,13 @@ my $Class = 'Archive::Extract'; use_ok($Class); ### debug will always be enabled on dev versions -my $Debug = (not $ENV{PERL_CORE} and +my $Debug = (not $ENV{PERL_CORE} and ($ARGV[0] or $Archive::Extract::VERSION =~ /_/)) - ? 1 + ? 1 : 0; -my $Self = File::Spec->rel2abs( - IS_WIN32 ? &Win32::GetShortPathName( cwd() ) : cwd() +my $Self = File::Spec->rel2abs( + IS_WIN32 ? &Win32::GetShortPathName( cwd() ) : cwd() ); my $SrcDir = File::Spec->catdir( $Self,'src' ); my $OutDir = File::Spec->catdir( $Self,'out' ); @@ -104,73 +111,32 @@ my $tmpl = { modules => [qw[Archive::Zip]], method => 'is_zip', outfile => 'a', - }, - 'x.ear' => { programs => [qw[unzip]], - modules => [qw[Archive::Zip]], - method => 'is_zip', - outfile => 'a', - }, - 'x.war' => { programs => [qw[unzip]], - modules => [qw[Archive::Zip]], - method => 'is_zip', - outfile => 'a', - }, + }, 'x.par' => { programs => [qw[unzip]], modules => [qw[Archive::Zip]], method => 'is_zip', outfile => 'a', - }, + }, 'x.lzma' => { programs => [qw[unlzma]], modules => [qw[Compress::unLZMA]], method => 'is_lzma', outfile => 'a', }, - 'x.xz' => { programs => [qw[unxz]], - modules => [qw[IO::Uncompress::UnXz]], - method => 'is_xz', - outfile => 'a', - }, - 'x.txz' => { programs => [qw[unxz tar]], - modules => [qw[Archive::Tar - IO::Uncompress::UnXz]], - method => 'is_txz', - outfile => 'a', - }, - 'x.tar.xz'=> { programs => [qw[unxz tar]], - modules => [qw[Archive::Tar - IO::Uncompress::UnXz]], - method => 'is_txz', - outfile => 'a', - }, ### with a directory 'y.tbz' => { programs => [qw[bunzip2 tar]], - modules => [qw[Archive::Tar + modules => [qw[Archive::Tar IO::Uncompress::Bunzip2]], method => 'is_tbz', outfile => 'z', outdir => 'y', }, 'y.tar.bz2' => { programs => [qw[bunzip2 tar]], - modules => [qw[Archive::Tar + modules => [qw[Archive::Tar IO::Uncompress::Bunzip2]], method => 'is_tbz', outfile => 'z', outdir => 'y' - }, - 'y.txz' => { programs => [qw[unxz tar]], - modules => [qw[Archive::Tar - IO::Uncompress::UnXz]], - method => 'is_txz', - outfile => 'z', - outdir => 'y', - }, - 'y.tar.xz' => { programs => [qw[unxz tar]], - modules => [qw[Archive::Tar - IO::Uncompress::UnXz]], - method => 'is_txz', - outfile => 'z', - outdir => 'y' - }, + }, 'y.tgz' => { programs => [qw[gzip tar]], modules => [qw[Archive::Tar IO::Zlib]], method => 'is_tgz', @@ -207,18 +173,6 @@ my $tmpl = { outfile => 'z', outdir => 'y' }, - 'y.ear' => { programs => [qw[unzip]], - modules => [qw[Archive::Zip]], - method => 'is_zip', - outfile => 'z', - outdir => 'y' - }, - 'y.war' => { programs => [qw[unzip]], - modules => [qw[Archive::Zip]], - method => 'is_zip', - outfile => 'z', - outdir => 'y' - }, ### with non-same top dir 'double_dir.zip' => { programs => [qw[unzip]], @@ -238,7 +192,7 @@ my $tmpl = { delete $tmpl->{'y.tbz'}; diag "Old bunzip2 detected, skipping .tbz test"; } -} +} ### show us the tools IPC::Cmd will use to run binary programs if( $Debug ) { @@ -258,34 +212,34 @@ if( $Debug ) { my @types = $Class->$meth; ok( scalar(@types), " Got a list of types" ); - + for my $type ( @types ) { my $obj = $Class->new( archive => $Me, type => $type ); ok( $obj, " Object created based on '$type'" ); ok( !$obj->error, " No error logged" ); } - + ### test unknown type { ### must turn on warnings to catch error here local $Archive::Extract::WARN = 1; - + my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; - + my $ae = $Class->new( archive => $Me ); ok( !$ae, " No archive created based on '$Me'" ); ok( !$Class->error, " Error not captured in class method" ); ok( $warnings, " Error captured as warning" ); like( $warnings, qr/Cannot determine file type for/, " Error is: unknown file type" ); - } -} + } +} ### test multiple errors ### XXX whitebox test { ### grab a random file from the template, so we can make an object - my $ae = Archive::Extract->new( - archive => File::Spec->catfile($SrcDir,[keys %$tmpl]->[0]) + my $ae = Archive::Extract->new( + archive => File::Spec->catfile($SrcDir,[keys %$tmpl]->[0]) ); ok( $ae, "Archive created" ); ok( not($ae->error), " No errors yet" ); @@ -297,28 +251,28 @@ if( $Debug ) { my $err = $ae->error; ok( $err, " Errors retrieved" ); - + my $expect = join $/, 1..5; is( $err, $expect, " As expected" ); ### this resets the errors - ### override the 'check' routine to return false, so we bail out of + ### override the 'check' routine to return false, so we bail out of ### extract() early and just run the error reset code; { no warnings qw[once redefine]; - local *Archive::Extract::check = sub { return }; + local *Archive::Extract::check = sub { return }; $ae->extract; } ok( not($ae->error), " Errors erased after ->extract() call" ); } ### XXX whitebox test -### test __get_extract_dir +### test __get_extract_dir SKIP: { my $meth = '__get_extract_dir'; ### get the right separator -- File::Spec does clean ups for ### paths, so we need to join ourselves. my $sep = [ split '', File::Spec->catfile( 'a', 'b' ) ]->[1]; - + ### bug #23999: Attempt to generate Makefile.PL gone awry ### showed that dirs in the style of './dir/' were reported ### to be unpacked in '.' rather than in 'dir'. here we test @@ -332,17 +286,17 @@ SKIP: { my $meth = '__get_extract_dir'; ### build a list like [dir, dir/file] and [./dir ./dir/file] ### where the dir and file actually exist, which is important ### for the method call - my @files = map { length $prefix + my @files = map { length $prefix ? join $sep, $prefix, $_ : $_ } $dir, File::Spec->catfile( $dir, [keys %$tmpl]->[0] ); - + my $res = $Class->$meth( \@files ); $res = &Win32::GetShortPathName( $res ) if IS_WIN32; ok( $res, "Found extraction dir '$res'" ); is( $res, $SrcDir, " Is expected dir '$SrcDir'" ); - } + } } ### configuration to run in: allow perl or allow binaries @@ -351,11 +305,10 @@ for my $switch ( [0,1], [1,0] ) { local $Archive::Extract::_ALLOW_PURE_PERL = $switch->[0]; local $Archive::Extract::_ALLOW_BIN = $switch->[1]; - + diag("Running extract with configuration: $cfg") if $Debug; for my $archive (keys %$tmpl) { - diag("Archive : $archive") if $Debug; ### check first if we can do the proper @@ -365,25 +318,26 @@ for my $switch ( [0,1], [1,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_txz is_tar]; + 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, .txz - local $Archive::Extract::_ALLOW_TAR_ITER = $tar_iter; - + ### Doesn't matter unless .tar, .tbz, .tgz + local $Archive::Extract::_ALLOW_TAR_ITER = $tar_iter; + diag("Archive::Tar->iter: $tar_iter") if $Debug; isa_ok( $ae, $Class ); my $method = $tmpl->{$archive}->{method}; - ok( $ae->$method(), "Archive type $method recognized properly" ); + 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 ); @@ -411,16 +365,16 @@ for my $switch ( [0,1], [1,0] ) { ### 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 || $ae->is_xz - ? ($abs_path) + 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, + ) { + skip "No binaries or modules to extract ".$archive, (10 * scalar @outs); } @@ -428,7 +382,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 ### @@ -448,13 +402,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 @@ -462,42 +416,42 @@ 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 while 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 whether 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; 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, @@ -513,15 +467,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> @@ -529,25 +483,25 @@ 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 successfully removed" ); + " Extract dir succesfully removed" ); } } } diff --git a/gnu/usr.bin/perl/cpan/CPAN/Changes b/gnu/usr.bin/perl/cpan/CPAN/Changes index 8e6d6e2f8f9..1b5300cf5fb 100644 --- a/gnu/usr.bin/perl/cpan/CPAN/Changes +++ b/gnu/usr.bin/perl/cpan/CPAN/Changes @@ -1,200 +1,3 @@ -2013-04-12 Andreas Koenig <k@UX31A> - - * release 2.00 (at Lancester #QA2013) - - * Removed the trial status for the release in the Makefile.PL - - * Merge with App::Cpan 0.61 (just a version number change) - -2013-02-06 k <k@k83.linux.bogus> - - * release 2.00-TRIAL - - * import App::Cpan 0.60_02 from brian d foy - - * RT#82589 doc fix thanks to Zefram - - * several portability fixes for 5.6.2 - - * RT#83042 workaround for current circular dependency in CPANPLUS and - CPANPLUS::Dist::Build - -2012-10-16 Andreas Koenig <andreas.koenig.7os6VVqR@franz.ak.mind.de> - - * release 1.99_51 - - * RT #79969: fix incompatibilities with VMS (Craig Berry) - - * bugfix: distroprefs of type pl/args were dropped for 'perl Build.PL' - - * RT #73742: watch build_dirs and react calmly when one has gone lost - -2011-08-07 Andreas J. Koenig <andk@cpan.org> - - * release 1.9800 - - * RT #69463: fix memory leak in CacheMgr (Serguei Trouchelle) - -2011-06-27 Andreas J. Koenig <andk@cpan.org> - - * release 1.97_51 - - * address #68835: Changed read_meta to ignore dynamic_config (David Golden) - - * bugfix: refuse to store_persistent if the own build_dir is not - available (Andreas Koenig) - - * cosmetics: remove "Going to" from the beginning of user-visible - strings (Jesse Vincent) - - * flock adjustments for Win32 from activestate (Christian Walde) - -2011-03-12 Andreas J. Koenig <andk@cpan.org> - - * release 1.9600 - - * Added PAUSE batch signing key 2011 to the distribution - - * Make t/00signature.t skip if verification fails. The user - shouldn't be prevented from installing if their gpg isn't - configured correctly, but we still run this to see diagnostics - - * Major highlights: - - - much less configuration dialog hassle - - support for META/MYMETA.json - - support for local::lib - - support for HTTP::Tiny to reduce the dependency on ftp sites - - automatic mirror selection - - iron out all known bugs in configure_requires - - support for distributions compressed with bzip2 - - allow Foo/Bar.pm on the commandline to mean Foo::Bar - - for more see Changes file for the 0.94_51 to 0.94_65 dev releases - -2011-02-14 David Golden <dagolden@cpan.org> - - * release 1.94_65 - - * Adds support for META/MYMETA.json files if CPAN::Meta is - installed - - * Adds HOMEDRIVE/HOMEPATH or USERPROFILE as home directory - options on Windows - - * fixes a minor test bug related to Makefile timeskews - - * fixes a minor test bug related to Makefile timeskews - - * various documentation typo fixes - -2011-01-20 David Golden <dagolden@cpan.org> - - * release 1.94_64 - - * remove 'use_file_homedir' config option and fix #62986 using - a more robust method. Original config directories will be found - even if File::HomeDir is installed - - * streamline configuration intro text - - * add missing documentation for 'atexit' and local::lib bootstrap - -2011-01-16 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_63 - - * address #63357: use Dumpvalue when dumping potential crap (Andreas - Koenig) - - * address #62986: new config option use_file_homedir (Andreas Koenig) - - * address #64037: new config option prefer_external_tar (Andreas Koenig) - - * add support for bootstrapping local::lib when the user does not have - write access to perl's site library directories (David Golden) - - * add support for (and prerequisite on) HTTP::Tiny; also adds - prerequisites for MIME::Base64 and Digest::MD5 to support proxy - authentication (David Golden) - - * automatic mirror selection now returns only http mirrors (David - Golden) - - * add 'atexit' option for cache scanning and cleanup (David Golden) - - * now with 421 distroprefs files (but a good portion of them seems - outdated) - -2010-10-26 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_62 - - * address RT #62064: build_requires_install_policy set to "no" did not - work correctly (reported by Xavier Bergade) - - * address RT ##55091: don't ask the proxy credentials if proxy_user - empty (fixed by Robert Bohne) - - * address RT #55093: no_proxy doesn't work with more then one entries - (fixed by Robert Bohne) - -2010-10-03 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_61 - - * address RT #61735: stop talking about sending test reports by email (Schwern) - - * prevent the use of old versions of Parse::CPAN::Meta which caused test failures - - * bandaid for native solaris patch program to actually do patching - -2010-09-28 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_60 - - * improvements to find_perl() by David Golden - - * test fixes to address the issues demonstrated by some cpantesters - -2010-09-26 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_59 - - * address RT #61607: make the FTP download code more robust (Reini Urban) - - * omit useless arithmetic in CPAN::Version to possibly help netbsd - (reported by Nigel Horne and suggested David Golden) - - * address RT #59216: make sure $builddir exists before calling tempdir - (Lee Goddard) - - * a couple of new distropref files - -2010-06-24 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_58 - - * bugfix: Non-English locales got no diagnostics on a failed locking due - to permissions (reported by Frank Wiegand) - - * chasing test failures with test fixes. - -2010-05-24 Andreas J. Koenig <andk@cpan.org> - - * release 1.94_57 - - * bugfix: treat modules correctly that are deprecated in perl 5.12. - - * bugfix: RT #57482 and #57788 revealed that configure_requires - implicitly assumed build_requires instead of normal requires. (Reported - by Andrew Whatson and Father Chrysostomos respectively) - - * testfix: solaris should run the tests without expect because (some?) - solaris have a broken expect - - * testfix: run tests with cache_metadata off to prevent spill over - effects from previous test runs - 2010-02-17 Andreas J. Koenig <andk@cpan.org> * release 1.94_56 diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build.pm b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build.pm index d938749c825..0f27639cda5 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build.pm @@ -1,7 +1,5 @@ package CPANPLUS::Dist::Build; -use if $] > 5.017, 'deprecate'; - use strict; use warnings; use vars qw[@ISA $STATUS $VERSION]; @@ -12,7 +10,7 @@ use CPANPLUS::Internals::Constants; ### these constants were exported by CPANPLUS::Internals::Constants ### in previous versions.. they do the same though. If we want to have ### a normal 'use' here, up the dependency to CPANPLUS 0.056 or higher -BEGIN { +BEGIN { require CPANPLUS::Dist::Build::Constants; CPANPLUS::Dist::Build::Constants->import() if not __PACKAGE__->can('BUILD') && __PACKAGE__->can('BUILD_DIR'); @@ -32,7 +30,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; local $Params::Check::VERBOSE = 1; -$VERSION = '0.70'; +$VERSION = '0.46'; =pod @@ -46,8 +44,8 @@ CPANPLUS::Dist::Build - CPANPLUS plugin to install packages that use Build.PL format => 'CPANPLUS::Dist::Build', module => $modobj, ); - - $build->prepare; # runs Build.PL + + $build->prepare; # runs Build.PL $build->create; # runs build && build test $build->install; # runs build install @@ -60,7 +58,7 @@ Using this package, you can create, install and uninstall perl modules. It inherits from C<CPANPLUS::Dist>. Normal users won't have to worry about the interface to this module, -as it functions transparently as a plug-in to C<CPANPLUS> and will +as it functions transparently as a plug-in to C<CPANPLUS> and will just C<Do The Right Thing> when it's loaded. =head1 ACCESSORS @@ -100,17 +98,17 @@ BOOL indicating if the C<Build test> command was successful. =item C<prepared ()> -BOOL indicating if the C<prepare> call exited successfully +BOOL indicating if the C<prepare> call exited succesfully This gets set after C<perl Build.PL> =item C<distdir ()> Full path to the directory in which the C<prepare> call took place, -set after a call to C<prepare>. +set after a call to C<prepare>. =item C<created ()> -BOOL indicating if the C<create> call exited successfully. This gets +BOOL indicating if the C<create> call exited succesfully. This gets set after C<Build> and C<Build test>. =item C<installed ()> @@ -147,8 +145,8 @@ to create and install modules in your environment. ### check if the format is available ### sub format_available { - my $mod = 'Module::Build'; - unless( can_load( modules => { $mod => '0.2611' }, nocache => 1 ) ) { + my $mod = "Module::Build"; + unless( can_load( modules => { $mod => '0.2611' } ) ) { error( loc( "You do not have '%1' -- '%2' not available", $mod, __PACKAGE__ ) ); return; @@ -186,15 +184,15 @@ sub init { =head2 $bool = $dist->prepare([perl => '/path/to/perl', buildflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) -C<prepare> prepares a distribution, running C<Build.PL> +C<prepare> prepares a distribution, running C<Build.PL> and establishing any prerequisites this distribution has. -The variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path +The variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the C<Build.PL> that is being executed. This enables any code inside the C<Build.PL> to know that it is being installed via CPANPLUS. -After a successful C<prepare> you may call C<create> to create the +After a succcesfull C<prepare> you may call C<create> to create the distribution, followed by C<install> to actually install it. Returns true on success and false on failure. @@ -234,9 +232,9 @@ sub prepare { perl => { default => $^X, store => \$perl }, buildflags => { default => $conf->get_conf('buildflags'), store => \$buildflags }, - prereq_target => { default => '', store => \$prereq_target }, + prereq_target => { default => '', store => \$prereq_target }, prereq_format => { default => '', - store => \$prereq_format }, + store => \$prereq_format }, prereq_build => { default => 0, store => \$prereq_build }, }; @@ -271,20 +269,19 @@ sub prepare { my @buildflags = $dist->_buildflags_as_list( $buildflags ); $dist->status->_buildflags( $buildflags ); - my $fail; my $prereq_fail; - my $status = { }; + my $fail; RUN: { # 0.85_01 ### we resolve 'configure requires' here, so we can run the 'perl ### Makefile.PL' command ### XXX for tests: mock f_c_r to something that *can* resolve and - ### something that *doesn't* resolve. Check the error log for ok + ### something that *doesnt* resolve. Check the error log for ok ### on this step or failure - ### XXX make a separate tarball to test for this scenario: simply + ### XXX make a seperate tarball to test for this scenario: simply ### containing a makefile.pl/build.pl for test purposes? my $safe_ver = version->new('0.85_01'); if ( version->new($CPANPLUS::Internals::VERSION) >= $safe_ver ) - { my $configure_requires = $dist->find_configure_requires; + { my $configure_requires = $dist->find_configure_requires; my $ok = $dist->_resolve_prereqs( format => $prereq_format, verbose => $verbose, @@ -292,19 +289,18 @@ sub prepare { target => $prereq_target, force => $force, prereq_build => $prereq_build, - ); - + ); + unless( $ok ) { - + #### use $dist->flush to reset the cache ### error( loc( "Unable to satisfy '%1' for '%2' " . - "-- aborting install", - 'configure_requires', $self->module ) ); + "-- aborting install", + 'configure_requires', $self->module ) ); $dist->status->prepared(0); - $prereq_fail++; - $fail++; + $fail++; last RUN; - } + } ### end of prereq resolving ### } @@ -314,27 +310,14 @@ sub prepare { my $env = ENV_CPANPLUS_IS_EXECUTING; local $ENV{$env} = BUILD_PL->( $dir ); - my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); - my $cmd = [$perl, @run_perl, BUILD_PL->($dir), @buildflags]; + my $run_perl = $conf->get_program('perlwrapper'); + my $cmd = [$perl, $run_perl, BUILD_PL->($dir), @buildflags]; unless ( scalar run( command => $cmd, buffer => \$prep_output, - verbose => $verbose ) + verbose => $verbose ) ) { error( loc( "Build.PL failed: %1", $prep_output ) ); - if ( $conf->get_conf('cpantest') ) { - $status->{stage} = 'prepare'; - $status->{capture} = $prep_output; - } - $fail++; last RUN; - } - - unless ( BUILD->( $dir ) ) { - error( loc( "Build.PL failed to generate a Build script: %1", $prep_output ) ); - if ( $conf->get_conf('cpantest') ) { - $status->{stage} = 'prepare'; - $status->{capture} = $prep_output; - } $fail++; last RUN; } @@ -342,20 +325,19 @@ sub prepare { my $prereqs = $self->status->prereqs; - $prereqs ||= $dist->_find_prereqs( verbose => $verbose, - dir => $dir, + $prereqs ||= $dist->_find_prereqs( verbose => $verbose, + dir => $dir, perl => $perl, buildflags => $buildflags ); } - + ### send out test report? ### - if( $fail and $conf->get_conf('cpantest') and not $prereq_fail ) { - $cb->_send_report( + if( $fail and $conf->get_conf('cpantest') ) { + $cb->_send_report( module => $self, failed => $fail, buffer => CPANPLUS::Error->stack_as_string, - status => $status, verbose => $verbose, force => $force, ) or error(loc("Failed to send test report for '%1'", @@ -388,7 +370,7 @@ sub _find_prereqs { buildflags => { default => $conf->get_conf('buildflags'), store => \$buildflags }, }; - + my $args = check( $tmpl, \%hash ) or return; my $prereqs = {}; @@ -407,11 +389,11 @@ sub _find_prereqs { my @buildflags = $dist->_buildflags_as_list( $buildflags ); # Use the new Build action 'prereq_data' - my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); + my $run_perl = $conf->get_program('perlwrapper'); - unless ( scalar run( command => [$perl, @run_perl, BUILD->($dir), 'prereq_data', @buildflags], + unless ( scalar run( command => [$perl, $run_perl, BUILD->($dir), 'prereq_data', @buildflags], buffer => \$content, - verbose => 0 ) + verbose => 0 ) ) { error( loc( "Build 'prereq_data' failed: %1 %2", $!, $content ) ); #return; @@ -431,7 +413,7 @@ sub _find_prereqs { error( loc( "Cannot open '%1': %2", $file, $! ) ); return; } - + $content = do { local $/; <$fh> }; } @@ -444,12 +426,8 @@ sub _find_prereqs { $prereqs->{$_} = $bphash->{$type}->{$_} for keys %{ $bphash->{$type} }; } } - - { - delete $prereqs->{'perl'} - unless version->new($CPANPLUS::Internals::VERSION) - >= version->new('0.9102'); - } + # Temporary fix + delete $prereqs->{'perl'}; ### allows for a user defined callback to filter the prerequisite ### list as they see fit, to remove (or add) any prereqs they see @@ -529,7 +507,7 @@ sub create { prereq_format => { #default => $self->status->installer_type, default => '', store => \$prereq_format }, - prereq_build => { default => 0, store => \$prereq_build }, + prereq_build => { default => 0, store => \$prereq_build }, }; $args = check( $tmpl, \%hash ) or return; @@ -585,10 +563,9 @@ sub create { $dist->status->_buildflags( $buildflags ); my $fail; my $prereq_fail; my $test_fail; - my $status = { }; RUN: { - my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); + my $run_perl = $conf->get_program('perlwrapper'); ### this will set the directory back to the start ### dir, so we must chdir /again/ @@ -620,19 +597,15 @@ sub create { $cmd = [$perl, BUILD->($dir), @buildflags]; } else { - $cmd = [$perl, @run_perl, BUILD->($dir), @buildflags]; + $cmd = [$perl, $run_perl, BUILD->($dir), @buildflags]; } unless ( scalar run( command => $cmd, buffer => \$captured, - verbose => $verbose ) + verbose => $verbose ) ) { error( loc( "MAKE failed:\n%1", $captured ) ); $dist->status->build(0); - if ( $conf->get_conf('cpantest') ) { - $status->{stage} = 'build'; - $status->{capture} = $captured; - } $fail++; last RUN; } @@ -643,8 +616,8 @@ sub create { ### add this directory to your lib ### $self->add_to_includepath(); - ### this buffer will not include what tests failed due to a - ### M::B/Test::Harness bug. Reported as #9793 with patch + ### this buffer will not include what tests failed due to a + ### M::B/Test::Harness bug. Reported as #9793 with patch ### against 0.2607 on 26/1/2005 unless( $skiptest ) { my $test_output; @@ -652,13 +625,13 @@ sub create { $cmd = [$perl, BUILD->($dir), "test", @buildflags]; } else { - $cmd = [$perl, @run_perl, BUILD->($dir), "test", @buildflags]; + $cmd = [$perl, $run_perl, BUILD->($dir), "test", @buildflags]; } unless ( scalar run( command => $cmd, buffer => \$test_output, - verbose => $verbose ) + verbose => $verbose ) ) { - error( loc( "MAKE TEST failed:\n%1 ", $test_output ), ( $verbose ? 0 : 1 ) ); + error( loc( "MAKE TEST failed:\n%1 ", $test_output ) ); ### mark specifically *test* failure.. so we dont ### send success on force... @@ -668,23 +641,16 @@ sub create { $self, $@ ) ) { $dist->status->test(0); - if ( $conf->get_conf('cpantest') ) { - $status->{stage} = 'test'; - $status->{capture} = $test_output; - } $fail++; last RUN; } - } + } else { msg( loc( "MAKE TEST passed:\n%1", $test_output ), 0 ); + #msg( $test_output, 0 ); $dist->status->test(1); - if ( $conf->get_conf('cpantest') ) { - $status->{stage} = 'test'; - $status->{capture} = $test_output; - } } - } + } else { msg(loc("Tests skipped"), $verbose); } @@ -700,7 +666,6 @@ sub create { module => $self, failed => $test_fail || $fail, buffer => CPANPLUS::Error->stack_as_string, - status => $status, verbose => $verbose, force => $force, tests_skipped => $skiptest, @@ -733,7 +698,7 @@ sub install { my $conf = $cb->configure_object; my %hash = @_; - + my $verbose; my $perl; my $force; my $buildflags; { local $Params::Check::ALLOW_UNKNOWN = 1; my $tmpl = { @@ -745,7 +710,7 @@ sub install { store => \$buildflags }, perl => { default => $^X, store => \$perl }, }; - + my $args = check( $tmpl, \%hash ) or return; $dist->status->_install_args( $args ); } @@ -764,7 +729,7 @@ sub install { } ### value set and false -- means failure ### - if( defined $self->status->installed && + if( defined $self->status->installed && !$self->status->installed && !$force ) { error( loc( "Module '%1' has failed to install before this session " . @@ -774,7 +739,7 @@ sub install { my $fail; my @buildflags = $dist->_buildflags_as_list( $buildflags ); - my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); + my $run_perl = $conf->get_program('perlwrapper'); ### hmm, how is this going to deal with sudo? ### for now, check effective uid, if it's not root, @@ -789,19 +754,11 @@ sub install { $cmd = [$perl, BUILD->($dir), "install", @buildflags]; } else { - $cmd = [$perl, @run_perl, BUILD->($dir), "install", @buildflags]; + $cmd = [$perl, $run_perl, BUILD->($dir), "install", @buildflags]; } - - ### Detect local::lib type behaviour. Do not use 'sudo' in these cases my $sudo = $conf->get_program('sudo'); - SUDO: { - ### Actual local::lib in use - last SUDO if defined $ENV{PERL_MB_OPT} and $ENV{PERL_MB_OPT} =~ m!install_base!; - ### 'buildflags' is configured with '--install_base' - last SUDO if scalar grep { m!install_base! } @buildflags; - ### oh well 'sudo make me a sandwich' - unshift @$cmd, $sudo; - } + unshift @$cmd, $sudo if $sudo; + my $buffer; unless( scalar run( command => $cmd, @@ -817,7 +774,7 @@ sub install { $cmd = [$perl, BUILD->($dir), "install", @buildflags]; } else { - $cmd = [$perl, @run_perl, BUILD->($dir), "install", @buildflags]; + $cmd = [$perl, $run_perl, BUILD->($dir), "install", @buildflags]; } unless( scalar run( command => $cmd, buffer => \$install_output, diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build/Constants.pm b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build/Constants.pm index f020093c9c7..1ac02108e44 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build/Constants.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/lib/CPANPLUS/Dist/Build/Constants.pm @@ -1,7 +1,5 @@ package CPANPLUS::Dist::Build::Constants; -use if $] > 5.017, 'deprecate'; - use strict; use warnings; use File::Spec; @@ -10,31 +8,28 @@ BEGIN { require Exporter; use vars qw[$VERSION @ISA @EXPORT]; - - $VERSION = '0.70'; + + $VERSION = '0.46'; @ISA = qw[Exporter]; - @EXPORT = qw[ BUILD_DIR BUILD CPDB_PERL_WRAPPER]; + @EXPORT = qw[ BUILD_DIR BUILD ]; } use constant BUILD_DIR => sub { return @_ ? File::Spec->catdir($_[0], '_build') : '_build'; - }; + }; use constant BUILD => sub { my $file = @_ ? File::Spec->catfile($_[0], 'Build') : 'Build'; - + ### on VMS, '.com' is appended when ### creating the Build file - $file .= '.com' if $^O eq 'VMS'; - + $file .= '.com' if $^O eq 'VMS'; + return $file; }; - - -use constant CPDB_PERL_WRAPPER => 'use strict; BEGIN { my $old = select STDERR; $|++; select $old; $|++; $0 = shift(@ARGV); my $rv = do($0); die $@ if $@; }'; - + 1; =head1 NAME diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/02_CPANPLUS-Dist-Build.t b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/02_CPANPLUS-Dist-Build.t index 945a906516a..23f939831c8 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/02_CPANPLUS-Dist-Build.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/02_CPANPLUS-Dist-Build.t @@ -145,10 +145,7 @@ while( my($path,$need_cc) = each %Map ) { SKIP: { skip("Install tests require Module::Build 0.2606 or higher", 2) unless $Module::Build::VERSION >= '0.2606'; - - local $ENV{MODULEBUILDRC}; - local $ENV{PERL_MB_OPT}; - + ### flush the lib cache ### otherwise, cpanplus thinks the module's already installed ### since the blib is already in @INC diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/inc/conf.pl b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/inc/conf.pl index 2eec6222ef3..506b3ed6eb3 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/inc/conf.pl +++ b/gnu/usr.bin/perl/cpan/CPANPLUS-Dist-Build/t/inc/conf.pl @@ -195,7 +195,7 @@ sub gimme_conf { ### cpanp-run-perl installed the same amount of 'uplevels' ### as the /tmp/foo prefix, we'll pull in the wrong script ### by accident. - ### Since we set the path to cpanp-run-perl explicitly + ### Since we set the path to cpanp-run-perl explicitily ### at the top of this script, it's best to update the config ### ourselves with a path lookup, rather than rely on its ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist b/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist index b4fadf552b9..5ba4556c529 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/bin/cpan2dist @@ -40,7 +40,7 @@ GetOptions( $opts, 'default-ignorelist!', 'edit-metafile!', 'install!' ); - + die usage() if exists $opts->{'help'}; ### parse options @@ -49,14 +49,12 @@ my $keep = $opts->{'keepsource'} ? 1 : 0; my $prereqbuild = exists $opts->{'buildprereq'} ? $opts->{'buildprereq'} : 0; -my $timeout = exists $opts->{'timeout'} - ? $opts->{'timeout'} +my $timeout = exists $opts->{'timeout'} + ? $opts->{'timeout'} : 300; ### use default answers? -unless ( $ENV{'PERL_MM_USE_DEFAULT'} ) { - $ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0; -} +$ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0; my $format; ### if provided, we go with the command line option, fall back to conf setting @@ -64,7 +62,7 @@ my $format; $conf->set_conf( dist_type => $format ); ### is this a valid format?? - die loc("Invalid format: " . ($format || "[NONE]") ) . usage() + die loc("Invalid format: " . ($format || "[NONE]") ) . usage() unless $formats{$format}; ### any options to fix config entries @@ -72,14 +70,14 @@ my $format; while( my($key,$val) = each %$set_conf ) { $conf->set_conf( $key => $val ); } - } + } ### any options to fix program entries { my $set_prog = $opts->{'set-program'} || {}; while( my($key,$val) = each %$set_prog ) { $conf->set_program( $key => $val ); } - } + } ### any other options passed { my %map = ( verbose => 'verbose', @@ -87,54 +85,54 @@ my $format; skiptest => 'skiptest', makefile => 'prefer_makefile' ); - - ### set config options from arguments + + ### set config options from arguments while (my($key,$val) = each %map) { - my $bool = exists $opts->{$key} - ? $opts->{$key} + my $bool = exists $opts->{$key} + ? $opts->{$key} : $conf->get_conf($val); $conf->set_conf( $val => $bool ); - } - } + } + } } my @modules = @ARGV; if( exists $opts->{'modulelist'} ) { - push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} }; -} + push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} }; +} die usage() unless @modules; ### set up munge callback if requested { if( $opts->{'edit-metafile'} ) { my $editor = $conf->get_program('editor'); - + if( $editor ) { - + ### register install callback ### $cb->_register_callback( name => 'munge_dist_metafile', code => sub { my $self = shift; my $text = shift or return; - + my($fh,$file) = tempfile( UNLINK => 1 ); - + unless( print $fh $text ) { warn "Could not print metafile information: $!"; return; } - + close $fh; - + system( $editor => $file ); - + my $cont = $cb->_get_file_contents( file => $file ); - + return $cont; }, ); - + } else { warn "No editor configured. Can not edit metafiles!\n"; } @@ -144,13 +142,13 @@ die usage() unless @modules; my $fh; LOGFILE: { if( my $file = $opts->{logfile} ) { - open $fh, ">$file" or ( + open $fh, ">$file" or ( warn loc("Could not open '%1' for writing: %2", $file,$!), last LOGFILE - ); - + ); + warn "Logging to '$file'\n"; - + *STDERR = $fh; *STDOUT = $fh; } @@ -159,7 +157,7 @@ LOGFILE: { ### reload indices if so desired $cb->reload_indices() if $opts->{'flushcache'}; -{ my @ban = exists $opts->{'ban'} +{ my @ban = exists $opts->{'ban'} ? map { qr/$_/ } @{ $opts->{'ban'} } : (); @@ -167,54 +165,54 @@ $cb->reload_indices() if $opts->{'flushcache'}; if( exists $opts->{'banlist'} ) { push @ban, map { parse_file( $_, 1 ) } @{ $opts->{'banlist'} }; } - + push @ban, map { s/\s+//; $_ } map { [split /\s*#\s*/]->[0] } grep { /#/ } - map { split /\n/ } _default_ban_list() + map { split /\n/ } _default_ban_list() if $opts->{'default-banlist'}; - - ### use our prereq install callback + + ### use our prereq install callback $conf->set_conf( prereqs => PREREQ_ASK ); - + ### register install callback ### $cb->_register_callback( name => 'install_prerequisite', code => \&__ask_about_install, ); - + ### check for ban patterns when handling prereqs sub __ask_about_install { - + my $mod = shift or return; my $prereq = shift or return; - - + + ### die with an error object, so we can verify that ### the die came from this location, and that it's an ### 'acceptable' death my $pat = ban_me( $prereq ); die bless sub { loc("Module '%1' requires '%2' to be installed " . "but found in your ban list (%3) -- skipping", - $mod->module, $prereq->module, $pat ) + $mod->module, $prereq->module, $pat ) }, PREREQ_SKIP_CLASS if $pat; return 1; - } - + } + ### should we skip this module? sub ban_me { my $mod = shift; - + for my $pat ( @ban ) { return $pat if $mod->module =~ /$pat/i; } return; } -} +} ### patterns to strip from prereq lists -{ my @ignore = exists $opts->{'ignore'} +{ my @ignore = exists $opts->{'ignore'} ? map { qr/$_/ } @{ $opts->{'ignore'} } : (); @@ -225,10 +223,10 @@ $cb->reload_indices() if $opts->{'flushcache'}; push @ignore, map { s/\s+//; $_ } map { [split /\s*#\s*/]->[0] } grep { /#/ } - map { split /\n/ } _default_ignore_list() + map { split /\n/ } _default_ignore_list() if $opts->{'default-ignorelist'}; - + ### register install callback ### $cb->_register_callback( name => 'filter_prereqs', @@ -238,7 +236,7 @@ $cb->reload_indices() if $opts->{'flushcache'}; sub __filter_prereqs { my $cb = shift; my $href = shift; - + for my $name ( keys %$href ) { my $obj = $cb->parse_module( module => $name ) or ( warn "Cannot make a module object out of ". @@ -249,44 +247,44 @@ $cb->reload_indices() if $opts->{'flushcache'}; warn loc("'%1' found in your ignore list (%2) ". "-- filtering it out\n", $name, $pat); - delete $href->{ $name }; + delete $href->{ $name }; } } return $href; } - + ### should we skip this module? sub ignore_me { my $mod = shift; - + for my $pat ( @ignore ) { return $pat if $mod->module =~ /$pat/i; return $pat if $mod->package_name =~ /$pat/i; } return; - } -} + } +} my %done; for my $name (@modules) { my $obj; - + ### is it a tarball? then we get it locally and transform it ### and its dependencies into .debs if( $tarball ) { ### make sure we use an absolute path, so chdirs() dont ### mess things up - $name = File::Spec->rel2abs( $name ); + $name = File::Spec->rel2abs( $name ); ### ENOTARBALL? unless( -e $name ) { warn loc("Archive '$name' does not exist"); next; } - + $obj = CPANPLUS::Module::Fake->new( module => basename($name), path => dirname($name), @@ -303,7 +301,7 @@ for my $name (@modules) { ### set the location of the tarball $obj->status->fetch($name); - ### plain old cpan module? + ### plain old cpan module? } else { ### find the corresponding module object ### @@ -318,26 +316,26 @@ for my $name (@modules) { warn loc("'%1' found in your ban list (%2) -- skipping\n", $obj->module, $pat ); next; - } - - ### or just ignored it? + } + + ### or just ignored it? if( my $pat = ignore_me( $obj ) ) { warn loc("'%1' found in your ignore list (%2) -- skipping\n", $obj->module, $pat ); next; - } - + } + my $target = $opts->{'install'} ? 'install' : 'create'; - my $dist = eval { + my $dist = eval { local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS } if $timeout; - + alarm $timeout || 0; my $dist_opts = $opts->{'dist-opts'} || {}; - my $rv = $obj->install( + my $rv = $obj->install( prereq_target => $target, target => $target, keep_source => $keep, @@ -346,32 +344,32 @@ for my $name (@modules) { ### any passed arbitrary options %$dist_opts, ); - - alarm 0; + + alarm 0; $rv; - }; - + }; + ### set here again, in case the install dies alarm 0; ### install failed due to a 'die' in our prereq skipper? if( $@ and ref $@ and $@->isa( PREREQ_SKIP_CLASS ) ) { - warn loc("Dist creation of '%1' skipped: '%2'", + warn loc("Dist creation of '%1' skipped: '%2'", $obj->module, $@->() ); next; } elsif ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) { warn loc("\nDist creation of '%1' skipped, build time exceeded: ". "%2 seconds\n", $obj->module, $timeout ); - next; + next; ### died for some other reason? just report and skip } elsif ( $@ ) { warn loc("Dist creation of '%1' failed: '%2'", $obj->module, $@ ); next; - } + } ### we didn't get a dist object back? unless ($dist and $obj->status->dist) { @@ -398,7 +396,7 @@ sub parse_file { s/^(\S+).*/$1/; # skip extra info push @rv, $qr ? qr/$_/ : $_; # add pattern to the list } - + return @rv; } @@ -430,11 +428,11 @@ sub usage { Usage: cpan2dist [--format FMT] [OPTS] Mod::Name [Mod::Name, ...] cpan2dist [--format FMT] [OPTS] --modulelist /tmp/mods.list - cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2] + cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2] Will create a distribution of type FMT of the modules specified on the command line, and all their prerequisites. - + Can also create a distribution of type FMT from a local archive and all of its prerequisites. @@ -446,21 +444,21 @@ $formats You can install more formats from CPAN! \n]; - + $usage .= << '=cut'; =pod - + Options: ### take no argument: --help Show this help message --install Install this package (and any prerequisites you built) - after building it. + after building it. --skiptest Skip tests. Can be negated using --noskiptest --force Force operation. Can be negated using --noforce --verbose Be verbose. Can be negated using --noverbose --keepsource Keep sources after building distribution. Can be - negated by --nokeepsource. May not be supported + negated by --nokeepsource. May not be supported by all formats --makefile Prefer Makefile.PL over Build.PL. Can be negated using --nomakefile. Defaults to your config setting @@ -484,7 +482,7 @@ Options: Are appended to the ban list built up by --ban May be given multiple times. --ignore Patterns of modules to exclude from prereq list. Useful - for when a prereq listed by a CPAN module is resolved + for when a prereq listed by a CPAN module is resolved in another way than from its corresponding CPAN package (Match is done on both module name, and package name of the package the module is in, case-insensitive) @@ -497,71 +495,71 @@ Options: --logfile File to log all output to. By default, all output goes to the console. --timeout The allowed time for buliding a distribution before - aborting. This is useful to terminate any build that - hang or happen to be interactive despite being told not - to be. Defaults to 300 seconds. To turn off, you can + aborting. This is useful to terminate any build that + hang or happen to be interactive despite being told not + to be. Defaults to 300 seconds. To turn off, you can set it to 0. --set-config Change any options as specified in your config for this - invocation only. See CPANPLUS::Config for a list of + invocation only. See CPANPLUS::Config for a list of supported options. --set-program Change any programs as specified in your config for this - invocation only. See CPANPLUS::Config for a list of + invocation only. See CPANPLUS::Config for a list of supported programs. --dist-opts Arbitrary options passed along to the chosen installer format's prepare()/create() routine. Please see the - documentation of the installer of your choice for + documentation of the installer of your choice for options it accepts. ### builtin lists --default-banlist Use our builtin banlist. Works just like --ban and --banlist, but with pre-set lists. See the "Builtin Lists" section for details. - --default-ignorelist Use our builtin ignorelist. Works just like - --ignore and --ignorelist but with pre-set lists. + --default-ignorelist Use our builtin ignorelist. Works just like + --ignore and --ignorelist but with pre-set lists. See the "Builtin Lists" section for details. Examples: - ### build a debian package of DBI and its prerequisites, + ### build a debian package of DBI and its prerequisites, ### don't bother running tests cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI - + ### build a debian package of DBI and its prerequisites and install them cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --install DBI - - ### Build a package, whose format is determined by your config, of + + ### Build a package, whose format is determined by your config, of ### the local tarball, reloading cpanplus' indices first and using ### the tarballs Makefile.PL if it has one. cpan2dist --makefile --flushcache --archive /path/to/Cwd-1.0.tgz - + ### build a package from Net::FTP, but dont build any packages or - ### dependencies whose name match 'Foo', 'Bar' or any of the + ### dependencies whose name match 'Foo', 'Bar' or any of the ### patterns mentioned in /tmp/ban cpan2dist --ban Foo --ban Bar --banlist /tmp/ban Net::FTP - + ### build a package from Net::FTP, but ignore its listed dependency ### on IO::Socket, as it's shipped per default with the OS we're on cpan2dist --ignore IO::Socket Net::FTP - + ### building all modules listed, plus their prerequisites - cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban - --modulelist /tmp/modules.list --buildprereq --flushcache + cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban + --modulelist /tmp/modules.list --buildprereq --flushcache --makefile --defaults - + ### pass arbitrary options to the format's prepare()/create() routine cpan2dist --dist-opts deb_version=3 --dist-opts prefix=corp =cut - + $usage .= qq[ Builtin Lists: Ignore list:] . _default_ignore_list() . qq[ Ban list:] . _default_ban_list(); - + ### strip the pod directives $usage =~ s/=pod\n//g; - + return $usage; } @@ -581,10 +579,10 @@ if you like, or supply your own if need be. =head2 Built-In Ignore List -=pod +=pod You can use this list of regexes to ignore modules matching -to be listed as prerequisites of a package. Particularly useful +to be listed as prerequisites of a package. Particulaly useful if they are bundled with core-perl anyway and they have known issues building. @@ -601,9 +599,9 @@ sub _default_ignore_list { ^Cwd$ # Provided with core anyway ^File::Spec # Provided with core anyway ^Config$ # Perl's own config, not shipped separately - ^ExtUtils::MakeMaker$ # Shipped with perl, recent versions + ^ExtUtils::MakeMaker$ # Shipped with perl, recent versions # have bug 14721 (see rt.cpan.org) - ^ExtUtils::Install$ # Part of of EU::MM, same reason + ^ExtUtils::Install$ # Part of of EU::MM, same reason =cut @@ -626,7 +624,7 @@ sub _default_ban_list { ^GD$ # Needs c libaries ^Berk.*DB # DB packages require specific options & linking - ^DBD:: # DBD drivers require database files/headers + ^DBD:: # DBD drives require database files/headers ^XML:: # XML modules usually require expat libraries Apache # These usually require apache libraries SSL # These usually require SSL certificates & libs @@ -657,10 +655,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm index e0ff071b34c..b61771b242c 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS.pm @@ -1,5 +1,4 @@ package CPANPLUS; -use deprecate; use strict; use Carp; @@ -14,7 +13,7 @@ BEGIN { use vars qw( @EXPORT @ISA $VERSION ); @EXPORT = qw( shell fetch get install ); @ISA = qw( Exporter ); - $VERSION = "0.9135"; #have to hardcode or cpan.org gets unhappy + $VERSION = "0.90"; #have to hardcode or cpan.org gets unhappy } ### purely for backward compatibility, so we can call it from the commandline: @@ -114,7 +113,7 @@ CPANPLUS - API & CLI access to the CPAN mirrors $ perl -MCPANPLUS -eshell $ perl -MCPANPLUS -e'fetch Some::Module' - + =head1 DESCRIPTION The C<CPANPLUS> library is an API to the C<CPAN> mirrors and a @@ -125,21 +124,21 @@ that use this API. =head2 GENERAL USAGE -This is the document you are currently reading. It describes -basic usage and background information. Its main purpose is to +This is the document you are currently reading. It describes +basic usage and background information. Its main purpose is to assist the user who wants to learn how to invoke CPANPLUS and install modules from the commandline and to point you to more indepth reading if required. =head2 API REFERENCE -The C<CPANPLUS> API is meant to let you programmatically +The C<CPANPLUS> API is meant to let you programmatically interact with the C<CPAN> mirrors. The documentation in L<CPANPLUS::Backend> shows you how to create an object capable of interacting with those mirrors, letting you create & retrieve module objects. L<CPANPLUS::Module> shows you how you can use these module -objects to perform actions like installing and testing. +objects to perform actions like installing and testing. The default shell, documented in L<CPANPLUS::Shell::Default> is also scriptable. You can use its API to dispatch calls @@ -151,46 +150,46 @@ from your script to the CPANPLUS Shell. =head2 STARTING AN INTERACTIVE SHELL -You can start an interactive shell by running either of +You can start an interactive shell by running either of the two following commands: $ cpanp $ perl -MCPANPLUS -eshell -All commands available are listed in the interactive shells -help menu. See C<cpanp -h> or L<CPANPLUS::Shell::Default> -for instructions on using the default shell. - +All commans available are listed in the interactive shells +help menu. See C<cpanp -h> or L<CPANPLUS::Shell::Default> +for instructions on using the default shell. + =head2 CHOOSE A SHELL By running C<cpanp> without arguments, you will start up -the shell specified in your config, which defaults to +the shell specified in your config, which defaults to L<CPANPLUS::Shell::Default>. There are more shells available. -C<CPANPLUS> itself ships with an emulation shell called -L<CPANPLUS::Shell::Classic> that looks and feels just like +C<CPANPLUS> itself ships with an emulation shell called +L<CPANPLUS::Shell::Classic> that looks and feels just like the old C<CPAN.pm> shell. You can start this shell by typing: $ perl -MCPANPLUS -e'shell Classic' - -Even more shells may be available from C<CPAN>. + +Even more shells may be available from C<CPAN>. Note that if you have changed your default shell in your -configuration, that shell will be used instead. If for -some reason there was an error with your specified shell, +configuration, that shell will be used instead. If for +some reason there was an error with your specified shell, you will be given the default shell. =head2 BUILDING PACKAGES -C<cpan2dist> is a commandline tool to convert any distribution +C<cpan2dist> is a commandline tool to convert any distribution from C<CPAN> into a package in the format of your choice, like -for example C<.deb> or C<FreeBSD ports>. +for example C<.deb> or C<FreeBSD ports>. See C<cpan2dist -h> for details. - - + + =head1 FUNCTIONS For quick access to common commands, you may use this module, @@ -239,10 +238,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO @@ -257,7 +256,7 @@ L<CPANPLUS::Shell::Default>, L<CPANPLUS::FAQ>, L<CPANPLUS::Backend>, L<CPANPLUS: I<bug-cpanplus@rt.cpan.org> =item * Questions & suggestions: -I<bug-cpanplus@rt.cpan.org> +I<cpanplus-devel@lists.sourceforge.net> =back diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm index 8ac565a70ec..3bcf8f45090 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Configure/Setup.pm @@ -1,9 +1,7 @@ package CPANPLUS::Configure::Setup; -use deprecate; use strict; -use vars qw[@ISA $VERSION]; -$VERSION = "0.9135"; +use vars qw(@ISA); use base qw[CPANPLUS::Internals::Utils]; use base qw[Object::Accessor]; @@ -13,6 +11,7 @@ use Term::UI; use Module::Load; use Term::ReadLine; + use CPANPLUS::Internals::Utils; use CPANPLUS::Internals::Constants; use CPANPLUS::Error; @@ -61,20 +60,20 @@ sub new { my $obj = $class->SUPER::new( keys %$tmpl ); for my $acc ( $obj->ls_accessors ) { $obj->$acc( $args->{$acc} ); - } - + } + ### otherwise there's a circular use ### load CPANPLUS::Configure; load CPANPLUS::Backend; $obj->configure_object( CPANPLUS::Configure->new() ) unless $obj->configure_object; - + $obj->backend( CPANPLUS::Backend->new( $obj->configure_object ) ) unless $obj->backend; ### use empty string in case user only has T::R::Stub -- it complains - $obj->term( Term::ReadLine->new('') ) + $obj->term( Term::ReadLine->new('') ) unless $obj->term; ### enable autoreply if that was passed ### @@ -86,10 +85,10 @@ sub new { sub init { my $self = shift; my $term = $self->term; - + ### default setting, unless changed $self->config_type( CONFIG_USER ) unless $self->config_type; - + my $save = loc('Save & exit'); my $exit = loc('Quit without saving'); my @map = ( @@ -100,45 +99,45 @@ sub init { [ loc('Setup FTP/Email settings') => '_setup_ftp' ], [ loc('Setup basic preferences') => '_setup_conf' ], [ loc('Setup installer settings') => '_setup_installer' ], - [ loc('Select mirrors'), => '_setup_hosts' ], - [ loc('Edit configuration file') => '_edit' ], + [ loc('Select mirrors'), => '_setup_hosts' ], + [ loc('Edit configuration file') => '_edit' ], [ $save => '_save' ], - [ $exit => 1 ], + [ $exit => 1 ], ); my @keys = map { $_->[0] } @map; # sorted keys my %map = map { @$_ } @map; # lookup hash - + PICK_SECTION: { print loc(" -=================> MAIN MENU <================= - +=================> MAIN MENU <================= + Welcome to the CPANPLUS configuration. Please select which parts you wish to configure Defaults are taken from your current configuration. If you would save now, your settings would be written to: - + %1 - + ", $self->config_type ); - + my $choice = $term->get_reply( prompt => "Section to configure:", choices => \@keys, default => $keys[0] - ); - + ); + ### exit configuration? if( $choice eq $exit ) { print loc(" Quitting setup, changes will not be saved. "); return 1; - } - + } + my $method = $map{$choice}; - + my $rv = $self->$method or print loc(" There was an error setting up this section. You might want to try again "); @@ -147,14 +146,14 @@ There was an error setting up this section. You might want to try again if( $choice eq $save and $rv ) { print loc(" Quitting setup, changes are saved to '%1' - ", $self->config_type + ", $self->config_type ); return 1; } ### otherwise, present choice again redo PICK_SECTION; - } + } return 1; } @@ -169,22 +168,22 @@ sub _save_where { ASK_CONFIG_TYPE: { - - print loc( q[ + + print loc( q[ Where would you like to save your CPANPLUS Configuration file? -If you want to configure CPANPLUS for this user only, +If you want to configure CPANPLUS for this user only, select the '%1' option. The file will then be saved in your homedirectory. -If you are the system administrator of this machine, -and would like to make this config available globally, +If you are the system administrator of this machine, +and would like to make this config available globally, select the '%2' option. -The file will be then be saved in your CPANPLUS +The file will be then be saved in your CPANPLUS installation directory. ], CONFIG_USER, CONFIG_SYSTEM ); - + ### ask what config type we should save to my $type = $term->get_reply( @@ -192,19 +191,19 @@ installation directory. default => $self->config_type || CONFIG_USER, choices => [CONFIG_USER, CONFIG_SYSTEM], ); - + my $file = $conf->_config_pm_to_file( $type ); - + ### can we save to this file? unless( $conf->can_save( $file ) ) { error(loc( "Can not save to file '%1'-- please check permissions " . - "and try again", $file + "and try again", $file )); - + redo ASK_CONFIG_FILE; - } - + } + ### you already have the file -- are we allowed to overwrite ### or should we try again? if ( -e $file and -w _ ) { @@ -215,18 +214,18 @@ I see you already have this file: The file will not be overwritten until you explicitly save it. ], $file ); - - redo ASK_CONFIG_TYPE + + redo ASK_CONFIG_TYPE unless $term->ask_yn( prompt => loc( "Do you wish to use this file?"), default => 'n', ); } - + print $/, loc("Using '%1' as your configuration type", $type); - + return $self->config_type($type); - } + } } @@ -238,10 +237,10 @@ sub _setup_base { my $base = $conf->get_conf('base'); my $home = File::Spec->catdir( $self->_home_dir, DOT_CPANPLUS ); - + print loc(" CPANPLUS needs a directory of its own to cache important index -files and maybe keep a temporary mirror of CPAN files. +files and maybe keep a temporary mirror of CPAN files. This may be a site-wide directory or a personal directory. For a single-user installation, we suggest using your home directory. @@ -267,7 +266,7 @@ For a single-user installation, we suggest using your home directory. print loc(" I see you already have a directory: %1 - + "), $where; my $yn = $term->ask_yn( @@ -339,7 +338,7 @@ First of all, I'd like to create this directory. print loc(q[ Your CPANPLUS build and cache directory has been set to: %1 - + ], $where); return 1; @@ -423,7 +422,7 @@ is required for the 'from' field, so choose wisely. unless (grep { $_ eq $current } @choices) { unshift @choices, $current; } - + my $email = $term->get_reply( prompt => loc('Which email address shall I use?'), default => $current || $choices[0], @@ -435,7 +434,7 @@ is required for the 'from' field, so choose wisely. $email = $term->get_reply( prompt => loc('Email address: '), ); - + unless( $self->_valid_email($email) ) { print loc(" You did not enter a valid email address, please try again! @@ -449,7 +448,7 @@ You did not enter a valid email address, please try again! print loc(" Your 'email' is now: %1 - + ", $email); $conf->set_conf( email => $email ); @@ -482,16 +481,16 @@ like '%1'. PROGRAM: { print "\n", loc("Where can I find your '%1' utility? ". "(Enter a single space to disable)", $prog ), "\n"; - + my $loc = $term->get_reply( prompt => "Path to your '$prog'", default => $conf->get_program( $prog ), - ); - - ### empty line clears it + ); + + ### empty line clears it my $cmd = $loc =~ /^\s*$/ ? undef : $loc; my ($bin) = $cmd =~ /^(\S+)/; - + ### did you provide a valid program ? if( $bin and not can_run( $bin ) ) { print "\n"; @@ -506,27 +505,27 @@ like '%1'. 'make' ); print loc("Please provide one!"); - + ### show win32 where to download - if ( $^O eq 'MSWin32' ) { + if ( $^O eq 'MSWin32' ) { print loc("You can get '%1' from:", NMAKE); print "\t". NMAKE_URL ."\n"; } print "\n"; - redo PROGRAM; + redo PROGRAM; } $conf->set_program( $prog => $cmd ); print $cmd - ? loc( "Your '%1' utility has been set to '%2'.", + ? loc( "Your '%1' utility has been set to '%2'.", $prog, $cmd ) - : loc( "Your '%1' has been disabled.", $prog ); + : loc( "Your '%1' has been disabled.", $prog ); print "\n"; } } - + return 1; -} +} sub _setup_installer { my $self = shift; @@ -534,7 +533,7 @@ sub _setup_installer { my $conf = $self->configure_object; my $none = 'None'; - { + { print loc(" CPANPLUS uses binary programs as well as Perl modules to accomplish various tasks. Normally, CPANPLUS will prefer the use of Perl modules @@ -544,7 +543,7 @@ You can change this setting by making CPANPLUS prefer the use of certain binary programs if they are available. "); - + ### default to using binaries if we don't have compress::zlib only ### -- it'll get very noisy otherwise my $type = 'prefer_bin'; @@ -671,7 +670,7 @@ Again, if you don't understand this question, just press ENTER. Some modules provide both a Build.PL (Module::Build) and a Makefile.PL (ExtUtils::MakeMaker). By default, CPANPLUS prefers Makefile.PL. -Module::Build support is not bundled standard with CPANPLUS, but +Module::Build support is not bundled standard with CPANPLUS, but requires you to install 'CPANPLUS::Dist::Build' from CPAN. Although Module::Build is a pure perl solution, which means you will @@ -723,10 +722,10 @@ pathnames to be added to your @INC, quoting any with embedded whitespace. $conf->set_conf( $type => $lib ); } - + return 1; -} - +} + sub _setup_conf { my $self = shift; @@ -835,37 +834,37 @@ Otherwise, select ASK to have us ask your permission to install them. "); my $type = 'prereqs'; - + my @map = ( - [ PREREQ_IGNORE, # conf value - loc('No, do not install prerequisites'), # UI Value + [ PREREQ_IGNORE, # conf value + loc('No, do not install prerequisites'), # UI Value loc("I won't install prerequisites") # diag message ], [ PREREQ_INSTALL, - loc('Yes, please install prerequisites'), - loc("I will install prerequisites") + loc('Yes, please install prerequisites'), + loc("I will install prerequisites") ], - [ PREREQ_ASK, - loc('Ask me before installing a prerequisite'), - loc("I will ask permission to install") + [ PREREQ_ASK, + loc('Ask me before installing a prerequisite'), + loc("I will ask permission to install") ], - [ PREREQ_BUILD, + [ PREREQ_BUILD, loc('Build prerequisites, but do not install them'), loc( "I will only build, but not install prerequisites" ) ], ); - + my %reply = map { $_->[1] => $_->[0] } @map; # choice => value my %diag = map { $_->[1] => $_->[2] } @map; # choice => diag message my %conf = map { $_->[0] => $_->[1] } @map; # value => ui choice - + my $reply = $term->get_reply( prompt => loc('Follow prerequisites?'), default => $conf{ $conf->get_conf( $type ) }, choices => [ @conf{ sort keys %conf } ], ); print "\n"; - + my $value = $reply{ $reply }; my $diag = $diag{ $reply }; @@ -881,7 +880,7 @@ CPANPLUS can do for you later); "); my $type = 'md5'; - + my $yn = $term->ask_yn( prompt => loc("Shall I use the MD5 checksums?"), default => $conf->get_conf( $type ), @@ -895,7 +894,7 @@ CPANPLUS can do for you later); } - + { ########################################### ## sally sells seashells by the seashore ## ########################################### @@ -910,7 +909,7 @@ please enter the full name for your shell module. my $type = 'shell'; my $other = 'Other'; my @choices = (qw| CPANPLUS::Shell::Default - CPANPLUS::Shell::Classic |, + CPANPLUS::Shell::Classic |, $other ); my $default = $conf->get_conf($type); @@ -930,9 +929,9 @@ please enter the full name for your shell module. ); unless( check_install( module => $reply ) ) { - print "\n", + print "\n", loc("Could not find '$reply' in your path " . - "-- please try again"), + "-- please try again"), "\n"; redo SHELL; } @@ -974,8 +973,8 @@ Would you like to do this? ################### print loc(" - -To limit the amount of RAM used by CPANPLUS, you can use the SQLite + +To limit the amount of RAM used by CPANPLUS, you can use the SQLite source backend instead. Note that it is currently still experimental. Would you like to do this? @@ -1198,26 +1197,26 @@ are done. } CHOICE: { - + ### doesn't play nice with Term::UI :( ### should make t::ui figure out pager opens #$self->_pager_open; # host lists might be long - + print loc(" -You can enter multiple sites by separating them by a space. +You can enter multiple sites by seperating them by a space. For example: 1 4 2 5 - "); - + "); + my @reply = $term->get_reply( prompt => loc('Please pick a site: '), - choices => [sort(keys %map), + choices => [sort(keys %map), qw|Custom View Up Quit|], default => $default, multi => 1, ); #$self->_pager_close; - + goto COUNTRY if grep { $_ eq 'Up' } @reply; goto CUSTOM if grep { $_ eq 'Custom' } @reply; @@ -1374,7 +1373,7 @@ This may take a while... "); - ### use the new configuration ### + ### use the enew configuratoin ### $cpan->configure_object( $conf ); load CPANPLUS::Module::Fake; @@ -1647,8 +1646,8 @@ post-configuration editing of the config file sub _save { my $self = shift; my $conf = $self->configure_object; - + return $conf->save( $self->config_type ); -} +} 1; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm index 73736d9e4da..c7108ed1392 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Base.pm @@ -1,11 +1,11 @@ package CPANPLUS::Dist::Base; -use deprecate; use strict; use base qw[CPANPLUS::Dist]; use vars qw[$VERSION]; -$VERSION = "0.9135"; +$VERSION = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION; + =head1 NAME @@ -19,13 +19,13 @@ CPANPLUS::Dist::Base - Base class for custom distribution classes sub prepare { my $dist = shift; - + ### do the 'standard' things $dist->SUPER::prepare( @_ ) or return; - + ### do MY_IMPLEMENTATION specific things ... - + ### don't forget to set the status! return $dist->status->prepared( $SUCCESS ? 1 : 0 ); } @@ -34,7 +34,7 @@ CPANPLUS::Dist::Base - Base class for custom distribution classes =head1 DESCRIPTION CPANPLUS::Dist::Base functions as a base class for all custom -distribution implementations. It does all the mundane work +distribution implementations. It does all the mundane work CPANPLUS would have done without a custom distribution, so you can override just the parts you need to make your own implementation work. @@ -50,7 +50,7 @@ class are called: $dist->prepare; # find/write meta information $dist->create; # write the distribution file $dist->install; # install the distribution file - + $dist->uninstall; # remove the distribution (OPTIONAL) =head1 METHODS @@ -64,8 +64,8 @@ override. =cut -sub methods { - return qw[format_available init prepare create install uninstall] +sub methods { + return qw[format_available init prepare create install uninstall] } =head2 $bool = $Class->format_available @@ -82,7 +82,7 @@ Simply return true if the request can proceed and false if it can not. The C<CPANPLUS::Dist::Base> implementation always returns true. -=cut +=cut sub format_available { return 1 } @@ -91,21 +91,21 @@ sub format_available { return 1 } This method is called just after the new dist object is set up and before the C<prepare> method is called. This is the time to set up -the object so it can be used with your class. +the object so it can be used with your class. For example, you might want to add extra accessors to the C<status> object, which you might do as follows: $dist->status->mk_accessors( qw[my_implementation_accessor] ); - -The C<status> object is implemented as an instance of the -C<Object::Accessor> class. Please refer to its documentation for + +The C<status> object is implemented as an instance of the +C<Object::Accessor> class. Please refer to its documentation for details. - -Return true if the initialization was successful, and false if it was + +Return true if the initialization was successul, and false if it was not. - -The C<CPANPLUS::Dist::Base> implementation does not alter your object + +The C<CPANPLUS::Dist::Base> implementation does not alter your object and always returns true. =cut @@ -116,14 +116,14 @@ sub init { return 1; } This runs the preparation step of your distribution. This step is meant to set up the environment so the C<create> step can create the actual -distribution(file). -A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution +distribution(file). +A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<perl Makefile.PL> to find the dependencies -for a distribution. For a C<debian> distribution, this is where you +for a distribution. For a C<debian> distribution, this is where you would write all the metafiles required for the C<dpkg-*> tools. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->prepared >> to the return value of this function. @@ -131,7 +131,7 @@ If you override this method, you should make sure to set this value. =cut -sub prepare { +sub prepare { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; @@ -147,18 +147,18 @@ sub prepare { =head2 $bool = $dist->create This runs the creation step of your distribution. This step is meant -to follow up on the C<prepare> call, that set up your environment so -the C<create> step can create the actual distribution(file). -A C<create> call in the standard C<ExtUtils::MakeMaker> distribution +to follow up on the C<prepare> call, that set up your environment so +the C<create> step can create the actual distribution(file). +A C<create> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<make> and C<make test> to build and test -a distribution. For a C<debian> distribution, this is where you +a distribution. For a C<debian> distribution, this is where you would create the actual C<.deb> file using C<dpkg>. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). -Sets C<< $dist->status->dist >> to the location of the created +Sets C<< $dist->status->dist >> to the location of the created distribution. If you override this method, you should make sure to set this value. @@ -167,7 +167,7 @@ If you override this method, you should make sure to set this value. =cut -sub create { +sub create { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; @@ -193,13 +193,13 @@ sub create { This runs the install step of your distribution. This step is meant to follow up on the C<create> call, which prepared a distribution(file) to install. -A C<create> call in the standard C<ExtUtils::MakeMaker> distribution +A C<create> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<make install> to copy the distribution files -to their final destination. For a C<debian> distribution, this is where +to their final destination. For a C<debian> distribution, this is where you would run C<dpkg --install> on the created C<.deb> file. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->installed >> to the return value of this function. @@ -207,12 +207,12 @@ If you override this method, you should make sure to set this value. =cut -sub install { +sub install { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - my $dist_cpan = $self->status->dist_cpan; + my $dist_cpan = $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -223,14 +223,14 @@ sub install { =head2 $bool = $dist->uninstall This runs the uninstall step of your distribution. This step is meant -to remove the distribution from the file system. -A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution -would, for example, run C<make uninstall> to remove the distribution -files the file system. For a C<debian> distribution, this is where you +to remove the distribution from the file system. +A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution +would, for example, run C<make uninstall> to remove the distribution +files the file system. For a C<debian> distribution, this is where you would run C<dpkg --uninstall PACKAGE>. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->uninstalled >> to the return value of this function. @@ -238,12 +238,12 @@ If you override this method, you should make sure to set this value. =cut -sub uninstall { +sub uninstall { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - my $dist_cpan = $self->status->dist_cpan; + my $dist_cpan = $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -251,7 +251,7 @@ sub uninstall { $dist->status->uninstalled( $dist_cpan->uninstall( @_ ) ); } -1; +1; # Local variables: # c-indentation-style: bsd diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm index e03d66f9836..0b0939208ff 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Dist/Sample.pm @@ -1,8 +1,4 @@ package CPANPLUS::Dist::Sample; -use deprecate; - -use vars qw[$VERSION]; -$VERSION = "0.9135"; =pod diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm index 09501c78e84..1a38200dfb7 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Constants; -use deprecate; use strict; @@ -14,18 +13,18 @@ use vars qw[$VERSION @ISA @EXPORT]; use Package::Constants; -$VERSION = "0.9135"; @ISA = qw[Exporter]; @EXPORT = Package::Constants->list( __PACKAGE__ ); + sub constants { @EXPORT }; use constant INSTALLER_BUILD => 'CPANPLUS::Dist::Build'; -use constant INSTALLER_MM => 'CPANPLUS::Dist::MM'; -use constant INSTALLER_SAMPLE +use constant INSTALLER_MM => 'CPANPLUS::Dist::MM'; +use constant INSTALLER_SAMPLE => 'CPANPLUS::Dist::Sample'; -use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; +use constant INSTALLER_BASE => 'CPANPLUS::Dist::Base'; use constant INSTALLER_AUTOBUNDLE => 'CPANPLUS::Dist::Autobundle'; @@ -51,26 +50,26 @@ use constant ON_NETWARE => $^O eq 'NetWare'; use constant ON_CYGWIN => $^O eq 'cygwin'; use constant ON_VMS => $^O eq 'VMS'; -use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus'; +use constant DOT_CPANPLUS => ON_VMS ? '_cpanplus' : '.cpanplus'; use constant OPT_AUTOFLUSH => '-MCPANPLUS::Internals::Utils::Autoflush'; use constant UNKNOWN_DL_LOCATION - => 'UNKNOWN-ORIGIN'; + => 'UNKNOWN-ORIGIN'; use constant NMAKE => 'nmake.exe'; -use constant NMAKE_URL => +use constant NMAKE_URL => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe'; -use constant INSTALL_VIA_PACKAGE_MANAGER +use constant INSTALL_VIA_PACKAGE_MANAGER => sub { my $fmt = $_[0] or return; return 1 if $fmt ne INSTALLER_BUILD and $fmt ne INSTALLER_MM; - }; + }; use constant IS_CODEREF => sub { ref $_[-1] eq 'CODE' }; -use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1], - 'CPANPLUS::Module') }; +use constant IS_MODOBJ => sub { UNIVERSAL::isa($_[-1], + 'CPANPLUS::Module') }; use constant IS_FAKE_MODOBJ => sub { UNIVERSAL::isa($_[-1], 'CPANPLUS::Module::Fake') }; use constant IS_AUTHOBJ => sub { UNIVERSAL::isa($_[-1], @@ -84,48 +83,48 @@ use constant IS_CONFOBJ => sub { UNIVERSAL::isa($_[-1], use constant IS_RVOBJ => sub { UNIVERSAL::isa($_[-1], 'CPANPLUS::Backend::RV') }; - + use constant IS_INTERNALS_OBJ => sub { UNIVERSAL::isa($_[-1], - 'CPANPLUS::Internals') }; - -use constant IS_FILE => sub { return 1 if -e $_[-1] }; + 'CPANPLUS::Internals') }; + +use constant IS_FILE => sub { return 1 if -e $_[-1] }; -use constant FILE_EXISTS => sub { +use constant FILE_EXISTS => sub { my $file = $_[-1]; return 1 if IS_FILE->($file); - local $Carp::CarpLevel = + local $Carp::CarpLevel = $Carp::CarpLevel+2; error(loc( q[File '%1' does not exist], $file)); return; - }; + }; -use constant FILE_READABLE => sub { +use constant FILE_READABLE => sub { my $file = $_[-1]; return 1 if -e $file && -r _; - local $Carp::CarpLevel = + local $Carp::CarpLevel = $Carp::CarpLevel+2; error( loc( q[File '%1' is not readable ]. q[or does not exist], $file)); return; - }; + }; use constant IS_DIR => sub { return 1 if -d $_[-1] }; -use constant DIR_EXISTS => sub { +use constant DIR_EXISTS => sub { my $dir = $_[-1]; return 1 if IS_DIR->($dir); - local $Carp::CarpLevel = - $Carp::CarpLevel+2; + local $Carp::CarpLevel = + $Carp::CarpLevel+2; error(loc(q[Dir '%1' does not exist], $dir)); return; - }; - - ### On VMS, if the $Config{make} is either MMK + }; + + ### On VMS, if the $Config{make} is either MMK ### or MMS, then the makefile is 'DESCRIP.MMS'. use constant MAKEFILE => sub { my $file = - (ON_VMS and + (ON_VMS and $Config::Config{make} =~ /MM[S|K]/i) ? 'DESCRIP.MMS' : 'Makefile'; @@ -133,80 +132,66 @@ use constant MAKEFILE => sub { my $file = return @_ ? File::Spec->catfile( @_, $file ) : $file; - }; + }; use constant MAKEFILE_PL => sub { return @_ ? File::Spec->catfile( @_, 'Makefile.PL' ) : 'Makefile.PL'; - }; + }; use constant BUILD_PL => sub { return @_ ? File::Spec->catfile( @_, 'Build.PL' ) : 'Build.PL'; }; - + use constant META_YML => sub { return @_ ? File::Spec->catfile( @_, 'META.yml' ) : 'META.yml'; - }; + }; use constant MYMETA_YML => sub { return @_ ? File::Spec->catfile( @_, 'MYMETA.yml' ) : 'MYMETA.yml'; - }; - -use constant META_JSON => sub { return @_ - ? File::Spec->catfile( @_, 'META.json' ) - : 'META.json'; - }; - -use constant MYMETA_JSON => sub { return @_ - ? File::Spec->catfile( @_, 'MYMETA.json' ) - : 'MYMETA.json'; - }; + }; use constant BLIB => sub { return @_ ? File::Spec->catfile(@_, 'blib') : 'blib'; - }; + }; use constant LIB => 'lib'; use constant LIB_DIR => sub { return @_ ? File::Spec->catdir(@_, LIB) : LIB; - }; -use constant AUTO => 'auto'; + }; +use constant AUTO => 'auto'; use constant LIB_AUTO_DIR => sub { return @_ ? File::Spec->catdir(@_, LIB, AUTO) : File::Spec->catdir(LIB, AUTO) - }; + }; use constant ARCH => 'arch'; use constant ARCH_DIR => sub { return @_ ? File::Spec->catdir(@_, ARCH) : ARCH; - }; + }; use constant ARCH_AUTO_DIR => sub { return @_ ? File::Spec->catdir(@_,ARCH,AUTO) : File::Spec->catdir(ARCH,AUTO) - }; + }; use constant BLIB_LIBDIR => sub { return @_ ? File::Spec->catdir( @_, BLIB->(), LIB ) : File::Spec->catdir( BLIB->(), LIB ); - }; - -use constant BIN => 'bin'; + }; -use constant SCRIPT => 'script'; - -use constant CONFIG_USER_LIB_DIR => sub { +use constant CONFIG_USER_LIB_DIR => sub { require CPANPLUS::Internals::Utils; LIB_DIR->( CPANPLUS::Internals::Utils->_home_dir, DOT_CPANPLUS ); - }; + }; use constant CONFIG_USER_FILE => sub { File::Spec->catfile( CONFIG_USER_LIB_DIR->(), @@ -219,13 +204,13 @@ use constant CONFIG_SYSTEM_FILE => sub { my $dir = File::Basename::dirname( $INC{'CPANPLUS/Internals.pm'} ); - + ### XXX use constants - File::Spec->catfile( + File::Spec->catfile( $dir, qw[Config System.pm] ); - }; - + }; + use constant README => sub { my $obj = $_[0]; my $pkg = $obj->package_name; $pkg .= '-' . $obj->package_version . @@ -239,8 +224,8 @@ use constant META => sub { my $obj = $_[0]; $pkg .= '-' . $obj->package_version . '.' . META_EXT; return $pkg; - }; - + }; + use constant OPEN_FILE => sub { my($file, $mode) = (@_, ''); my $fh; @@ -250,23 +235,23 @@ use constant OPEN_FILE => sub { $file, $!)); return $fh if $fh; return; - }; - -use constant OPEN_DIR => sub { + }; + +use constant OPEN_DIR => sub { my $dir = shift; my $dh; opendir $dh, $dir or error(loc( "Could not open dir '%1': %2", $dir, $! )); - + return $dh if $dh; return; }; -use constant READ_DIR => sub { +use constant READ_DIR => sub { my $dir = shift; my $dh = OPEN_DIR->( $dir ) or return; - + ### exclude . and .. my @files = grep { $_ !~ /^\.{1,2}/ } readdir($dh); @@ -276,27 +261,27 @@ use constant READ_DIR => sub { if( ON_VMS ) { s/(?<!\^)\.$// for @files; } - + return @files; - }; + }; -use constant STRIP_GZ_SUFFIX +use constant STRIP_GZ_SUFFIX => sub { my $file = $_[0] or return; $file =~ s/.gz$//i; return $file; - }; - + }; + use constant CHECKSUMS => 'CHECKSUMS'; use constant PGP_HEADER => '-----BEGIN PGP SIGNED MESSAGE-----'; use constant ENV_CPANPLUS_CONFIG => 'PERL5_CPANPLUS_CONFIG'; use constant ENV_CPANPLUS_IS_EXECUTING => 'PERL5_CPANPLUS_IS_EXECUTING'; -use constant DEFAULT_EMAIL => 'cpanplus@example.com'; +use constant DEFAULT_EMAIL => 'cpanplus@example.com'; use constant CPANPLUS_UA => sub { ### for the version number ### require CPANPLUS::Internals; - "CPANPLUS/$CPANPLUS::Internals::VERSION" + "CPANPLUS/$CPANPLUS::Internals::VERSION" }; use constant TESTERS_URL => sub { 'http://cpantesters.org/distro/'. @@ -306,15 +291,15 @@ use constant TESTERS_DETAILS_URL => sub { 'http://cpantesters.org/distro/'. uc(substr($_[0],0,1)) .'/'. $_[0]; - }; + }; -use constant CREATE_FILE_URI - => sub { +use constant CREATE_FILE_URI + => sub { my $dir = $_[0] or return; - return $dir =~ m|^/| + return $dir =~ m|^/| ? 'file://' . $dir - : 'file:///' . $dir; - }; + : 'file:///' . $dir; + }; use constant EMPTY_DSLIP => ' '; @@ -323,65 +308,64 @@ use constant CUSTOM_AUTHOR_ID use constant DOT_SHELL_DEFAULT_RC => '.shell-default.rc'; - + use constant SOURCE_SQLITE_DB => 'db.sql'; -use constant PREREQ_IGNORE => 0; +use constant PREREQ_IGNORE => 0; use constant PREREQ_INSTALL => 1; use constant PREREQ_ASK => 2; use constant PREREQ_BUILD => 3; use constant BOOLEANS => [0,1]; -use constant CALLING_FUNCTION +use constant CALLING_FUNCTION => sub { my $lvl = $_[0] || 0; - return join '::', (caller(2+$lvl))[3] + return join '::', (caller(2+$lvl))[3] }; use constant PERL_CORE => 'perl'; -use constant PERL_WRAPPER => 'use strict; BEGIN { my $old = select STDERR; $|++; select $old; $|++; $0 = shift(@ARGV); my $rv = do($0); die $@ if $@; }'; use constant STORABLE_EXT => '.stored'; use constant GET_XS_FILES => sub { my $dir = $_[0] or return; require File::Find; my @files; - File::Find::find( + File::Find::find( sub { push @files, $File::Find::name if $File::Find::name =~ /\.xs$/i }, $dir ); - + return @files; - }; + }; -use constant INSTALL_LOG_FILE +use constant INSTALL_LOG_FILE => sub { my $obj = shift or return; my $name = $obj->name; $name =~ s/::/-/g; $name .= '-'. $obj->version; $name .= '-'. scalar(time) . '.log'; return $name; - }; + }; -use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 +use constant ON_OLD_CYGWIN => do { ON_CYGWIN and $] < 5.008 ? loc( "Your perl version for %1 is too low; ". "Require %2 or higher for this function", $^O, '5.8.0' ) - : ''; + : ''; }; ### XXX these 2 are probably obsolete -- check & remove; -use constant DOT_EXISTS => '.exists'; +use constant DOT_EXISTS => '.exists'; -use constant QUOTE_PERL_ONE_LINER +use constant QUOTE_PERL_ONE_LINER => sub { my $line = shift or return; ### use double quotes on these systems - return qq["$line"] + return qq["$line"] if ON_WIN32 || ON_NETWARE || ON_VMS; ### single quotes on the rest return qq['$line']; - }; + }; -1; +1; # Local variables: # c-indentation-style: bsd diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm index dc92ec6c31d..59a41a6083b 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Constants/Report.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Constants::Report; -use deprecate; use strict; use CPANPLUS::Error; @@ -15,10 +14,11 @@ use Package::Constants; ### for the version require CPANPLUS::Internals; -$VERSION = "0.9135"; +$VERSION = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION; @ISA = qw[Exporter]; @EXPORT = Package::Constants->list( __PACKAGE__ ); + ### OS to regex map ### my %OS = ( Amiga => 'amigaos', @@ -80,10 +80,10 @@ use constant RELEVANT_TEST_RESULT my $name = $mod->module; my $specific; for my $platform (keys %OS) { - if( $name =~ /^$platform\b/i ) { + if( $name =~ /\b$platform\b/i ) { # beware the Mac != MAC next if($platform eq 'Mac' && - $name !~ /^$platform\b/); + $name !~ /\b$platform\b/); $specific++; return 1 if $^O =~ /^(?:$OS{$platform})$/ @@ -100,7 +100,7 @@ use constant UNSUPPORTED_OS return 1; } return 0; - }; + }; use constant PERL_VERSION_TOO_LOW => sub { @@ -116,7 +116,7 @@ use constant PERL_VERSION_TOO_LOW return 1; } return 0; - }; + }; use constant NO_TESTS_DEFINED => sub { @@ -125,10 +125,10 @@ use constant NO_TESTS_DEFINED /(No tests defined( for [\w:]+ extension)?\.)/ and $buffer !~ /\*\.t/m and $buffer !~ /test\.pl/m - ) { - return $1 + ) { + return $1 } - + return; }; @@ -149,8 +149,8 @@ use constant MISSING_PREREQS_LIST my @list = map { s/.pm$//; s|/|::|g; $_ } ($last =~ m/\bCan\'t locate (\S+) in \@INC/g); - - ### make sure every missing prereq is only + + ### make sure every missing prereq is only ### listed once { my %seen; @list = grep { !$seen{$_}++ } @list @@ -162,7 +162,7 @@ use constant MISSING_PREREQS_LIST use constant MISSING_EXTLIBS_LIST => sub { my $buffer = shift; - my @list = + my @list = ($buffer =~ m/No library found for -l([-\w]+)/g); @@ -175,9 +175,9 @@ use constant REPORT_MESSAGE_HEADER return << "."; Dear $author, - + This is a computer-generated error report created automatically by -CPANPLUS, version $version. Testers personal comments may appear +CPANPLUS, version $version. Testers personal comments may appear at the end of this report. . @@ -200,32 +200,15 @@ $buffer . }; -use constant REPORT_MESSAGE_PASS_HEADER - => sub { - my($stage, $buffer) = @_; - return << "."; - -Thank you for uploading your work to CPAN. Congratulations! -All tests were successful. - -TEST RESULTS: - -Below is the error stack from stage '$stage': - -$buffer - -. - }; - use constant REPORT_MISSING_PREREQS => sub { my ($author,$email,@missing) = @_; - $author = ($author && $email) - ? "$author ($email)" + $author = ($author && $email) + ? "$author ($email)" : 'Your Name Here'; - + my $modules = join "\n", @missing; - my $prereqs = join "\n", + my $prereqs = join "\n", map {"\t'$_'\t=> '0',". " # or a minimum working version"} @missing; @@ -259,7 +242,7 @@ use constant REPORT_MISSING_TESTS return << "."; RECOMMENDATIONS: -It would be very helpful if you could include even a simple test +It would be very helpful if you could include even a simple test script in the next release, so people can verify which platforms can successfully install them, as well as avoid regression bugs? @@ -283,7 +266,7 @@ Thanks! :-) . }; -use constant REPORT_LOADED_PREREQS +use constant REPORT_LOADED_PREREQS => sub { my $mod = shift; my $cb = $mod->parent; @@ -291,13 +274,13 @@ use constant REPORT_LOADED_PREREQS ### not every prereq may be coming from CPAN ### so maybe we wont find it in our module - ### tree at all... + ### tree at all... ### skip ones that cant be found in teh list ### as reported in #12723 my @prq = grep { defined } map { $cb->module_tree($_) } sort keys %$prq; - + ### no prereqs? return '' unless @prq; @@ -305,27 +288,27 @@ use constant REPORT_LOADED_PREREQS my $str = << "."; PREREQUISITES: -Here is a list of prerequisites you specified and versions we +Here is a list of prerequisites you specified and versions we managed to load: - + . - $str .= join '', - map { sprintf "\t%s %-30s %8s %8s\n", + $str .= join '', + map { sprintf "\t%s %-30s %8s %8s\n", @$_ - + } [' ', 'Module Name', 'Have', 'Want'], map { my $want = $prq->{$_->name}; - [ do { $_->is_uptodate( + [ do { $_->is_uptodate( version => $want - ) ? ' ' : '!' + ) ? ' ' : '!' }, $_->name, $_->installed_version, $want ], ### might be empty entries in there - } grep { $_ } @prq; - + } grep { $_ } @prq; + return $str; }; @@ -347,8 +330,6 @@ use constant REPORT_TOOLCHAIN_VERSIONS ExtUtils::ParseXS File::Spec Module::Build - Pod::Parser - Pod::Simple Test::Harness Test::More version @@ -367,23 +348,23 @@ use constant REPORT_TOOLCHAIN_VERSIONS Perl module toolchain versions installed: . - $str .= join '', - map { sprintf "\t%-30s %8s\n", + $str .= join '', + map { sprintf "\t%-30s %8s\n", @$_ - + } ['Module Name', 'Have'], map { [ $_->name, $_->installed_version, ], ### might be empty entries in there - } @toolchain; - + } @toolchain; + return $str; }; -use constant REPORT_TESTS_SKIPPED +use constant REPORT_TESTS_SKIPPED => sub { return << "."; @@ -395,7 +376,7 @@ use constant REPORT_TESTS_SKIPPED . }; - + use constant REPORT_MESSAGE_FOOTER => sub { return << "."; @@ -403,7 +384,7 @@ use constant REPORT_MESSAGE_FOOTER ******************************** NOTE ******************************** The comments above are created mechanically, possibly without manual checking by the sender. As there are many people performing automatic -tests on each upload to CPAN, it is likely that you will receive +tests on each upload to CPAN, it is likely that you will receive identical messages about the same problem. If you believe that the message is mistaken, please reply to the first @@ -412,7 +393,7 @@ it personally. We appreciate your patience. :) ********************************************************************** Additional comments: - + . }; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm index 50f82f485c9..a0ddf499bf6 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Source::SQLite; -use deprecate; use strict; use warnings; @@ -17,12 +16,9 @@ use DBD::SQLite; use Params::Check qw[allow check]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; -use vars qw[$VERSION]; -$VERSION = "0.9135"; - use constant TXN_COMMIT => 1000; -=head1 NAME +=head1 NAME CPANPLUS::Internals::Source::SQLite - SQLite implementation @@ -31,23 +27,23 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { my $Dbh; my $DbFile; - sub __sqlite_file { + sub __sqlite_file { return $DbFile if $DbFile; my $self = shift; my $conf = $self->configure_object; - $DbFile = File::Spec->catdir( + $DbFile = File::Spec->catdir( $conf->get_conf('base'), SOURCE_SQLITE_DB ); - + return $DbFile; }; - sub __sqlite_dbh { + sub __sqlite_dbh { return $Dbh if $Dbh; - + my $self = shift; $Dbh = DBIx::Simple->connect( "dbi:SQLite:dbname=" . $self->__sqlite_file, @@ -55,17 +51,9 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { AutoCommit => 1 } ); #$Dbh->dbh->trace(1); - $Dbh->query(qq{PRAGMA synchronous = OFF}); - return $Dbh; + return $Dbh; }; - - sub __sqlite_disconnect { - return unless $Dbh; - $Dbh->disconnect; - $Dbh = undef; - return; - } } { my $used_old_copy = 0; @@ -74,7 +62,7 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation my $self = shift; my $conf = $self->configure_object; my %hash = @_; - + my($path,$uptodate,$verbose,$use_stored); my $tmpl = { path => { default => $conf->get_conf('base'), store => \$path }, @@ -82,60 +70,59 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation uptodate => { required => 1, store => \$uptodate }, use_stored => { default => 1, store => \$use_stored }, }; - + check( $tmpl, \%hash ) or return; ### if it's not uptodate, or the file doesn't exist, we need to create ### a new sqlite db - if( not $uptodate or not -e $self->__sqlite_file ) { + if( not $uptodate or not -e $self->__sqlite_file ) { $used_old_copy = 0; ### chuck the file - $self->__sqlite_disconnect; 1 while unlink $self->__sqlite_file; - + ### and create a new one $self->__sqlite_create_db or do { error(loc("Could not create new SQLite DB")); - return; - } + return; + } } else { $used_old_copy = 1; - } - + } + ### set up the author tree { my %at; tie %at, 'CPANPLUS::Internals::Source::SQLite::Tie', - dbh => $self->__sqlite_dbh, table => 'author', + dbh => $self->__sqlite_dbh, table => 'author', key => 'cpanid', cb => $self; - + $self->_atree( \%at ); } ### set up the author tree { my %mt; tie %mt, 'CPANPLUS::Internals::Source::SQLite::Tie', - dbh => $self->__sqlite_dbh, table => 'module', + dbh => $self->__sqlite_dbh, table => 'module', key => 'module', cb => $self; $self->_mtree( \%mt ); } - + ### start a transaction $self->__sqlite_dbh->query('BEGIN'); - - return 1; - + + return 1; + } - + sub _standard_trees_completed { return $used_old_copy } sub _custom_trees_completed { return } ### finish transaction - sub _finalize_trees { $_[0]->__sqlite_dbh->commit; return 1 } + sub _finalize_trees { $_[0]->__sqlite_dbh->query('COMMIT'); return 1 } ### saves current memory state, but not implemented in sqlite - sub _save_state { - error(loc("%1 has not implemented writing state to disk", __PACKAGE__)); + sub _save_state { + error(loc("%1 has not implemented writing state to disk", __PACKAGE__)); return; } } @@ -149,7 +136,7 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation class => { default => 'CPANPLUS::Module::Author', store => \$class }, map { $_ => { required => 1 } } @keys }; - + ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually my $ph = join ',', map { '?' } @keys; @@ -158,9 +145,9 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation my $self = shift; my %hash = @_; my $dbh = $self->__sqlite_dbh; - + my $href = do { - local $Params::Check::NO_DUPLICATES = 1; + local $Params::Check::NO_DUPLICATES = 1; local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ) or return; }; @@ -168,18 +155,18 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; - $dbh->commit or error( $dbh->error ); # commit previous transaction - $dbh->begin_work or error( $dbh->error ); # and start a new one + $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction + $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one } - - $dbh->query( + + $dbh->query( "INSERT INTO author (". join(',',keys(%$href)) .") VALUES ($ph)", values %$href ) or do { error( $dbh->error ); return; }; - + return 1; } } @@ -187,13 +174,13 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation { my $txn_count = 0; ### XXX move this outside the sub, so we only compute it once - my $class; + my $class; my @keys = qw[ module version path comment author package description dslip mtime ]; my $tmpl = { class => { default => 'CPANPLUS::Module', store => \$class }, map { $_ => { required => 1 } } @keys }; - + ### dbix::simple's expansion of (??) is REALLY expensive, so do it manually my $ph = join ',', map { '?' } @keys; @@ -201,50 +188,51 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation my $self = shift; my %hash = @_; my $dbh = $self->__sqlite_dbh; - + my $href = do { local $Params::Check::NO_DUPLICATES = 1; local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ) or return; }; - + ### fix up author to be 'plain' string $href->{'author'} = $href->{'author'}->cpanid; ### keep counting how many we inserted unless( ++$txn_count % TXN_COMMIT ) { #warn "Committing transaction $txn_count"; - $dbh->commit or error( $dbh->error ); # commit previous transaction - $dbh->begin_work or error( $dbh->error ); # and start a new one + $dbh->query('COMMIT') or error( $dbh->error ); # commit previous transaction + $dbh->query('BEGIN') or error( $dbh->error ); # and start a new one } - - $dbh->query( - "INSERT INTO module (". join(',',keys(%$href)) .") VALUES ($ph)", + + $dbh->query( + "INSERT INTO module (". join(',',keys(%$href)) .") VALUES ($ph)", values %$href ) or do { error( $dbh->error ); return; }; - + return 1; } } { my %map = ( - _source_search_module_tree + _source_search_module_tree => [ module => module => 'CPANPLUS::Module' ], - _source_search_author_tree + _source_search_author_tree => [ author => cpanid => 'CPANPLUS::Module::Author' ], - ); + ); while( my($sub, $aref) = each %map ) { no strict 'refs'; - + my($table, $key, $class) = @$aref; *$sub = sub { my $self = shift; my %hash = @_; - + my $dbh = $self->__sqlite_dbh; + my($list,$type); my $tmpl = { allow => { required => 1, default => [ ], strict_type => 1, @@ -252,25 +240,19 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation type => { required => 1, allow => [$class->accessors()], store => \$type }, }; - + check( $tmpl, \%hash ) or return; - - + + ### we aliased 'module' to 'name', so change that here too $type = 'module' if $type eq 'name'; - - my $meth = $table .'_tree'; - - { - my $throw = $self->$meth; - } - - my $dbh = $self->__sqlite_dbh; + my $res = $dbh->query( "SELECT * from $table" ); - - my @rv = map { $self->$meth( $_->{$key} ) } + + my $meth = $table .'_tree'; + my @rv = map { $self->$meth( $_->{$key} ) } grep { allow( $_->{$type} => $list ) } $res->hashes; - + return @rv; } } @@ -281,29 +263,29 @@ CPANPLUS::Internals::Source::SQLite - SQLite implementation sub __sqlite_create_db { my $self = shift; my $dbh = $self->__sqlite_dbh; - - ### we can ignore the result/error; not all sqlite implementations - ### support this + + ### we can ignore the result/error; not all sqlite implemantation + ### support this $dbh->query( qq[ DROP TABLE IF EXISTS author; \n] ) or do { msg( $dbh->error ); - }; + }; $dbh->query( qq[ DROP TABLE IF EXISTS module; \n] ) or do { msg( $dbh->error ); - }; - + }; + $dbh->query( qq[ /* the author information */ CREATE TABLE author ( id INTEGER PRIMARY KEY AUTOINCREMENT, - + author varchar(255), email varchar(255), cpanid varchar(255) @@ -319,7 +301,7 @@ sub __sqlite_create_db { /* the module information */ CREATE TABLE module ( id INTEGER PRIMARY KEY AUTOINCREMENT, - + module varchar(255), version varchar(255), path varchar(255), @@ -330,54 +312,15 @@ sub __sqlite_create_db { dslip varchar(255), mtime varchar(255) ); - - \n] - - ) or do { - error( $dbh->error ); - return; - }; - - $dbh->query( qq[ - /* the module index */ - CREATE INDEX IX_module_module ON module ( - module - ); - - \n] - - ) or do { - error( $dbh->error ); - return; - }; - - $dbh->query( qq[ - /* the version index */ - CREATE INDEX IX_module_version ON module ( - version - ); - - \n] - - ) or do { - error( $dbh->error ); - return; - }; - - $dbh->query( qq[ - /* the module-version index */ - CREATE INDEX IX_module_module_version ON module ( - module, version - ); - + \n] ) or do { error( $dbh->error ); return; - }; - - return 1; + }; + + return 1; } 1; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm index b44b04bd58e..f908c9803e4 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Source/SQLite/Tie.pm @@ -1,5 +1,4 @@ package CPANPLUS::Internals::Source::SQLite::Tie; -use deprecate; use strict; use warnings; @@ -10,21 +9,24 @@ use CPANPLUS::Module::Fake; use CPANPLUS::Module::Author::Fake; use CPANPLUS::Internals::Constants; + use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; -use vars qw[@ISA $VERSION]; -$VERSION = "0.9135"; + +use Data::Dumper; +$Data::Dumper::Indent = 1; require Tie::Hash; +use vars qw[@ISA]; push @ISA, 'Tie::StdHash'; sub TIEHASH { my $class = shift; my %hash = @_; - + my $tmpl = { dbh => { required => 1 }, table => { required => 1 }, @@ -32,12 +34,12 @@ sub TIEHASH { cb => { required => 1 }, offset => { default => 0 }, }; - + my $args = check( $tmpl, \%hash ) or return; my $obj = bless { %$args, store => {} } , $class; return $obj; -} +} sub FETCH { my $self = shift; @@ -45,28 +47,28 @@ sub FETCH { my $dbh = $self->{dbh}; my $cb = $self->{cb}; my $table = $self->{table}; - - + + ### did we look this one up before? if( my $obj = $self->{store}->{$key} ) { return $obj; } - + my $res = $dbh->query( "SELECT * from $table where $self->{key} = ?", $key ) or do { error( $dbh->error ); return; }; - + my $href = $res->hash; - + ### get rid of the primary key delete $href->{'id'}; - + ### no results? return unless keys %$href; - + ### expand author if needed ### XXX no longer generic :( if( $table eq 'module' ) { @@ -78,16 +80,16 @@ sub FETCH { author => 'CPANPLUS::Module::Author', }->{ $table }; - my $obj = $self->{store}->{$key} = $class->new( %$href, _id => $cb->_id ); - + my $obj = $self->{store}->{$key} = $class->new( %$href, _id => $cb->_id ); + return $obj; } -sub STORE { +sub STORE { my $self = shift; my $key = shift; my $val = shift; - + $self->{store}->{$key} = $val; } @@ -102,7 +104,7 @@ sub FIRSTKEY { ); $self->{offset} = 0; - + my $key = $res->flat->[0]; return $key; @@ -128,7 +130,7 @@ sub NEXTKEY { sub EXISTS { !!$_[0]->FETCH( $_[1] ) } -sub SCALAR { +sub SCALAR { my $self = shift; my $dbh = $self->{'dbh'}; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm index 8aa9030dfa3..56566436a14 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Internals/Utils/Autoflush.pm @@ -1,8 +1,4 @@ package CPANPLUS::Internals::Utils::Autoflush; -use deprecate; - -use vars qw[$VERSION]; -$VERSION = "0.9135"; BEGIN { $|++ }; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm index 802d8cc2a60..cec6f2906b0 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Module/Signature.pm @@ -1,14 +1,13 @@ package CPANPLUS::Module::Signature; -use deprecate; use strict; + use Cwd; use CPANPLUS::Error; use Params::Check qw[check]; use Module::Load::Conditional qw[can_load]; -use vars qw[$VERSION]; -$VERSION = "0.9135"; + ### detached sig, not actually used afaik --kane ### #sub get_signature { diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm index 6cdc6f69cca..08c03bcf383 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Classic.pm @@ -5,7 +5,6 @@ ################################################## package CPANPLUS::Shell::Classic; -use deprecate; use strict; @@ -31,7 +30,7 @@ $Params::Check::ALLOW_UNKNOWN = 1; BEGIN { use vars qw[ $VERSION @ISA ]; @ISA = qw[ CPANPLUS::Shell::_Base::ReadLine ]; - $VERSION = "0.9135"; + $VERSION = '0.0562'; } load CPANPLUS::Shell; @@ -98,20 +97,6 @@ sub new { code => \&__ask_about_test_report, ); - if (my $histfile = $self->configure_object->get_conf( 'histfile' )) { - my $term = $self->term; - if ($term->can('AddHistory')) { - if (open my $fh, '<', $histfile) { - local $/ = "\n"; - while (my $line = <$fh>) { - chomp($line); - $term->AddHistory($line); - } - close($fh); - } - } - } - return $self; } @@ -209,24 +194,6 @@ sub _dispatch_on_input { ### displays quit message sub _quit { - my $self = shift; - my $term = $self->term; - - if ($term->can('GetHistory')) { - my @history = $term->GetHistory; - - my $histfile = $self->configure_object->get_conf('histfile'); - - if (open my $fh, '>', $histfile) { - foreach my $line (@history) { - print {$fh} "$line\n"; - } - close($fh); - } - else { - warn "Cannot open history file '$histfile' - $!"; - } - } ### well, that's what CPAN.pm says... print "Lockfile removed\n"; @@ -1240,10 +1207,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod index 8000aac9884..ca765f9e0ac 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/lib/CPANPLUS/Shell/Default/Plugins/HOWTO.pod @@ -5,20 +5,20 @@ CPANPLUS::Shell::Default::Plugins::HOWTO -- documentation on how to write your o =head1 SYNOPSIS package CPANPLUS::Shell::Default::Plugins::MyPlugin; - + ### return command => method mapping sub plugins { ( myplugin1 => 'mp1', myplugin2 => 'mp2' ) } - + ### method called when the command '/myplugin1' is issued sub mp1 { .... } ### method called when the command '/? myplugin1' is issued sub mp1_help { return "Help Text" } - + =head1 DESCRIPTION -This pod text explains how to write your own plugins for -C<CPANPLUS::Shell::Default>. +This pod text explains how to write your own plugins for +C<CPANPLUS::Shell::Default>. =head1 HOWTO @@ -34,18 +34,18 @@ C<.pm> file. =head2 Registering Plugin Commands To register any plugin commands, a list of key value pairs must be returned -by a C<plugins> method in your package. The keys are the commands you wish +by a C<plugins> method in your package. The keys are the commands you wish to register, the values are the methods in the plugin package you wish to have called when the command is issued. For example, a simple 'Hello, World!' plugin: package CPANPLUS::Shell::Default::Plugins::HW; - + sub plugins { return ( helloworld => 'hw' ) }; - + sub hw { print "Hello, world!\n" } - + When the user in the default shell now issues the C</helloworld> command, this command will be dispatched to the plugin, and its C<hw> method will be called @@ -60,7 +60,7 @@ For example, extending the above example, when a user calls C</? helloworld>, the function C<hw_help> will be called, which might look like this: sub hw_help { " /helloworld # prints "Hello, world!\n" } - + If you dont provide a corresponding _help function to your commands, the default shell will handle it gracefully, but the user will be stuck without usage information on your commands, so it's considered undesirable to omit @@ -90,8 +90,8 @@ are all positional: For example, the following command: /helloworld bob --nofoo --bar=2 joe - -Would yield the following arguments: + +Would yield the following arguments: sub hw { my $class = shift; # CPANPLUS::Shell::Default::Plugins::HW @@ -115,10 +115,10 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -The CPAN++ interface (of which this module is a part of) is copyright (c) +The CPAN++ interface (of which this module is a part of) is copyright (c) 2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved. -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =head1 SEE ALSO diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t index e15dcb2fc06..8e372fe0fdc 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/00_CPANPLUS-Internals-Utils.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -8,7 +8,7 @@ use strict; ### make sure to keep the plan -- this is the only test ### supported for 'older' T::H (pre 2.28) -- see Makefile.PL for details -use Test::More tests => 48; +use Test::More tests => 40; use Cwd; use Data::Dumper; @@ -67,11 +67,11 @@ rmdir $Dir if -d $Dir; } ### test _chdir ### -{ ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" ); +{ ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" ); my $abs = File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)); paths_are_same( File::Spec->rel2abs(cwd()), $abs, - " Cwd() is '$Dir'"); + " Cwd() is '$Dir'"); ok( $Class->_chdir( dir => $Cwd), "Chdir back to '$Cwd'" ); paths_are_same( File::Spec->rel2abs(cwd()), $Cwd, @@ -83,18 +83,18 @@ rmdir $Dir if -d $Dir; "Move from '$Dir' to '$Move'" ); ok( -d $Move, " Dir '$Move' exists" ); ok( !-d $Dir, " Dir '$Dir' no longer exists" ); - - + + { local $CPANPLUS::Error::ERROR_FH = output_handle(); - + ### now try to move it somewhere it can't ### ok( !$Class->_move( file => $Move, to => 'inc' ), " Impossible move detected" ); like( CPANPLUS::Error->stack_as_string, qr/Failed to move/, " Expected error found" ); } -} - +} + ### test _rmdir ### { ok( -d $Move, "Dir '$Move' exists" ); ok( $Class->_rmdir( dir => $Move ), " Deleted dir '$Move'" ); @@ -107,75 +107,71 @@ rmdir $Dir if -d $Dir; like( $contents, qr/BEGIN/, " Proper contents found" ); like( $contents, qr/CPANPLUS/, " Proper contents found" ); } - + ### _perl_version tests ### { my $version = $Class->_perl_version( perl => $^X ); ok( $version, "Perl version found" ); like( $version, qr/\d.\d+.\d+/, " Looks like a proper version" ); -} - +} + ### _version_to_number tests ### { my $map = { - '1' => '1', - '1.2' => '1.2', - '.2' => '.2', - 'foo' => '0.0', - 'a.1' => '0.0', - '1.2.3' => '1.002003', - 'v1.2.3' => '1.002003', - 'v1.5' => '1.005000', - '1.5-a' => '1.500', - }; + '1' => '1', + '1.2' => '1.2', + '.2' => '.2', + 'foo' => '0.0', + 'a.1' => '0.0', + }; while( my($try,$expect) = each %$map ) { my $ver = $Class->_version_to_number( version => $try ); ok( $ver, "Version returned" ); is( $ver, $expect, " Value as expected" ); - } + } } ### _whoami tests ### -{ sub foo { - my $me = $Class->_whoami; +{ sub foo { + my $me = $Class->_whoami; ok( $me, "_whoami returned a result" ); - is( $me, 'foo', " Value as expected" ); - } + is( $me, 'foo', " Value as expected" ); + } foo(); } - + ### _mode_plus_w tests ### { open my $fh, ">$File" or die "Could not open $File for writing: $!"; close $fh; - + ### remove perms ok( -e $File, "File '$File' created" ); ok( chmod( 000, $File ), " File permissions set to 000" ); - + ok( $Class->_mode_plus_w( file => $File ), " File permissions set to +w" ); ok( -w $File, " File is writable" ); 1 while unlink $File; - + ok( !-e $File, " File removed" ); } -### uri encode/decode tests +### uri encode/decode tests { my $org = 'file://foo/bar'; my $enc = $Class->_uri_encode( uri => $org ); - + ok( $enc, "String '$org' encoded" ); like( $enc, qr/%/, " Contents as expected" ); - + my $dec = $Class->_uri_decode( uri => $enc ); ok( $dec, "String '$enc' decoded" ); is( $dec, $org, " Decoded properly" ); -} - - +} + + # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t index 152a9ac632f..fc02640c7aa 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/01_CPANPLUS-Configure.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -15,7 +15,7 @@ my $Config_pm = 'CPANPLUS/Config.pm'; for my $mod (qw[CPANPLUS::Configure]) { use_ok($mod) or diag qq[Can't load $mod]; -} +} my $c = CPANPLUS::Configure->new(); isa_ok($c, 'CPANPLUS::Configure'); @@ -38,33 +38,33 @@ for my $cat ( $r->ls_accessors ) { ### copy for use on the config object itself my $accessor = $cat; my $prepend = ($cat =~ s/^_//) ? '_' : ''; - + my $getmeth = $prepend . 'get_'. $cat; my $setmeth = $prepend . 'set_'. $cat; my $addmeth = $prepend . 'add_'. $cat; - + ok( scalar(@options), "Possible options obtained" ); - + ### test adding keys too ### { my $add_key = 'test_key'; my $add_val = [1..3]; - + my $found = grep { $add_key eq $_ } @options; ok( !$found, "Key '$add_key' not yet defined" ); ok( $c->$addmeth( $add_key => $add_val ), - " $addmeth('$add_key' => VAL)" ); + " $addmeth('$add_key' => VAL)" ); ### this one now also exists ### push @options, $add_key } - ### poke in the object, get the actual hashref out ### + ### poke in the object, get the actual hashref out ### my %hash = map { - $_ => $r->$accessor->$_ + $_ => $r->$accessor->$_ } $r->$accessor->ls_accessors; - + while( my ($key,$val) = each %hash ) { - my $is = $c->$getmeth($key); + my $is = $c->$getmeth($key); is_deeply( $val, $is, "deep check for '$key'" ); ok( $c->$setmeth($key => 1 ), " $setmeth('$key' => 1)" ); is( $c->$getmeth($key), 1, " $getmeth('$key')" ); @@ -74,15 +74,15 @@ for my $cat ( $r->ls_accessors ) { ### now check if we found all the keys with options or not ### delete $hash{$_} for @options; ok( !(scalar keys %hash), "All possible keys found" ); - -} + +} ### see if we can save the config ### { my $dir = File::Spec->rel2abs('dummy-cpanplus'); my $pm = 'CPANPLUS::Config::Test' . $$; my $file = $c->save( $pm, $dir ); - + ok( $file, "Config $pm saved" ); ok( -e $file, " File exists" ); ok( -s $file, " File has size" ); @@ -92,23 +92,23 @@ for my $cat ( $r->ls_accessors ) { ok( $c->init( rescan => 1 ), "Reran ->init()" ); } - + ### make sure this file is now loaded - ### XXX can't trust bloody dir separators on Win32 in %INC, + ### XXX can't trust bloody dir seperators on Win32 in %INC, ### so rather than an exact match, do a grep... - my ($found) = grep /\bTest$$/, values %INC; + my ($found) = grep /\bTest$$/, values %INC; ok( $found, " Found $file in \%INC" ); ok( -e $file, " File exists" ); 1 while unlink $file; ok(!-e $file, " File removed" ); - + } { my $env = ENV_CPANPLUS_CONFIG; local $ENV{$env} = $$; my $ok = $c->init; my $stack = CPANPLUS::Error->stack_as_string; - + ok( $ok, "Reran init again" ); like( $stack, qr/Specifying a config file in your environment/, " Warning logged" ); @@ -116,16 +116,16 @@ for my $cat ( $r->ls_accessors ) { { CPANPLUS::Error->flush; - - { ### try a bogus method call + + { ### try a bogus method call my $x = $c->flubber('foo'); my $err = CPANPLUS::Error->stack_as_string; is ($x, undef, "Bogus method call returns undef"); like($err, "/flubber/", " Bogus method call recognized"); } - + CPANPLUS::Error->flush; -} +} # Local variables: diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t index 46a7cb6e208..84b78f3ade3 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/02_CPANPLUS-Internals.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -23,21 +23,21 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); ok( $del, "ID deleted" ); isa_ok( $del, "CPANPLUS::Internals" ); is( $del, $cb, " Deleted ID matches last object" ); - + my $id = $cb->_store_id( $del ); ok( $id, "ID stored" ); is( $id, $cb->_id, " Stored proper ID" ); - + my $obj = $cb->_retrieve_id( $id ); ok( $obj, "Object retrieved from ID" ); isa_ok( $obj, 'CPANPLUS::Internals' ); is( $obj->_id, $id, " Retrieved ID properly" ); - + my @obs = $cb->_return_all_objects(); ok( scalar(@obs), "Returned objects" ); is( scalar(@obs), 1, " Proper amount of objects found" ); is( $obs[0]->_id, $id, " Proper ID found on object" ); - + my $lid = $cb->_last_id; ok( $lid, "Found last registered ID" ); is( $lid, $id, " ID matches last object" ); @@ -45,29 +45,29 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); my $iid = $cb->_inc_id; ok( $iid, "Incremented ID" ); is( $iid, $id+1, " ID matched last ID + 1" ); -} +} ### host ok test ### { my $host = $cb->configure_object->get_conf('hosts')->[0]; - + is( $cb->_host_ok( host => $host ), 1, "Host ok" ); is( $cb->_add_fail_host(host => $host), 1, " Host now marked as bad" ); is( $cb->_host_ok( host => $host ), 0, " Host still bad" ); ok( $cb->_flush( list => ['hosts'] ), " Hosts flushed" ); is( $cb->_host_ok( host => $host ), 1, " Host now ok again" ); -} +} ### flush loads test { my $mod = 'Benchmark'; my $file = $mod . '.pm'; - + ### XXX whitebox test -- mark this module as unloadable $Module::Load::Conditional::CACHE->{$mod}->{usable} = 0; ok( !can_load( modules => { $mod => 0 }, verbose => 0 ), "'$mod' not loaded" ); - + ok( $cb->flush('load'), " 'load' cache flushed" ); ok( can_load( modules => { $mod => 0 }, verbose => 0 ), " '$mod' loaded" ); @@ -76,30 +76,30 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); ### add to inc path tests { my $meth = '_add_to_includepath'; can_ok( $cb, $meth ); - + my $p5lib = $ENV{PERL5LIB} || ''; - my $inc = "@INC"; - ok( $cb->$meth( directories => [$$] ), + my $inc = "@INC"; + ok( $cb->$meth( directories => [$$] ), " CB->$meth( $$ )" ); - + my $new_p5lib = $ENV{PERL5LIB}; - my $new_inc = "@INC"; + my $new_inc = "@INC"; isnt( $p5lib, $new_p5lib, " PERL5LIB is now: $new_p5lib" ); like( $new_p5lib, qr/$$/, " Matches $$" ); isnt( $inc, $new_inc, ' @INC is expanded with: ' . $$ ); like( $new_inc, qr/$$/, " Matches $$" ); - - ok( $cb->$meth( directories => [$$] ), + + ok( $cb->$meth( directories => [$$] ), " CB->$meth( $$ ) again" ); is( "@INC", $new_inc, ' @INC unchanged' ); is( $new_p5lib, $ENV{PERL5LIB}, " PERL5LIB unchanged" ); -} +} ### callback registering tests ### { my $callback_map = { - ### name default value + ### name default value install_prerequisite => 1, # install prereqs when 'ask' is set? edit_test_report => 0, # edit the prepared test report? send_test_report => 1, # send the test report? @@ -110,32 +110,32 @@ is($cb->_id, $cb->_last_id, "Comparing ID's"); }; for my $callback ( keys %$callback_map ) { - + { my $rv = $callback_map->{$callback}; is( $rv, $cb->_callbacks->$callback->( $0, $$ ), "Default callback '$callback' called" ); - like( CPANPLUS::Error->stack_as_string, qr/DEFAULT '\S+' HANDLER/s, - " Default handler warning recorded" ); + like( CPANPLUS::Error->stack_as_string, qr/DEFAULT '\S+' HANDLER/s, + " Default handler warning recorded" ); CPANPLUS::Error->flush; } - + ### try to register the callback my $ok = $cb->_register_callback( name => $callback, code => sub { return $callback } ); - + ok( $ok, "Registered callback '$callback' ok" ); - + my $sub = $cb->_callbacks->$callback; ok( $sub, " Retrieved callback" ); ok( IS_CODEREF->($sub), " Callback is a sub" ); - + my $rv = $sub->(); ok( $rv, " Callback called ok" ); is( $rv, $callback, " Got expected return value" ); - } + } } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t index d6ad2ea94f6..65f1e54c352 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/03_CPANPLUS-Internals-Source.t @@ -1,14 +1,14 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } use strict; use Module::Load; -use Test::More eval { - load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1 +use Test::More eval { + load $ENV{CPANPLUS_SOURCE_ENGINE} if $ENV{CPANPLUS_SOURCE_ENGINE}; 1 } ? 'no_plan' : (skip_all => "SQLite engine not available"); @@ -20,7 +20,6 @@ use Data::Dumper; use File::Basename qw[dirname]; my $conf = gimme_conf(); -$conf->set_conf( enable_custom_sources => 1 ); my $cb = CPANPLUS::Backend->new( $conf ); ### XXX temp @@ -36,12 +35,12 @@ my $modname = TEST_CONF_MODULE; ### source files should be copied from the 'server' now for my $name (qw[auth mod dslip] ) { - my $file = File::Spec->catfile( + my $file = File::Spec->catfile( $conf->get_conf('base'), $conf->_get_source($name) - ); + ); ok( (-e $file && -f _ && -s _), "$file exists" ); - } + } ok( $at, "Authortree loaded successfully" ); ok( scalar keys %$at, " Authortree has items in it" ); @@ -56,7 +55,7 @@ my $modname = TEST_CONF_MODULE; } ### save state tests -SKIP: { +SKIP: { skip "Save state tests for custom engine $ENV{CPANPLUS_SOURCE_ENGINE}", 7 if $ENV{CPANPLUS_SOURCE_ENGINE}; @@ -74,44 +73,44 @@ SKIP: { my $rv = $cb->save_state; ok( $rv, " State information saved" ); - - like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/, + + like( CPANPLUS::Error->stack_as_string, qr/Writing compiled source/, " Diagnostics confirmed" ); } - + ### now we rebuild the trees from disk and ### check if the module object has a status saved with it { CPANPLUS::Error->flush; ok( $cb->_build_trees( uptodate => 1, use_stored => 1), " Trees are rebuilt" ); - like( CPANPLUS::Error->stack_as_string, qr/Retrieving/, + like( CPANPLUS::Error->stack_as_string, qr/Retrieving/, " Diagnostics confirmed" ); - + my $mod = $cb->_module_tree->{$modname}; ok( $mod->status, " Status now set in module object" ); - } + } } ### check custom sources ### XXX whitebox test -SKIP: { +SKIP: { ### first, find a file to serve as a source my $mod = $cb->_module_tree->{$modname}; my $package = File::Spec->rel2abs( - File::Spec->catfile( + File::Spec->catfile( $FindBin::Bin, TEST_CONF_CPAN_DIR, $mod->path, $mod->package, ) - ); - + ); + ok( $package, "Found file for custom source" ); ok( -e $package, " File '$package' exists" ); - ### remote uri + ### remote uri my $uri = $cb->_host_to_uri( scheme => 'file', host => '', @@ -119,25 +118,25 @@ SKIP: { ); my $expected_file = $cb->__custom_module_source_index_file( uri => $uri ); - + ok( $expected_file, "Sources should be written to '$uri'" ); - + skip( "Index file size too long (>260 chars). Can't write to disk", 28 ) if length $expected_file > 260 and ON_WIN32; + - - ### local file + ### local file ### 2 tests my $src_file = $cb->_add_custom_module_source( uri => $uri ); - ok( $src_file, "Sources written to '$src_file'" ); - ok( -e $src_file, " File exists" ); - - ### and write the file + ok( $src_file, "Sources written to '$src_file'" ); + ok( -e $src_file, " File exists" ); + + ### and write the file ### 5 tests { my $meth = '__write_custom_module_index'; can_ok( $cb, $meth ); - my $rv = $cb->$meth( + my $rv = $cb->$meth( path => dirname( $package ), to => $src_file ); @@ -146,26 +145,26 @@ SKIP: { is( $rv, $src_file, " Written to expected file" ); ok( -e $src_file, " Source file exists" ); ok( -s $src_file, " File has non-zero size" ); - } - + } + ### let's see if we can find our custom files ### 3 tests { my $meth = '__list_custom_module_sources'; can_ok( $cb, $meth ); - + my %files = $cb->$meth; ok( scalar(keys(%files)), " Got list of sources" ); - + ### on VMS, we can't predict the case unfortunately ### so grep for it instead; - my $found = map { + my $found = map { my $src_re = quotemeta($src_file); $_ =~ /$src_re/i; } keys %files; ok( $found, " Found proper entry for $src_file" ); - } + } ### now we can have it be loaded in ### 6 tests @@ -179,7 +178,7 @@ SKIP: { my $add = $cb->_module_tree->{$add_name}; ok( $add, " Found added module" ); - ok( $add->status->_fetch_from, + ok( $add->status->_fetch_from, " Full download path set" ); is( $add->author->cpanid, CUSTOM_AUTHOR_ID, " Attributed to custom author" ); @@ -194,60 +193,60 @@ SKIP: { ### 3 tests { my $meth = '__update_custom_module_sources'; can_ok( $cb, $meth ); - + ### mark what time it is now, sleep 1 second for better measuring - my $now = time; + my $now = time; sleep 1; - + my $ok = $cb->$meth; ok( $ok, "Custom sources updated" ); cmp_ok( [stat $src_file]->[9], '>=', $now, - " Timestamp on sourcefile updated" ); + " Timestamp on sourcefile updated" ); } - + ### now update it individually - ### 3 tests + ### 3 tests { my $meth = '__update_custom_module_source'; can_ok( $cb, $meth ); - + ### mark what time it is now, sleep 1 second for better measuring - my $now = time; + my $now = time; sleep 1; - + my $ok = $cb->$meth( remote => $uri ); ok( $ok, "Custom source for '$uri' updated" ); cmp_ok( [stat $src_file]->[9], '>=', $now, - " Timestamp on sourcefile updated" ); + " Timestamp on sourcefile updated" ); } ### now update using the higher level API, see if it's part of the update - ### 3 tests + ### 3 tests { CPANPLUS::Error->flush; ### mark what time it is now, sleep 1 second for better measuring - my $now = time; + my $now = time; sleep 1; - + my $ok = $cb->_build_trees( uptodate => 0, use_stored => 0, ); - + ok( $ok, "All sources updated" ); cmp_ok( [stat $src_file]->[9], '>=', $now, - " Timestamp on sourcefile updated" ); + " Timestamp on sourcefile updated" ); like( CPANPLUS::Error->stack_as_string, qr/Updating sources from/, " Update recorded in the log" ); } - + ### now remove the index file; - ### 3 tests + ### 3 tests { my $meth = '_remove_custom_module_source'; can_ok( $cb, $meth ); - + my $file = $cb->$meth( uri => $uri ); ok( $file, "Index file removed" ); ok( ! -e $file, " File '$file' no longer on disk" ); diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t index 1014e62bdab..f45755143b5 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/04_CPANPLUS-Module.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -21,7 +21,7 @@ my $Conf = gimme_conf(); my $CB = CPANPLUS::Backend->new( $Conf ); ### start with fresh sources ### -ok( $CB->reload_indices( update_source => 0 ), "Rebuilding trees" ); +ok( $CB->reload_indices( update_source => 0 ), "Rebuilding trees" ); my $AuthName = TEST_CONF_AUTHOR; my $Auth = $CB->author_tree( $AuthName ); @@ -48,17 +48,17 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); name => $ModName, comment => undef, package => 'Foo-Bar-0.01.tar.gz', - path => 'authors/id/EUNOXS', + path => 'authors/id/EUNOXS', version => '0.01', dslip => 'cdpO ', - description => 'CPANPLUS Test Package', + description => 'CPANPLUS Test Package', mtime => '', author => $Auth, - ); + ); my @acc = $Mod->accessors; ok( scalar(@acc), "Retrieved module accessors" ); - + ### remove private accessors is_deeply( [ sort keys %map ], [ sort grep { $_ !~ /^_/ } @acc ], " About to test all accessors" ); @@ -71,7 +71,7 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ### check accessor objects ### isa_ok( $Mod->parent, 'CPANPLUS::Backend' ); isa_ok( $Mod->author, 'CPANPLUS::Module::Author' ); - is( $Mod->author->author, $Auth->author, + is( $Mod->author->author, $Auth->author, "Module eq Author" ); } @@ -89,18 +89,18 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); { my $clone = $Mod->clone; ok( $clone, "Module cloned" ); isa_ok( $clone, 'CPANPLUS::Module' ); - + for my $acc ( $Mod->accessors ) { is( $clone->$acc, $Mod->$acc, " Clone->$acc matches Mod->$acc " ); } - - ### XXX whitebox test + + ### XXX whitebox test ok( !$clone->_status, "Status object empty on start" ); - + my $status = $clone->status; ok( $status, " Status object defined after query" ); - is( $status, $clone->_status, + is( $status, $clone->_status, " Object stored as expected" ); isa_ok( $status, 'Object::Accessor' ); } @@ -109,18 +109,18 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ok( !$Mod->extract(), "Cannot extract unfetched file" ); like( CPANPLUS::Error->stack_as_string, qr/You have not fetched/, " Error properly logged" ); -} +} { ### fetch tests ### ### enable signature checks for checksums ### my $old = $Conf->get_conf('signature'); - $Conf->set_conf(signature => 1); - + $Conf->set_conf(signature => 1); + my $where = $Mod->fetch( force => 1 ); ok( $where, "Module fetched" ); ok( -f $where, " Module is a file" ); ok( -s $where, " Module has size" ); - + $Conf->set_conf( signature => $old ); } @@ -142,26 +142,26 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); SKIP: { skip(q[You chose not to enable checksum verification], 5) unless $Conf->get_conf('md5'); - + my $cksum_file = $Mod->checksums; ok( $cksum_file, "Checksum file found" ); is( $cksum_file, $Mod->status->checksums, " File stored in module object" ); ok( -e $cksum_file, " File exists" ); ok( -s $cksum_file, " File has size" ); - + ### XXX test checksum_value if there's digest::md5 + config wants it ok( $Mod->status->checksum_ok, " Checksum is ok" ); - - ### check ttl code for checksums; fetching it now means the cache + + ### check ttl code for checksums; fetching it now means the cache ### should kick in { CPANPLUS::Error->flush; - ok( $Mod->checksums, + ok( $Mod->checksums, " Checksums re-fetched" ); like( CPANPLUS::Error->stack_as_string, qr/Using cached file/, " Cached file used" ); - } + } } } @@ -177,14 +177,14 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); SKIP: { skip(q[You chose not to enable signature checks], 1) unless $Conf->get_conf('signature'); - + ok( $Mod->check_signature, "Signature check OK" ); } } ### dslip & related -{ my $dslip = $Mod->dslip; +{ my $dslip = $Mod->dslip; ok( $dslip, "Got dslip information from $ModName ($dslip)" ); ### now find it for a submodule @@ -193,33 +193,33 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ok( $submod->dslip, " Got dslip info (".$submod->dslip.")" ); is( $submod->dslip, $dslip, " It's identical to $ModName" ); - } + } } -{ ### details() test ### +{ ### details() test ### my $href = { 'Support Level' => 'Developer', 'Package' => $Mod->package, 'Description' => $Mod->description, - 'Development Stage' => + 'Development Stage' => 'under construction but pre-alpha (not yet released)', 'Author' => sprintf("%s (%s)", $Auth->author, $Auth->email), 'Version on CPAN' => $Mod->version, - 'Language Used' => + 'Language Used' => 'Perl-only, no compiler needed, should be platform independent', - 'Interface Style' => + 'Interface Style' => 'Object oriented using blessed references and/or inheritance', - 'Public License' => 'Unknown', + 'Public License' => 'Unknown', ### XXX we can't really know what you have installed ### #'Version Installed' => '0.06', - }; + }; my $res = $Mod->details; - + ### delete they key of which we don't know the value ### delete $res->{'Version Installed'}; - - is_deeply( $res, $href, "Details OK" ); + + is_deeply( $res, $href, "Details OK" ); } { ### contians() test ### @@ -227,9 +227,9 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ### we use 4x the same package name for different modules. So use ### the only unique package name here, which is the one for the core mod my @list = $CoreMod->contains; - + ok( scalar(@list), "Found modules contained in this one" ); - is_deeply( \@list, [$CoreMod], + is_deeply( \@list, [$CoreMod], " Found all modules expected" ); } @@ -263,9 +263,9 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); my @objs = $bundle->bundle_modules; is( scalar(@objs), 5, " Found all prerequisites" ); - + for( @objs ) { - isa_ok( $_, 'CPANPLUS::Module', + isa_ok( $_, 'CPANPLUS::Module', " Prereq " . $_->module ); ok( defined $bundle->status->prereqs->{$_->module}, " Prereq was registered" ); @@ -273,21 +273,21 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); } { ### testing autobundles - my $file = File::Spec->catfile( - dummy_cpan_dir(), + my $file = File::Spec->catfile( + dummy_cpan_dir(), $Conf->_get_build('autobundle'), - 'Snapshot.pm' + 'Snapshot.pm' ); my $uri = $CB->_host_to_uri( scheme => 'file', path => $file ); my $bundle = $CB->parse_module( module => $uri ); - + ok( -e $file, "Creating bundle from '$file'" ); ok( $bundle, " Object created" ); isa_ok( $bundle, 'CPANPLUS::Module', " Object" ); ok( $bundle->is_bundle, " Recognized as bundle" ); ok( $bundle->is_autobundle, " Recognized as autobundle" ); - + my $type = $bundle->get_installer_type; ok( $type, " Found installer type" ); is( $type, INSTALLER_AUTOBUNDLE, @@ -303,7 +303,7 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); is( scalar(@list), 1, " Right number of prereqs" ); isa_ok( $list[0], 'CPANPLUS::Module', " Object" ); - + ### skiptests to make sure we don't get any test header mismatches my $rv = $bundle->create( prereq_target => 'create', skiptest => 1 ); ok( $rv, " Tested prereqs" ); @@ -313,28 +313,28 @@ isa_ok( $Auth->parent, 'CPANPLUS::Backend' ); ### test module from perl core ### { isa_ok( $CoreMod, 'CPANPLUS::Module', "Core module " . $CoreName ); - ok( $CoreMod->package_is_perl_core, + ok( $CoreMod->package_is_perl_core, " Package found in perl core" ); - + ### check if it's core with 5.6.1 { local $] = '5.006001'; ok( $CoreMod->module_is_supplied_with_perl_core, " Module also found in perl core"); } - + ok( !$CoreMod->install, " Package not installed" ); like( CPANPLUS::Error->stack_as_string, qr/core Perl/, " Error properly logged" ); -} +} ### test third-party modules SKIP: { - skip "Module::ThirdParty not installed", 10 + skip "Module::ThirdParty not installed", 10 unless eval { require Module::ThirdParty; 1 }; - ok( !$Mod->is_third_party, + ok( !$Mod->is_third_party, "Not a 3rd party module: ". $Mod->name ); - + my $fake = $CB->parse_module( module => 'LOCAL/SVN-Core-1.0' ); ok( $fake, "Created module object for ". $fake->name ); ok( $fake->is_third_party, @@ -343,11 +343,11 @@ SKIP: { my $info = $fake->third_party_information; ok( $info, "Got 3rd party package information" ); isa_ok( $info, 'HASH' ); - + for my $item ( qw[name url author author_url] ) { ok( length($info->{$item}), " $item field is filled" ); - } + } } ### testing EU::Installed methods in Dist::MM tests ### diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t index 7a6b1acb86f..9d648fc38f7 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/05_CPANPLUS-Internals-Fetch.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -26,11 +26,11 @@ isa_ok( $mod, 'CPANPLUS::Module' ); ### fail host tests ### { my $host = {}; my $rv = $cb->_add_fail_host( host => $host ); - + ok( $rv, "Failed host added " ); - ok(!$cb->_host_ok( host => $host), + ok(!$cb->_host_ok( host => $host), " Host registered as failed" ); - ok( $cb->_host_ok( host => {} ), + ok( $cb->_host_ok( host => {} ), " Fresh host unregistered" ); } @@ -38,7 +38,7 @@ isa_ok( $mod, 'CPANPLUS::Module' ); { my $where = $cb->_fetch( module => $mod, force => 1 ); ok( $where, "File downloaded to '$where'" ); - ok( -s $where, " File exists" ); + ok( -s $where, " File exists" ); unlink $where; ok(!-e $where, " File removed" ); } @@ -46,24 +46,24 @@ isa_ok( $mod, 'CPANPLUS::Module' ); ### try to fetch something that doesn't exist ### { ### set up a bogus host first ### my $hosts = $conf->get_conf('hosts'); - my $fail = { scheme => 'file', + my $fail = { scheme => 'file', path => "$0/$0" }; - + unshift @$hosts, $fail; $conf->set_conf( hosts => $hosts ); - + ### the fallback host will get it ### my $where = $cb->_fetch( module => $mod, force => 1, verbose => 0 ); ok($where, "File downloaded to '$where'" ); - ok( -s $where, " File exists" ); - + ok( -s $where, " File exists" ); + ### but the error should be recorded ### like( CPANPLUS::Error->stack_as_string, qr/Fetching of .*? failed/s, - " Error recorded appropriately" ); + " Error recorded appropriately" ); ### host marked as bad? ### - ok(!$cb->_host_ok( host => $fail ), - " Failed host logged properly" ); + ok(!$cb->_host_ok( host => $fail ), + " Failed host logged properly" ); ### restore the hosts ### shift @$hosts; $conf->set_conf( hosts => $hosts ); @@ -82,23 +82,23 @@ isa_ok( $mod, 'CPANPLUS::Module' ); : File::Spec::Unix->catfile( File::Spec::Unix->catdir( File::Spec->splitdir( $cwd ) ), $base - ); - + ); + my $target = CREATE_FILE_URI->($in_file); my $fake = $cb->parse_module( module => $target ); - - ok( IS_FAKE_MODOBJ->(mod => $fake), + + ok( IS_FAKE_MODOBJ->(mod => $fake), "Fake module created from $0" ); is( $fake->status->_fetch_from, $target, - " Fetch from set ok" ); - + " Fetch from set ok" ); + my $where = $fake->fetch; ok( $where, " $target fetched ok" ); ok( -s $where, " $where exists" ); like( $where, '/'. UNKNOWN_DL_LOCATION .'/', " Saved to proper location" ); - like( $where, qr/$base$/, " Saved with proper name" ); + like( $where, qr/$base$/, " Saved with proper name" ); } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t index 993b2dc4ac0..65bde1181ab 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/06_CPANPLUS-Internals-Constants.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -40,7 +40,7 @@ ok( IS_CONFOBJ->( conf => $conf ), "IS_CONFOBJ recognizes conf object" ); ok( FILE_EXISTS->( file => basename($0) ), "FILE_EXISTS finds file" ); ok( FILE_READABLE->( file => basename($0) ), "FILE_READABLE finds file" ); ok( DIR_EXISTS->( dir => cwd() ), "DIR_EXISTS finds dir" ); - + { no strict 'refs'; @@ -56,18 +56,18 @@ ok( DIR_EXISTS->( dir => cwd() ), "DIR_EXISTS finds dir" ); : 'Makefile' }, }; - + while ( my($sub,$res) = each %$tmpl ) { is( &{$sub}->(), $res, "$sub returns proper result without args" ); - + my $long = File::Spec->catfile( cwd(), $res ); is( &{$sub}->( cwd() ), $long, "$sub returns proper result with args" ); - } -} - + } +} + # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: -# vim: expandtab shiftwidth=4: +# vim: expandtab shiftwidth=4: diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t index 3c18a3b9443..b03befa8ac7 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/07_CPANPLUS-Internals-Extract.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t index aba3a475f77..73611e872bf 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/08_CPANPLUS-Backend.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -25,8 +25,8 @@ isa_ok( $cb, $Class ); my $mt = $cb->module_tree; my $at = $cb->author_tree; -ok( scalar keys %$mt, "Module tree has entries" ); -ok( scalar keys %$at, "Author tree has entries" ); +ok( scalar keys %$mt, "Module tree has entries" ); +ok( scalar keys %$at, "Author tree has entries" ); ### module_tree tests ### my $Name = TEST_CONF_MODULE; @@ -35,7 +35,7 @@ my $mod = $cb->module_tree($Name); ### XXX SOURCEFILES FIX { my @mods = $cb->module_tree($Name,$Name); my $none = $cb->module_tree( TEST_CONF_INVALID_MODULE ); - + ok( IS_MODOBJ->(mod => $mod), "Module object found" ); is( scalar(@mods), 2, " Module list found" ); ok( IS_MODOBJ->(mod => $mods[0]), " ISA module object" ); @@ -46,7 +46,7 @@ my $mod = $cb->module_tree($Name); { my @auths = $cb->author_tree( $mod->author->cpanid, $mod->author->cpanid ); my $none = $cb->author_tree( 'fnurk' ); - + ok( IS_AUTHOBJ->(auth => $mod->author), "Author object found" ); is( scalar(@auths), 2, " Author list found" ); ok( IS_AUTHOBJ->( author => $auths[0] )," ISA author object" ); @@ -59,122 +59,122 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ### parse_module tests ### -{ my @map = ( - $Name => [ +{ my @map = ( + $Name => [ $mod->author->cpanid, # author $mod->package_name, # package name $mod->version, # version ], - $mod => [ - $mod->author->cpanid, - $mod->package_name, - $mod->version, + $mod => [ + $mod->author->cpanid, + $mod->package_name, + $mod->version, ], - 'Foo-Bar-EU-NOXS' => [ - $mod->author->cpanid, - $mod->package_name, + 'Foo-Bar-EU-NOXS' => [ + $mod->author->cpanid, + $mod->package_name, $mod->version, ], - 'Foo-Bar-EU-NOXS-0.01' => [ - $mod->author->cpanid, - $mod->package_name, + 'Foo-Bar-EU-NOXS-0.01' => [ + $mod->author->cpanid, + $mod->package_name, '0.01', ], - 'EUNOXS/Foo-Bar-EU-NOXS' => [ + 'EUNOXS/Foo-Bar-EU-NOXS' => [ 'EUNOXS', - $mod->package_name, + $mod->package_name, $mod->version, ], - 'EUNOXS/Foo-Bar-EU-NOXS-0.01' => [ - 'EUNOXS', - $mod->package_name, + 'EUNOXS/Foo-Bar-EU-NOXS-0.01' => [ + 'EUNOXS', + $mod->package_name, '0.01', ], ### existing module, no extension given ### this used to create a modobj with no package extension - 'EUNOXS/Foo-Bar-0.02' => [ - 'EUNOXS', + 'EUNOXS/Foo-Bar-0.02' => [ + 'EUNOXS', 'Foo-Bar', '0.02', ], - 'Foo-Bar-EU-NOXS-0.09' => [ - $mod->author->cpanid, - $mod->package_name, + 'Foo-Bar-EU-NOXS-0.09' => [ + $mod->author->cpanid, + $mod->package_name, '0.09', ], - 'MBXS/Foo-Bar-EU-NOXS-0.01' => [ - 'MBXS', - $mod->package_name, + 'MBXS/Foo-Bar-EU-NOXS-0.01' => [ + 'MBXS', + $mod->package_name, '0.01', ], - 'EUNOXS/Foo-Bar-EU-NOXS-0.09' => [ + 'EUNOXS/Foo-Bar-EU-NOXS-0.09' => [ 'EUNOXS', - $mod->package_name, + $mod->package_name, '0.09', ], - 'EUNOXS/Foo-Bar-EU-NOXS-0.09.zip' => [ + 'EUNOXS/Foo-Bar-EU-NOXS-0.09.zip' => [ 'EUNOXS', - $mod->package_name, + $mod->package_name, '0.09', ], - 'FROO/Flub-Flob-1.1.zip' => [ - 'FROO', - 'Flub-Flob', - '1.1', + 'FROO/Flub-Flob-1.1.zip' => [ + 'FROO', + 'Flub-Flob', + '1.1', ], - 'G/GO/GOYALI/SMS_API_3_01.tar.gz' => [ - 'GOYALI', - 'SMS_API', - '3_01', + 'G/GO/GOYALI/SMS_API_3_01.tar.gz' => [ + 'GOYALI', + 'SMS_API', + '3_01', ], - 'E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ - 'EYCK', - 'Net-Lite-FTP', + 'E/EY/EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ + 'EYCK', + 'Net-Lite-FTP', '0.091', ], - 'EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ + 'EYCK/Net/Lite/Net-Lite-FTP-0.091' => [ 'EYCK', - 'Net-Lite-FTP', + 'Net-Lite-FTP', '0.091', ], - 'M/MA/MAXDB/DBD-MaxDB-7.5.0.24a' => [ + 'M/MA/MAXDB/DBD-MaxDB-7.5.0.24a' => [ 'MAXDB', 'DBD-MaxDB', - '7.5.0.24a', + '7.5.0.24a', ], - 'EUNOXS/perl5.005_03.tar.gz' => [ - 'EUNOXS', + 'EUNOXS/perl5.005_03.tar.gz' => [ + 'EUNOXS', 'perl', '5.005_03', ], - 'FROO/Flub-Flub-v1.1.0.tbz' => [ - 'FROO', - 'Flub-Flub', - 'v1.1.0', + 'FROO/Flub-Flub-v1.1.0.tbz' => [ + 'FROO', + 'Flub-Flub', + 'v1.1.0', ], - 'FROO/Flub-Flub-1.1_2.tbz' => [ - 'FROO', - 'Flub-Flub', + 'FROO/Flub-Flub-1.1_2.tbz' => [ + 'FROO', + 'Flub-Flub', '1.1_2', - ], - 'LDS/CGI.pm-3.27.tar.gz' => [ + ], + 'LDS/CGI.pm-3.27.tar.gz' => [ 'LDS', 'CGI', - '3.27', + '3.27', ], - 'FROO/Text-Tabs+Wrap-2006.1117.tar.gz' => [ - 'FROO', + 'FROO/Text-Tabs+Wrap-2006.1117.tar.gz' => [ + 'FROO', 'Text-Tabs+Wrap', - '2006.1117', - ], - 'JETTERO/Crypt-PBC-0.7.20.0-0.4.9' => [ + '2006.1117', + ], + 'JETTERO/Crypt-PBC-0.7.20.0-0.4.9' => [ 'JETTERO', 'Crypt-PBC', '0.7.20.0-0.4.9' , ], - 'GRICHTER/HTML-Embperl-1.2.1.tar.gz' => [ - 'GRICHTER', - 'HTML-Embperl', + 'GRICHTER/HTML-Embperl-1.2.1.tar.gz' => [ + 'GRICHTER', + 'HTML-Embperl', '1.2.1', ], 'KANE/File-Fetch-0.15_03' => [ @@ -186,18 +186,13 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); 'AUSCHUTZ', 'IO-Stty', '.02', - ], + ], '.' => [ 'CPANPLUS', 't', '', - ], - 'Foo/Bar.pm' => [ - $mod->author->cpanid, # author - $mod->package_name, # package name - $mod->version, # version - ], - ); + ], + ); while ( my($guess, $attr) = splice @map, 0, 2 ) { my( $author, $pkg_name, $version ) = @$attr; @@ -205,11 +200,11 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ok( $guess, "Attempting to parse $guess" ); my $obj = $cb->parse_module( module => $guess ); - + ok( $obj, " Result returned" ); - ok( IS_MODOBJ->( mod => $obj ), - " parse_module success by '$guess'" ); - + ok( IS_MODOBJ->( mod => $obj ), + " parse_module success by '$guess'" ); + is( $obj->version, $version, " Proper version found: $version" ); is( $obj->package_version, $version, @@ -223,10 +218,10 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); { my $ext = $obj->package_extension; ok( $ext, " Has extension as well: $ext" ); } - - like( $obj->author->cpanid, "/$author/i", + + like( $obj->author->cpanid, "/$author/i", " Proper author found: $author"); - like( $obj->path, "/$author/i", + like( $obj->path, "/$author/i", " Proper path found: " . $obj->path ); } @@ -238,49 +233,49 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); [qr/Cannot find .+? in the module tree/,"Unable to find module"] ] ], [ {}, => [ - [ qr/module string from reference/,"Unable to parse ref"] + [ qr/module string from reference/,"Unable to parse ref"] ] ], ); for my $entry ( @map ) { my($mod,$aref) = @$entry; - + my $none = $cb->parse_module( module => $mod ); - ok( !IS_MODOBJ->(mod => $none), - "Non-existent module detected" ); + ok( !IS_MODOBJ->(mod => $none), + "Non-existant module detected" ); ok( !IS_FAKE_MODOBJ->(mod => $none), - "Non-existent fake module detected" ); - + "Non-existant fake module detected" ); + my $str = CPANPLUS::Error->stack_as_string; for my $pair (@$aref) { my($re,$diag) = @$pair; like( $str, $re," $diag" ); } - } + } } - + ### test parsing of arbitrary URI for my $guess ( qw[ http://foo/bar.gz http://a/b/c/d/e/f/g/h/i/j flub://floo ] ) { my $obj = $cb->parse_module( module => $guess ); - ok( IS_FAKE_MODOBJ->(mod => $obj), + ok( IS_FAKE_MODOBJ->(mod => $obj), "parse_module success by '$guess'" ); is( $obj->status->_fetch_from, $guess, " Fetch from set ok" ); - } -} + } +} ### RV tests ### { my $method = 'readme'; - my %args = ( modules => [$Name] ); - + my %args = ( modules => [$Name] ); + my $rv = $cb->$method( %args ); ok( IS_RVOBJ->( $rv ), "Got an RV object" ); ok( $rv->ok, " Overall OK" ); cmp_ok( $rv, '==', 1, " Overload OK" ); - is( $rv->function, $method, " Function stored OK" ); + is( $rv->function, $method, " Function stored OK" ); is_deeply( $rv->args, \%args, " Arguments stored OK" ); is( $rv->rv->{$Name}, $mod->readme, " RV as expected" ); } @@ -290,18 +285,18 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); my $file = File::Spec->catfile( $conf->get_conf('base'), $conf->_get_source('mod'), ); - - ok( $cb->reload_indices( update_source => 0 ), "Rebuilding trees" ); + + ok( $cb->reload_indices( update_source => 0 ), "Rebuilding trees" ); my $age = -M $file; - + ### make sure we are 'newer' on faster machines with a sleep.. ### apparently Win32's FAT isn't granual enough on intervals ### < 2 seconds, so it may give the same answer before and after ### the sleep, causing the test to fail. so sleep atleast 2 seconds. sleep 2; - ok( $cb->reload_indices( update_source => 1 ), + ok( $cb->reload_indices( update_source => 1 ), "Rebuilding and refetching trees" ); - cmp_ok( $age, '>', -M $file, " Source file '$file' updated" ); + cmp_ok( $age, '>', -M $file, " Source file '$file' updated" ); } ### flush tests ### @@ -313,8 +308,8 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ### installed tests ### { ok( scalar($cb->installed), "Found list of installed modules" ); -} - +} + ### autobudle tests ### { my $where = $cb->autobundle; @@ -323,17 +318,17 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); } ### local_mirror tests ### -{ ### turn off md5 checks for the 'fake' packages we have +{ ### turn off md5 checks for the 'fake' packages we have my $old_md5 = $conf->get_conf('md5'); $conf->set_conf( md5 => 0 ); ### otherwise 'status->fetch' might be undef! ### my $rv = $cb->local_mirror( path => 'dummy-localmirror' ); ok( $rv, "Local mirror created" ); - + for my $mod ( values %{ $cb->module_tree } ) { my $name = $mod->module; - + my $cksum = File::Spec->catfile( dirname($mod->status->fetch), CHECKSUMS ); @@ -341,10 +336,10 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); ok( -s _, " Module '$name' has size" ); ok( -e $cksum, " Checksum fetched for '$name'" ); ok( -s _, " Checksum for '$name' has size" ); - } + } $conf->set_conf( md5 => $old_md5 ); -} +} ### check ENV variable { ### process id @@ -353,23 +348,23 @@ ok( IS_CONFOBJ->(conf => $conf_obj), "Configure object found" ); is( $ENV{$name}, $$, " Set to current process id" ); } - ### Version + ### Version { my $name = 'PERL5_CPANPLUS_IS_VERSION'; ok( $ENV{$name}, "Env var '$name' set" ); ### version.pm formats ->VERSION output... *sigh* - is( $ENV{$name}, $Class->VERSION, + is( $ENV{$name}, $Class->VERSION, " Set to current process version" ); } - + } -__END__ - +__END__ + # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: -# vim: expandtab shiftwidth=4: - +# vim: expandtab shiftwidth=4: + diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t index e5ef37cb686..c00437d09a7 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/09_CPANPLUS-Internals-Search.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -37,7 +37,7 @@ for my $type ( CPANPLUS::Module->accessors() ) { ### search for authors ### my $auth = $Mod->author; for my $type ( CPANPLUS::Module::Author->accessors() ) { - + ### don't muck around with references/objects ### or private identifiers next if ref $auth->$type() or $type =~/^_/; diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t index 355ca7aad49..800a126c0d2 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/10_CPANPLUS-Error.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -19,7 +19,7 @@ my $map = { error => ["This is just a test error"], }; -### check if CPANPLUS::Error can do what we expect +### check if CPANPLUS::Error can do what we expect { for my $name ( keys %$map ) { can_ok('CPANPLUS::Error', $name); can_ok('main', $name); # did it get exported? @@ -28,8 +28,8 @@ my $map = { ### make sure we start with an empty stack { CPANPLUS::Error->flush; - is( scalar(()=CPANPLUS::Error->stack), 0, - "Starting with empty stack" ); + is( scalar(()=CPANPLUS::Error->stack), 0, + "Starting with empty stack" ); } ### global variables test ### @@ -37,9 +37,9 @@ my $map = { ### this *has* to be set, as we're testing the contents of the file ### to see if it matches what's stored in the buffer. - local $CPANPLUS::Error::MSG_FH = output_handle(); + local $CPANPLUS::Error::MSG_FH = output_handle(); local $CPANPLUS::Error::ERROR_FH = output_handle(); - + ok( -e $file, "Output redirect file exists" ); ok( !-s $file, " Output file is empty" ); @@ -51,40 +51,40 @@ my $map = { } ### must close it for Win32 tests! - close output_handle; + close output_handle; ok( -s $file, " Output file now has size" ); - + my $fh = FileHandle->new( $file ); ok( $fh, "Opened output file for reading " ); - + my $contents = do { local $/; <$fh> }; my $string = CPANPLUS::Error->stack_as_string; my $trace = CPANPLUS::Error->stack_as_string(1); - + ok( $contents, " Got the file contents" ); ok( $string, "Got the error stack as string" ); - - + + for my $type ( keys %$map ) { my $tag = $type; $tag =~ s/.+?_//g; - + for my $str (@{ $map->{$type} } ) { like( $contents, qr/\U\Q$tag/, - " Contents matches for '$type'" ); + " Contents matches for '$type'" ); like( $contents, qr/\Q$str/, - " Contents matches for '$type'" ); - + " Contents matches for '$type'" ); + like( $string, qr/\U\Q$tag/, - " String matches for '$type'" ); + " String matches for '$type'" ); like( $string, qr/\Q$str/, " String matches for '$type'" ); like( $trace, qr/\U\Q$tag/, - " Trace matches for '$type'" ); + " Trace matches for '$type'" ); like( $trace, qr/\Q$str/, " Trace matches for '$type'" ); - + ### extra trace tests ### like( $trace, qr/\Q$str\E.*?\Q$str/s, " Trace holds proper traceback" ); @@ -92,17 +92,17 @@ my $map = { " Trace holds program name" ); like( $trace, qr/line/, " Trace holds line number information" ); - } + } } ### check the stack, flush it, check again ### - is( scalar(()=CPANPLUS::Error->stack), scalar(keys(%$map)), + is( scalar(()=CPANPLUS::Error->stack), scalar(keys(%$map)), "All items on stack" ); is( scalar(()=CPANPLUS::Error->flush), scalar(keys(%$map)), "All items flushed" ); - is( scalar(()=CPANPLUS::Error->stack), 0, - "No items on stack" ); - + is( scalar(()=CPANPLUS::Error->stack), 0, + "No items on stack" ); + } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t index 51283c67275..2a7e8c6b87f 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/15_CPANPLUS-Shell.t @@ -1,8 +1,8 @@ ### the shell prints to STDOUT, so capture that here ### and we can check the output ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -17,7 +17,7 @@ BEGIN { sub _out { $out } sub _reset_out { $out = '' } -} +} use strict; use Test::More 'no_plan'; @@ -37,25 +37,22 @@ my $Default = SHELL_DEFAULT; my $TestMod = TEST_CONF_MODULE; my $TestAuth= TEST_CONF_AUTHOR; -unless ( -t ) { - ok('We are not on a terminal'); - exit 0; -} - + ### basic load tests use_ok( $Class, 'Default' ); is( $Class->which, SHELL_DEFAULT, "Default shell loaded" ); + ### create an object my $Shell = $Class->new( $Conf ); ok( $Shell, " New object created" ); isa_ok( $Shell, $Default, " Object" ); ### method tests -{ +{ ### uri to use for /cs tests my $cs_path = File::Spec->rel2abs( - File::Spec->catfile( + File::Spec->catfile( $FindBin::Bin, TEST_CONF_CPAN_DIR, ) @@ -65,10 +62,10 @@ isa_ok( $Shell, $Default, " Object" ); host => '', path => $cs_path, ); + + my $base = $Conf->get_conf('base'); - my $base = $Conf->get_conf('base'); - - ### XXX have to keep the list ordered, as some methods only work as + ### XXX have to keep the list ordered, as some methods only work as ### expected *after* others have run my @map = ( 'v' => qr/CPANPLUS/, @@ -95,7 +92,7 @@ isa_ok( $Shell, $Default, " Object" ); '! die $$; p' => qr/$$/, '/plugins' => qr/Available plugins:/i, '/? ?' => qr/usage/i, - + ### custom source plugin tests ### lower case path matching, as on VMS we can't predict case "/? cs" => qr|/cs|, @@ -113,21 +110,21 @@ isa_ok( $Shell, $Default, " Object" ); my $meth = 'dispatch_on_input'; can_ok( $Shell, $meth ); - + while( my($input,$out_re) = splice(@map, 0, 2) ) { ### empty output cache __PACKAGE__->_reset_out; CPANPLUS::Error->flush; - + ok( 1, "Testing '$input'" ); $Shell->$meth( input => $input ); - + my $out = __PACKAGE__->_out; - + ### XXX remove me #diag( $out ); - + ok( $out, " Output received" ); like( $out, $out_re, " Output matches '$out_re'" ); } @@ -135,18 +132,18 @@ isa_ok( $Shell, $Default, " Object" ); __END__ -#### test separately, they have side effects +#### test seperately, they have side effects 'q' => qr/^$/, # no output! -'s save boxed' => do { my $re = CONFIG_BOXED; qr/$re/ }, -### this doens't write any output +'s save boxed' => do { my $re = CONFIG_BOXED; qr/$re/ }, +### this doens't write any output 'x --update_source' => qr/module tree/i, s edit s reconfigure -'c' => '_reports', -'i' => '_install', +'c' => '_reports', +'i' => '_install', 'u' => '_uninstall', 'z' => '_shell', ### might not have any out of date modules... 'o' => '_uptodate', - + diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t index b551741eef6..cb0cd333050 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/19_CPANPLUS-Dist.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -21,7 +21,7 @@ BEGIN { require CPANPLUS::Dist; CPANPLUS::Dist->_add_dist_types( __PACKAGE__ ); - sub init { $_[0]->status->mk_accessors( + sub init { $_[0]->status->mk_accessors( qw[prepared created installed _prepare_args _install_args _create_args]); return $Init }; @@ -50,7 +50,7 @@ my $cb = CPANPLUS::Backend->new( $conf ); ### obsolete #my $Format = '_test'; my $Module = 'CPANPLUS::Dist::_Test'; -my $ModName = TEST_CONF_MODULE; +my $ModName = TEST_CONF_MODULE; my $ModPrereq = TEST_CONF_INST_MODULE; ### XXX this version doesn't exist, but we don't check for it either ### my $Prereq = { $ModPrereq => '1000' }; @@ -96,7 +96,7 @@ ok( $Mod, "Got module object" ); { local $CPANPLUS::Dist::_Test::Available = 0; ok( !$Module->format_available, - "Format availability turned off" ); + "Format availabillity turned off" ); { $conf->_set_build('sanity_check' => 0); @@ -108,9 +108,9 @@ ok( $Mod, "Got module object" ); } { $conf->_set_build('sanity_check' => 1); - + my $dist = $Module->new( module => $Mod ); - + ok( !$dist, "Dist not created with sanity check on" ); like( CPANPLUS::Error->stack_as_string, qr/Format '$Module' is not available/, @@ -122,7 +122,7 @@ ok( $Mod, "Got module object" ); { local $CPANPLUS::Dist::_Test::Init = 0; my $dist = $Module->new( module => $Mod ); - + ok( !$dist, "No dist created by failed init" ); like( CPANPLUS::Error->stack_as_string, qr/Dist initialization of '$Module' failed for/s, @@ -132,36 +132,36 @@ ok( $Mod, "Got module object" ); ### configure_requires tests { my $meta = META->( $Mod ); ok( $meta, "Reading 'configure_requires' from '$meta'" ); - + my $clone = $Mod->clone; ok( $clone, " Package cloned" ); ### set the new location to fetch from $clone->package( $meta ); - + my $file = $clone->fetch; ok( $file, " Meta file fetched" ); ok( -e $file, " File '$file' exits" ); - + my $dist = $Module->new( module => $Mod ); ok( $dist, " Dist object created" ); - - my $meth = 'find_configure_requires'; + + my $meth = 'find_configure_requires'; can_ok( $dist, $meth ); - + my $href = $dist->$meth( file => $file ); ok( $href, " '$meth' returned hashref" ); - + ok( scalar(keys(%$href)), " Contains entries" ); ok( $href->{ +TEST_CONF_PREREQ }, " Contains the right prereq" ); -} +} ### test _resolve prereqs, in a somewhat simulated set of circumstances { my $old_prereq = $conf->get_conf('prereqs'); - + my $map = { 0 => { 'Previous install failed' => [ @@ -199,6 +199,13 @@ ok( $Mod, "Got module object" ); " Dist installation failed recorded ok" ) }, ], + "Set dependency to be perl-core" => [ + sub { $cb->module_tree( $ModPrereq )->package( + 'perl-5.8.1.tar.gz' ); 'install' }, + sub { like( CPANPLUS::Error->stack_as_string, + qr/Prerequisite '$ModPrereq' is perl-core/s, + " Dist installation failed recorded ok" ) }, + ], 'Simple ignore' => [ sub { 'ignore' }, sub { ok( !$_[0]->status->prepared, @@ -222,10 +229,10 @@ ok( $Mod, "Got module object" ); 'Perl binary version too low' => [ sub { $cb->module_tree( $ModName ) ->status->prereqs({ PERL_CORE, 10000000000 }); '' }, - sub { like( CPANPLUS::Error->stack_as_string, + sub { like( CPANPLUS::Error->stack_as_string, qr/needs perl version/, " Perl version not high enough" ) }, - ], + ], }, 1 => { 'Simple create' => [ @@ -247,14 +254,6 @@ ok( $Mod, "Got module object" ); " Module status says installed" ) }, ], - "Set dependency to be perl-core" => [ - sub { $cb->module_tree( $ModPrereq )->package( - 'perl-5.8.1.tar.gz' ); 'install' }, - sub { like( CPANPLUS::Error->stack_as_string, - qr/Prerequisite '$ModPrereq' is perl-core/s, - " Dist installation failed recorded ok" ) }, - ], - 'Install from conf' => [ sub { $conf->set_conf(prereqs => PREREQ_INSTALL); '' }, sub { ok( $_[0]->status->prepared, @@ -316,10 +315,10 @@ ok( $Mod, "Got module object" ); 'Perl binary version sufficient' => [ sub { $cb->module_tree( $ModName ) ->status->prereqs({ PERL_CORE, 1 }); '' }, - sub { unlike( CPANPLUS::Error->stack_as_string, + sub { unlike( CPANPLUS::Error->stack_as_string, qr/needs perl version/, " Perl version sufficient" ) }, - ], + ], }, }; @@ -372,7 +371,7 @@ ok( $Mod, "Got module object" ); 0 => undef, 1 => undef, 2 => qr/have to resolve/, - }; + }; my $mod = CPANPLUS::Module::Fake->new( module => $$, @@ -382,37 +381,37 @@ ok( $Mod, "Got module object" ); ok( $mod, "Fake module created" ); is( $mod->version, 1, " Version set correctly" ); - + my $dist = $Module->new( module => $Mod ); - + ok( $dist, "Dist object created" ); isa_ok( $dist, $Module ); - - + + ### scope it for the locals { local $^W; # quell sub redefined warnings; - + ### is_uptodate will need to return false for this test local *CPANPLUS::Module::Fake::is_uptodate = sub { return }; local *CPANPLUS::Module::Fake::is_uptodate = sub { return }; - CPANPLUS::Error->flush; - - + CPANPLUS::Error->flush; + + ### it's satisfied while( my($ver, $re) = each %$map ) { - + my $rv = $dist->prereq_satisfied( version => $ver, modobj => $mod ); - - ok( 1, "Testing ver: $ver" ); + + ok( 1, "Testing ver: $ver" ); is( $rv, undef, " Return value as expected" ); - + if( $re ) { like( CPANPLUS::Error->stack_as_string, $re, " Error as expected" ); } - + CPANPLUS::Error->flush; } } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t index 5bba1371597..a203c88ffe3 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/20_CPANPLUS-Dist-MM.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -103,7 +103,7 @@ ok( $Mod->extract, "Extracting module to ".$Mod->status->extract ); ok( $dist, "Dist created with target => " . TARGET_INIT ); ok( !$dist->status->prepared, " Prepare was not run" ); -} +} ok( $Mod->test, "Testing module" ); @@ -141,20 +141,20 @@ SKIP: { ### make sure no options are set in PERL5_MM_OPT, as they might ### change the installation target and therefor will 1. mess up ### the tests and 2. leave an installed copy of our test module - ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t - ### fails (and leaves test files installed) when EUMM options + ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t + ### fails (and leaves test files installed) when EUMM options ### include INSTALL_BASE - { local $ENV{'PERL5_MM_OPT'}; local $ENV{'PERL_MM_OPT'}; - + { local $ENV{'PERL5_MM_OPT'}; + ### add the new dir to the configuration too, so eu::installed tests ### work as they should $conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] ); - - ok( $Mod->install( force => 1, - makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR, + + ok( $Mod->install( force => 1, + makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR, ), "Installing module" ); - } - + } + ok( $Mod->status->installed," Module installed according to status" ); @@ -164,8 +164,8 @@ SKIP: { ### #46890: ExtUtils::Installed + EU::MM PREFIX= don't always work ### well together skip( "ExtUtils::Installed issue #46890 prevents these tests from running reliably", 8 ); - - + + skip( "Old perl on cygwin detected " . "-- tests will fail due to known bugs", 8 ) if ON_OLD_CYGWIN; @@ -225,7 +225,7 @@ SKIP: { ### test exceptions in Dist::MM->create ### { ok( $Mod->status->mk_flush, "Old status info flushed" ); my $dist = INSTALLER_MM->new( module => $Mod ); - + ok( $dist, "New dist object made" ); ok(!$dist->prepare, " Dist->prepare failed" ); like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/, @@ -268,7 +268,7 @@ SKIP: { ok( $dist->write_makefile_pl( force => 0 ), " Makefile.PL written" ); like( CPANPLUS::Error->stack_as_string, qr/Already created/, - " Prior existence noted" ); + " Prior existance noted" ); ### ok, unlink the makefile.pl, now really write one 1 while unlink $makefile; @@ -308,7 +308,7 @@ SKIP: { { my $unlink_sts = unlink($makefile_pl); 1 while unlink $makefile_pl; ok( $unlink_sts, "Deleting Makefile.PL"); - } + } ok( !-s $makefile_pl, " Makefile.PL deleted" ); ok( $dist->status->mk_flush,"Dist status flushed" ); ok( $dist->prepare, " Dist->prepare run again" ); @@ -339,7 +339,7 @@ SKIP: { ### now let's write a makefile.pl that just does 'die' { local $^W; - local *CPANPLUS::Dist::MM::write_makefile_pl = + local *CPANPLUS::Dist::MM::write_makefile_pl = __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" ); ### there's no makefile.pl now, since the previous test failed @@ -360,8 +360,8 @@ SKIP: { { my $unlink_sts = unlink($makefile_pl); 1 while unlink $makefile_pl; ok( $unlink_sts, "Deleting Makefile.PL"); - } - + } + $dist->status->mk_flush; } @@ -370,21 +370,21 @@ SKIP: { my $env = ENV_CPANPLUS_IS_EXECUTING; my $sub = __PACKAGE__->_custom_makefile_pl_sub( "print qq[ENV=\$ENV{$env}\n]; exit 1;" ); - + my $clone = $Mod->clone; $clone->status->fetch( $Mod->status->fetch ); - + ok( $clone, 'Testing ENV settings $dist->prepare' ); ok( $clone->extract, ' Files extracted' ); ok( $clone->prepare, ' $mod->prepare worked first time' ); - + my $dist = $clone->status->dist; my $makefile_pl = MAKEFILE_PL->( $clone->status->extract ); ok( $sub->($dist), " Custom Makefile.PL written" ); ok( -e $makefile_pl, " File exists" ); - ### clear errors + ### clear errors CPANPLUS::Error->flush; my $rv = $dist->prepare( force => 1, verbose => 0 ); @@ -401,20 +401,20 @@ SKIP: { ### and the ENV var should no longer be set now ok( !$ENV{$env}, " ENV var now unset" ); -} +} sub _custom_makefile_pl_sub { my $pkg = shift; my $txt = shift or return; - + return sub { - my $dist = shift; + my $dist = shift; my $self = $dist->parent; my $fh = OPEN_FILE->( MAKEFILE_PL->($self->status->extract), '>' ); print $fh $txt; close $fh; - + return 1; } } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t index 10a2745d80d..55007ba5666 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/21_CPANPLUS-Dist-No-Build.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -27,27 +27,27 @@ my $Inst = INSTALLER_BUILD; my $Mod = $CB->module_tree( 'Foo::Bar::MB::NOXS' ); -ok( $Mod, "Module object retrieved" ); +ok( $Mod, "Module object retrieved" ); ok( not grep { $_ eq $Inst } CPANPLUS::Dist->dist_types, " $Inst installer not returned" ); - -### fetch the file first + +### fetch the file first { my $where = $Mod->fetch; ok( -e $where, " Tarball '$where' exists" ); } - -### extract it, silence warnings/messages + +### extract it, silence warnings/messages { my $where = $Mod->extract; ok( -e $where, " Tarball extracted to '$where'" ); } -### check the installer type -{ is( $Mod->status->installer_type, $Inst, +### check the installer type +{ is( $Mod->status->installer_type, $Inst, "Proper installer type found: $Inst" ); my $href = $Mod->status->configure_requires; ok( scalar(keys(%$href)), " Dependencies recorded" ); - + ok( defined $href->{$Inst}, " Dependency on $Inst" ); cmp_ok( $href->{$Inst}, '>', 0, " Minimum version: $href->{$Inst}" ); @@ -55,7 +55,7 @@ ok( not grep { $_ eq $Inst } CPANPLUS::Dist->dist_types, my $err = CPANPLUS::Error->stack_as_string; like( $err, qr/$Inst/, " Message mentions $Inst" ); like( $err, qr/prerequisites list/, - " Message mentions adding prerequisites" ); + " Message mentions adding prerequisites" ); } ### now run the test, it should trigger the installation of the installer @@ -65,30 +65,30 @@ ok( not grep { $_ eq $Inst } CPANPLUS::Dist->dist_types, ### bootstrapping creates a call to $cb->module_tree('c::d::build')->install ### we need to intercept that call my $org_mt = CPANPLUS::Backend->can('module_tree'); - local *CPANPLUS::Backend::module_tree = sub { + local *CPANPLUS::Backend::module_tree = sub { my $self = shift; my $mod = shift; - + ### return a dummy object if this is the bootstrap call return CPANPLUS::Test::Module->new if $mod eq $Inst; - + ### otherwise do a regular call return $org_mt->( $self, $mod, @_ ); }; - + ### bootstrap install call will abort the ->create() call, so catch ### that here eval { $Mod->create( skiptest => 1) }; - + ok( $@, "Create call aborted at bootstrap phase" ); like( $@, qr/$Inst/, " Diagnostics confirmed" ); - + my $diag = CPANPLUS::Error->stack_as_string; like( $diag, qr/This module requires.*$Inst/, " Dependency on $Inst recorded" ); like( $diag, qr/Bootstrapping installer.*$Inst/, " Bootstrap notice recorded" ); - like( $diag, qr/Installer '$Inst' successfully bootstrapped/, + like( $diag, qr/Installer '$Inst' succesfully bootstrapped/, " Successful bootstrap recorded" ); } @@ -97,18 +97,18 @@ END { 1 while unlink output_file() } ### place holder package to serve as a module object for C::D::Build { package CPANPLUS::Test::Module; sub new { return bless {} } - sub install { + sub install { ### at load time we ignored C::D::Build. Reset the ignore here ### so a 'rescan' after the 'install' picks up C::D::Build CPANPLUS::Dist->_reset_dist_ignore; - return 1; + return 1; } } ### test package for cpanplus::dist::build { package CPANPLUS::Dist::Build; use base 'CPANPLUS::Dist::Base'; - + ### shortcut out of the installation procedure sub new { die __PACKAGE__ }; sub format_available { 1 } diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t index b6723d35c64..9cbd15c7e3f 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/25_CPANPLUS.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -24,16 +24,16 @@ use_ok( $Class ); for my $meth ( qw[fetch get install] ) { my $sub = $Class->can( $meth ); ok( $sub, "$Class->can( $meth )" ); - + my %map = ( 0 => qr/failed/, 1 => qr/successful/, ); - + ok( 1, "Trying '$meth' in different configurations" ); - + while( my($rv, $re) = each %map ) { - + ### don't actually install, just test logic no warnings 'redefine'; local *CPANPLUS::Module::install = sub { $rv }; @@ -45,7 +45,7 @@ for my $meth ( qw[fetch get install] ) { is( $ok, $rv, " Expected RV: $rv" ); like( CPANPLUS::Error->stack_as_string, $re, " With expected diagnostic" ); - } + } ### does not take objects / references { CPANPLUS::Error->flush; @@ -74,15 +74,15 @@ for my $meth ( qw[fetch get install] ) { { ### test package for shell() method package CPANPLUS::Shell::Test; - + ### ->shell() looks in %INC use Module::Loaded qw[mark_as_loaded]; mark_as_loaded( __PACKAGE__ ); - sub new { bless {}, __PACKAGE__ }; + sub new { bless {}, __PACKAGE__ }; sub shell { $$ }; } - + my $rv = $sub->( 'Test' ); ok( $rv, " Shell started" ); is( $rv, $$, " Proper shell called" ); diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t index 6347daa21cd..a816faa1766 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/30_CPANPLUS-Internals-Selfupdate.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -35,7 +35,7 @@ my $Prereq = { $Dep => 0 }; } -### check specifically if our bundled shells dont trigger a +### check specifically if our bundled shells dont trigger a ### dependency (see #26077). ### do this _before_ changing the built in conf! { my $meth = 'modules_for_feature'; @@ -44,15 +44,15 @@ my $Prereq = { $Dep => 0 }; my $cur = $cobj->get_conf( $type ); for my $shell ( SHELL_DEFAULT, SHELL_CLASSIC ) { - ok( $cobj->set_conf( $type => $shell ), + ok( $cobj->set_conf( $type => $shell ), "Testing dependencies for '$shell'" ); my $rv = $CB->$Acc->$meth( $type => 1); ok( !$rv, " No dependencies for '$shell' -- bundled" ); - } - + } + for my $shell ( 'CPANPLUS::Test::Shell' ) { - ok( $cobj->set_conf( $type => $shell ), + ok( $cobj->set_conf( $type => $shell ), "Testing dependencies for '$shell'" ); my $rv = $CB->$Acc->$meth( $type => 1 ); @@ -62,7 +62,7 @@ my $Prereq = { $Dep => 0 }; is_deeply( $rv, { $shell => '0.0' }, " With the proper entries" ); } -} +} ### test the feature list { ### start with defining our OWN type of config, as not all mentioned @@ -75,7 +75,7 @@ my $Prereq = { $Dep => 0 }; } is_deeply( $Conf, $Class->_get_config, - "Config updated successfully" ); + "Config updated succesfully" ); my @cat = $CB->$Acc->list_categories; ok( scalar(@cat), "Category list returned" ); @@ -87,18 +87,18 @@ my $Prereq = { $Dep => 0 }; for my $feat (@feat) { my $meth = 'modules_for_feature'; my @mods = $CB->$Acc->$meth( $feat ); - + ok( $feat, "Testing feature '$feat'" ); ok( scalar( @mods ), " Module list returned" ); - + my $acc = 'is_installed_version_sufficient'; for my $mod (@mods) { isa_ok( $mod, "CPANPLUS::Module" ); isa_ok( $mod, $ModClass ); can_ok( $mod, $acc ); ok( $mod->$acc, " Module uptodate" ); - } - + } + ### check if we can get a hashref { my $href = $CB->$Acc->$meth( $feat, 1 ); ok( $href, "Got result as hash" ); @@ -106,7 +106,7 @@ my $Prereq = { $Dep => 0 }; is_deeply( $href, $Prereq, " With the proper entries" ); - } + } } ### see if we can get a list of modules to be updated @@ -124,7 +124,7 @@ my $Prereq = { $Dep => 0 }; cmp_ok( scalar(keys(%list)), '==', 1, "Got modules for '$cat' from '$meth'" ); - + my $aref = $list{$cat}; ok( $aref, " Got module list" ); cmp_ok( scalar(@$aref), '==', 1, @@ -136,22 +136,22 @@ my $Prereq = { $Dep => 0 }; ### find enabled features { my $meth = 'list_enabled_features'; - can_ok( $Class, $meth ); - + can_ok( $Class, $meth ); + my @list = $CB->$Acc->$meth; ok( scalar(@list), "Retrieved enabled features" ); is_deeply( [$Feat], \@list, " Proper features found" ); } - + ### find dependencies/core modules for my $meth ( qw[list_core_dependencies list_core_modules] ) { - can_ok( $Class, $meth ); - + can_ok( $Class, $meth ); + my @list = $CB->$Acc->$meth; ok( scalar(@list), "Retrieved modules" ); is( scalar(@list), 1, " 1 Found" ); - isa_ok( $list[0], $ModClass ); + isa_ok( $list[0], $ModClass ); is( $list[0]->name, $Dep, " Correct module found" ); @@ -163,7 +163,7 @@ my $Prereq = { $Dep => 0 }; " With the proper entries" ); } } - + ### now selfupdate ourselves { ### XXX just test the mechanics, make sure install returns true @@ -171,11 +171,11 @@ my $Prereq = { $Dep => 0 }; ### declare in a block to quelch 'sub redefined' warnings. { local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; } local *CPANPLUS::Selfupdate::Module::install = sub { 1 }; - + my $meth = 'selfupdate'; can_ok( $Class, $meth ); - ok( $CB->$Acc->$meth( update => 'all'), + ok( $CB->$Acc->$meth( update => 'all'), " Selfupdate successful" ); } -} +} diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t b/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t index a8823351d1e..ecce8a5b7cb 100755 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/40_CPANPLUS-Internals-Report.t @@ -1,6 +1,6 @@ ### make sure we can find our conf.pl file -BEGIN { - use FindBin; +BEGIN { + use FindBin; require "$FindBin::Bin/inc/conf.pl"; } @@ -25,7 +25,7 @@ my $CB = CPANPLUS::Backend->new( $conf ); my $ModName = TEST_CONF_MODULE; my $ModPrereq = TEST_CONF_PREREQ; -### pick a high number, but not ~0 as possibly ~0 is unsigned, and we cause +### pick a high number, but not ~0 as possibly ~0 is unsigned, and we cause ### an overflow, as happens to version.pm 0.7203 among others. ### ANOTHER bug in version.pm, this time for 64bit: ### https://rt.cpan.org/Ticket/Display.html?id=45241 @@ -53,7 +53,7 @@ my $map = { check => 0, skiptests => 1, # did we skip the tests? - }, + }, missing_prereq => { buffer => missing_prereq_buffer(), failed => 1, @@ -87,7 +87,7 @@ my $map = { '/NA/', ], check => 0, - }, + }, perl_version_too_low_build1 => { buffer => perl_version_too_low_buffer_build(1), failed => 1, @@ -96,7 +96,7 @@ my $map = { '/NA/', ], check => 0, - }, + }, perl_version_too_low_build2 => { buffer => perl_version_too_low_buffer_build(2), failed => 1, @@ -105,7 +105,7 @@ my $map = { '/NA/', ], check => 0, - }, + }, prereq_versions_too_low => { ### set the prereq version incredibly high pre_hook => sub { @@ -119,14 +119,14 @@ my $map = { '/http://testers.cpan.org/', '/NA/', ], - check => 0, + check => 0, }, prereq_not_on_cpan => { pre_hook => sub { my $mod = shift; my $clone = $mod->clone; - $clone->status->prereqs( - { TEST_CONF_INVALID_MODULE, 0 } + $clone->status->prereqs( + { TEST_CONF_INVALID_MODULE, 0 } ); return $clone; }, @@ -135,14 +135,14 @@ my $map = { '/http://testers.cpan.org/', '/NA/', ], - check => 0, + check => 0, }, prereq_not_on_cpan_but_core => { pre_hook => sub { my $mod = shift; my $clone = $mod->clone; - $clone->status->prereqs( - { TEST_CONF_PREREQ, 0 } + $clone->status->prereqs( + { TEST_CONF_PREREQ, 0 } ); return $clone; }, @@ -151,11 +151,11 @@ my $map = { '/http://testers.cpan.org/', '/UNKNOWN/', ], - check => 0, + check => 0, }, }; -### test config settings +### test config settings { for my $opt ( qw[cpantest cpantest_mx] ) { my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; @@ -167,7 +167,7 @@ my $map = { " Retrieved properly" ); ok( $conf->set_conf( $opt => $org ), " Option $opt set back to original" ); - ok( !$warnings, " No warnings" ); + ok( !$warnings, " No warnings" ); } } @@ -180,7 +180,7 @@ my $map = { ### test non-relevant tests ### my $cp = $Mod->clone; - $cp->module( ($^O eq 'beos' ? 'MSDOS' : 'Be') . '::' . $cp->module ); + $cp->module( $Mod->module . '::' . ($^O eq 'beos' ? 'MSDOS' : 'Be') ); ok(!RELEVANT_TEST_RESULT->($cp),"Test is irrelevant"); } @@ -219,15 +219,15 @@ my $map = { "Proper test fail stage found" ); } - ### test missing prereqs + ### test missing prereqs { my $str = q[Can't locate Foo/Bar.pm in @INC]; - + ### standard test { my @list = MISSING_PREREQS_LIST->( $str ); is( scalar(@list), 1, " List of missing prereqs found" ); is( $list[0], 'Foo::Bar', " Proper prereq found" ); } - + ### multiple mentions of same prereq { my @list = MISSING_PREREQS_LIST->( $str . $str ); @@ -256,14 +256,14 @@ my $map = { { my $prereqs = REPORT_MISSING_PREREQS->('foo','bar@example.com','Foo::Bar'); ok( $prereqs, "Test output generated" ); - like( $prereqs, qr/'foo \(bar\@example\.com\)'/, + like( $prereqs, qr/'foo \(bar\@example\.com\)'/, " Proper content found" ); like( $prereqs, qr/Foo::Bar/, " Proper content found" ); like( $prereqs, qr/prerequisi/, " Proper content found" ); like( $prereqs, qr/PREREQ_PM/, " Proper content found" ); } - { my $prereqs = REPORT_MISSING_PREREQS->(undef,undef,'Foo::Bar'); + { my $prereqs = REPORT_MISSING_PREREQS->(undef,undef,'Foo::Bar'); ok( $prereqs, "Test output generated" ); like( $prereqs, qr/Your Name/, " Proper content found" ); like( $prereqs, qr/Foo::Bar/, " Proper content found" ); @@ -291,15 +291,15 @@ my $map = { my @list = qw(foo bar); is_deeply( \@libs, \@list, " Proper content found" ); } - + { my $clone = $Mod->clone; my $prereqs = { $ModPrereq => $HighVersion }; - + $clone->status->prereqs( $prereqs ); my $str = REPORT_LOADED_PREREQS->( $clone ); - + like($str, qr/PREREQUISITES:/, "Listed loaded prerequisites" ); like($str, qr/\! $ModPrereq\s+\S+\s+\S+/, " Proper content found" ); @@ -308,7 +308,7 @@ my $map = { { my $clone = $Mod->clone; my $str = REPORT_TOOLCHAIN_VERSIONS->( $clone ); - + like($str, qr/toolchain/, "Correct message in report" ); use Cwd; like($str, qr/Cwd\s+\Q$Cwd::VERSION\E/, @@ -317,10 +317,10 @@ my $map = { } ### callback tests -{ ### as reported in bug 13086, this callback returned the wrong item +{ ### as reported in bug 13086, this callback returned the wrong item ### from the list: - ### $self->_callbacks->munge_test_report->($Mod, $message, $grade); - my $rv = $CB->_callbacks->munge_test_report->( 1..4 ); + ### $self->_callbacks->munge_test_report->($Mod, $message, $grade); + my $rv = $CB->_callbacks->munge_test_report->( 1..4 ); is( $rv, 2, "Default 'munge_test_report' callback OK" ); } @@ -334,14 +334,14 @@ SKIP: { unless $CB->_have_query_report_modules(verbose => 0); - SKIP: { + SKIP: { my $mod = $CB->module_tree( TEST_CONF_PREREQ ); # is released to CPAN ok( $mod, "Module retrieved" ); - + ### so we're not pinned down to this specific version of perl my @list = $mod->fetch_report( all_versions => 1 ); skip "Possibly no net connection, or server down", 7 unless @list; - + my $href = $list[0]; ok( scalar(@list), "Fetched test report" ); is( ref $href, ref {}, " Return value has hashrefs" ); @@ -389,7 +389,7 @@ SKIP: { : $Mod; my $file = do { - ### so T::R does not try to resolve our maildomain, which can + ### so T::R does not try to resolve our maildomain, which can ### lead to large timeouts for *every* invocation in T::R < 1.51_01 ### see: http://code.google.com/p/test-reporter/issues/detail?id=15 local $ENV{MAILDOMAIN} ||= 'example.com'; @@ -477,7 +477,7 @@ BEGIN failed--compilation aborted at Makefile.PL line 1. BEGIN failed--compilation aborted at Makefile.PL line 1. -- cannot continue ]; -} +} sub perl_version_too_low_buffer_build { my $type = shift; @@ -493,7 +493,7 @@ ERROR: version: Prerequisite version isn't installed ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions of the modules indicated above before proceeding with this installation. ] if($type == 2); -} +} # Local variables: # c-indentation-style: bsd diff --git a/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl b/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl index 4cce0efcb43..ca6473157cd 100644 --- a/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl +++ b/gnu/usr.bin/perl/cpan/CPANPLUS/t/inc/conf.pl @@ -2,9 +2,9 @@ ### So reset it here explicitly my ($old_env_path, $old_env_perl5lib); BEGIN { - use FindBin; + use FindBin; use File::Spec; - + ### paths to our own 'lib' and 'inc' dirs ### include them, relative from t/ my @paths = map { "$FindBin::Bin/$_" } qw[../lib inc]; @@ -12,21 +12,21 @@ BEGIN { ### absolute'ify the paths in @INC; my @rel2abs = map { File::Spec->rel2abs( $_ ) } grep { not File::Spec->file_name_is_absolute( $_ ) } @INC; - + ### use require to make devel::cover happy require lib; - for ( @paths, @rel2abs ) { - my $l = 'lib'; - $l->import( $_ ) + for ( @paths, @rel2abs ) { + my $l = 'lib'; + $l->import( $_ ) } use Config; ### and add them to the environment, so shellouts get them $old_env_perl5lib = $ENV{'PERL5LIB'}; - $ENV{'PERL5LIB'} = join $Config{'path_sep'}, + $ENV{'PERL5LIB'} = join $Config{'path_sep'}, grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs; - + ### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl ### and friends get picked up $old_env_path = $ENV{PATH}; @@ -42,10 +42,10 @@ BEGIN { ### Fix up the path to perl, as we're about to chdir ### but only under perlcore, or if the path contains delimiters, ### meaning it's relative, but not looked up in your $PATH - $^X = File::Spec->rel2abs( $^X ) + $^X = File::Spec->rel2abs( $^X ) if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| ); - ### chdir to our own test dir, so we know all files are relative + ### chdir to our own test dir, so we know all files are relative ### to this point, no matter whether run from perlcore tests or ### regular CPAN installs chdir "$FindBin::Bin" if -d "$FindBin::Bin" @@ -53,7 +53,7 @@ BEGIN { BEGIN { use IPC::Cmd; - + ### Win32 has issues with redirecting FD's properly in IPC::Run: ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801 $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; @@ -94,7 +94,7 @@ use File::Basename qw[basename]; my $Env = 'PERL5_CPANPLUS_TEST_VERBOSE'; # prereq has to be in our package file && core! -use constant TEST_CONF_PREREQ => 'Cwd'; +use constant TEST_CONF_PREREQ => 'Cwd'; use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS'; use constant TEST_CONF_MODULE_SUB => 'Foo::Bar::EU::NOXS::Sub'; use constant TEST_CONF_AUTHOR => 'EUNOXS'; @@ -104,7 +104,7 @@ use constant TEST_CONF_MIRROR_DIR => 'dummy-localmirror'; use constant TEST_CONF_CPAN_DIR => 'dummy-CPAN'; use constant TEST_CONF_CPANPLUS_DIR => 'dummy-cpanplus'; use constant TEST_CONF_INSTALL_DIR => File::Spec->rel2abs( - File::Spec->catdir( + File::Spec->catdir( TEST_CONF_CPANPLUS_DIR, 'install' ) @@ -118,41 +118,36 @@ sub dummy_cpan_dir { ### Convert to an absolute file specification my $abs_test_dir = File::Spec->rel2abs($test_dir); - - ### According to John M: the hosts path needs to be in UNIX format. + + ### According to John M: the hosts path needs to be in UNIX format. ### File::Spec::Unix->rel2abs does not work at all on VMS $abs_test_dir = VMS::Filespec::unixify( $abs_test_dir ) if $^O eq 'VMS'; return $abs_test_dir; } -sub gimme_conf { +sub gimme_conf { ### don't load any other configs than the heuristic one ### during tests. They might hold broken/incorrect data ### for our test suite. Bug [perl #43629] showed this. - local $ENV{PERL5_CPANPLUS_HOME} = ''; - my $conf = CPANPLUS::Configure->new( load_configs => 0 ); my $dummy_cpan = dummy_cpan_dir(); - - $conf->set_conf( hosts => [ { + + $conf->set_conf( hosts => [ { path => $dummy_cpan, scheme => 'file', - } ], + } ], ); $conf->set_conf( base => File::Spec->rel2abs(TEST_CONF_CPANPLUS_DIR)); $conf->set_conf( dist_type => '' ); $conf->set_conf( signature => 0 ); - $conf->set_conf( allow_unknown_prereqs => 1 ); # just to make sure, eh $conf->set_conf( verbose => 1 ) if $ENV{ $Env }; - + ### never use a pager in the test suite $conf->set_program( pager => '' ); - $conf->set_conf( enable_custom_sources => 0 ); - ### dmq tells us that we should run with /nologo ### if using nmake, as it's very noisy otherwise. { my $make = $conf->get_program('make'); @@ -170,7 +165,7 @@ sub gimme_conf { ### cpanp-run-perl installed the same amount of 'uplevels' ### as the /tmp/foo prefix, we'll pull in the wrong script ### by accident. - ### Since we set the path to cpanp-run-perl explicitly + ### Since we set the path to cpanp-run-perl explicitily ### at the top of this script, it's best to update the config ### ourselves with a path lookup, rather than rely on its ### heuristics. Thanks to David Wheeler, Josh Jore and Vincent @@ -181,16 +176,16 @@ sub gimme_conf { $conf->set_conf( source_engine => $ENV{CPANPLUS_SOURCE_ENGINE} ) if $ENV{CPANPLUS_SOURCE_ENGINE}; - + _clean_test_dir( [ - $conf->get_conf('base'), + $conf->get_conf('base'), TEST_CONF_MIRROR_DIR, # TEST_INSTALL_DIR_LIB, # TEST_INSTALL_DIR_BIN, -# TEST_INSTALL_DIR_MAN1, +# TEST_INSTALL_DIR_MAN1, # TEST_INSTALL_DIR_MAN3, ], ( $ENV{PERL_CORE} ? 0 : 1 ) ); - + return $conf; }; @@ -199,47 +194,47 @@ sub gimme_conf { my $file = ".".basename($0).".output"; sub output_handle { return $fh if $fh; - + $fh = FileHandle->new(">$file") or warn "Could not open output file '$file': $!"; - + $fh->autoflush(1); return $fh; } - + sub output_file { return $file } - - - + + + ### redirect output from msg() and error() output to file unless( $ENV{$Env} ) { - + print "# To run tests in verbose mode, set ". "\$ENV{$Env} = 1\n" unless $ENV{PERL_CORE}; - + 1 while unlink $file; # just in case - + $CPANPLUS::Error::ERROR_FH = $CPANPLUS::Error::ERROR_FH = output_handle(); - + $CPANPLUS::Error::MSG_FH = $CPANPLUS::Error::MSG_FH = output_handle(); - - } + + } } ### clean these files if we're under perl core -END { +END { if ( $ENV{PERL_CORE} ) { close output_handle(); 1 while unlink output_file(); _clean_test_dir( [ - gimme_conf->get_conf('base'), + gimme_conf->get_conf('base'), TEST_CONF_MIRROR_DIR, # TEST_INSTALL_DIR_LIB, # TEST_INSTALL_DIR_BIN, - # TEST_INSTALL_DIR_MAN1, + # TEST_INSTALL_DIR_MAN1, # TEST_INSTALL_DIR_MAN3, ], 0 ); # DO NOT be verbose under perl core -- makes tests fail } @@ -258,47 +253,47 @@ sub _clean_test_dir { my $dh; opendir $dh, $dir or die "Could not open basedir '$dir': $!"; - while( my $file = readdir $dh ) { + while( my $file = readdir $dh ) { next if $file =~ /^\./; # skip dot files - + my $path = File::Spec->catfile( $dir, $file ); - + ### directory, rmtree it if( -d $path ) { ### John Malmberg reports yet another VMS issue: - ### A directory name on VMS in VMS format ends with .dir + ### A directory name on VMS in VMS format ends with .dir ### when it is referenced as a file. ### In UNIX format traditionally PERL on VMS does not remove the ### '.dir', however the VMS C library conversion routines do - ### remove the '.dir' and the VMS C library routines can not + ### remove the '.dir' and the VMS C library routines can not ### handle the '.dir' being present on UNIX format filenames. - ### So code doing the fixup has on VMS has to be able to handle - ### both UNIX format names and VMS format names. - + ### So code doing the fixup has on VMS has to be able to handle + ### both UNIX format names and VMS format names. + ### XXX See http://www.xray.mpe.mpg.de/ ### mailing-lists/perl5-porters/2007-10/msg00064.html ### for details -- the below regex could use some touchups - ### according to John. M. + ### according to John. M. $file =~ s/\.dir$//i if $^O eq 'VMS'; - + my $dirpath = File::Spec->catdir( $dir, $file ); print "# Deleting directory '$dirpath'\n" if $verbose; eval { rmtree( $dirpath ) }; - warn "Could not delete '$dirpath' while cleaning up '$dir'" + warn "Could not delete '$dirpath' while cleaning up '$dir'" if $@; - + ### regular file } else { print "# Deleting file '$path'\n" if $verbose; 1 while unlink $path; - } - } - + } + } + close $dh; } - + return 1; } 1; diff --git a/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/Changes b/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/Changes index 99424de47bb..24fb8c3025a 100644 --- a/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/Changes +++ b/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/Changes @@ -1,165 +1,10 @@ CHANGES ------- - 2.060 7 January 2013 - - * Mention SimpleZip in POD - - 2.059 24 November 2012 - - * Copy-on-write support - [#81353] - - 2.058 12 November 2012 - - * No Changes - - 2.057 10 November 2012 - - * Compress::Raw::Zlib needs to use PERL_NO_GET_CONTEXT - [#80319] - - * Install to 'site' instead of 'perl' when perl version is 5.11+ - [#79812] - - * update to ppport.h that includes SvPV_nomg_nolen - [#78079] - - 2.056 10 August 2012 - - * Fix C++ build issue - Thanks to Karl Williamson for supplying the patch. - - 2.055 4 August 2012 - - * Fix misuse of magic in API - [#78079] - - 2.054 8 May 2012 - - * Build issue on Win32 - [#77030] - - 2.053 6 May 2012 - - * Include zlib 1.2.7 source. - - 2.052 29 April 2012 - - * Fixed build issue when Perl is built with C++ - - 2.051 20 February 2012 - - * Bug in Compress::Raw::Zlib on Windows - [#75222] - - 2.050 20 February 2012 - - * Build failure on Irix & Solaris. - [RT #69985] - - 2.049 18 February 2012 - - * Include zlib 1.2.6 source. - - 2.048 29 January 2012 - - * Set minimum zlib version to 1.2.0 - - 2.047 28 January 2012 - - * Allow flush to be called multiple times without any intermediate - call to deflate and still return Z_OK. - In the code below $status was Z_BUF_ERROR before this change. - - $def->flush(...); - $status = $def->flush(...); - - * Added support for zlibCompileFlags - - * Set minimum Perl version to 5.6 - - 2.045 3 December 2011 - - * Moved FAQ.pod into Zlib.pm - - 2.044 2 December 2011 - - * Moved FAQ.pod under the lib directory so it can get installed - - 2.043 20 November 2011 - - * No Changes - - 2.042 17 November 2011 - - * No Changes - - 2.040 28 October 2011 - - * No Changes - - 2.039 28 October 2011 - - * croak if attempt to freeze/thaw compression object - [RT #69985] - - 2.037 22 June 2011 - - * No Changes - - 2.036 6 May 2011 - - * Added offset patramter to CRC32 - - 2.035 6 May 2011 - - * No Changes - - 2.033 11 Jan 2011 - * Fixed typos & spelling errors. - [perl# 81782] - - 2.032 4 Jan 2011 - - * Document inflateReset - [RT #61082] - - 2.030 22 July 2010 - - * Ran the zlib2ansi script against the files in zlib-src. - Thanks to Nicholas Clark for the reminder. - - * Added "-DNO_VIZ" to DEFINE in Makefile.PL - [RT #65293] - - 2.027 24 April 2010 - - * Updated to include zlib 1.2.5 - - 2.026 7 April 2010 - - * Fixed definition of Z_TREES in Makefile.PL - [RT #65293] - - * Fixed build issue with definition of off64_t not found on Solaris - by modifying the zlib source - changed the symbol - _LARGEFILE64_SOURCE to _LARGEFILE64_SOURCE_dummy in zconf.h, - zlib.h and zutil.h - [RT #56108] - - 2.025 27 March 2010 - - * Updated to include zlib 1.2.4 - - * Allow zlib version check to be disabled by setting - TEST_SKIP_VERSION_CHECK environment variable. - [RT #54510] - 2.023 9 November 2009 * fixed instance where $[ should have been $] in t/02zlib.t - Thanks to Robin Barker and zefram [RT #50765] for independently + Thanks to Robin Barker and zefram [RT #50765] for independantly spotting the issue. 2.021 30 August 2009 diff --git a/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/README b/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/README index 37a3f1ce8dd..10b396168a5 100644 --- a/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/README +++ b/gnu/usr.bin/perl/cpan/Compress-Raw-Zlib/README @@ -1,17 +1,17 @@ - Compress-Raw-Zlib + Compress-Raw-Zlib - Version 2.060 + Version 2.024 - 7th January 2013 + 7th January 2010 - Copyright (c) 2005-2013 Paul Marquess. All rights reserved. + Copyright (c) 2005-2010 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The directory zlib-src contains a subset of the - source files copied directly from zlib version 1.2.7. - These files are Copyright(C) 1995-2012 + source files copied directly from zlib version 1.2.3. + These files are Copyright(C) 1995-2005 Jean-loup Gailly and Mark Adler. Full source for the zlib library is available at http://www.zlib.org @@ -29,7 +29,7 @@ installed on your system: * A C compiler - * Perl 5.006 or better. + * Perl 5.004 or better. By default, Compress-Raw-Zlib will build its own private copy of the zlib library. If you want to use a different version of @@ -71,7 +71,7 @@ zlib library is used: 3. Use a pre-built zlib library. Note that if you intend to use either Option 2 or 3, you need to have -zlib version 1.2.0 or better. +zlib version 1.0.5 or better. The contents of the file config.in are used to control which of the three options is actually used. This file is read during the @@ -99,16 +99,16 @@ before building this module. For option 2, fetch a copy of the zlib source distribution from http://www.zlib.org and unpack it into the Compress-Raw-Zlib source - directory. Assuming you have fetched zlib 1.2.7, - it will create a directory called zlib-1.2.7. + directory. Assuming you have fetched zlib 1.2.3, + it will create a directory called zlib-1.2.3. Now set the variables in the file config.in as follows (if the version - you have fetched isn't 1.2.7, change the INCLUDE and LIB + you have fetched isn't 1.2.3, change the INCLUDE and LIB variables appropriately): BUILD_ZLIB = True - INCLUDE = ./zlib-1.2.7 - LIB = ./zlib-1.2.7 + INCLUDE = ./zlib-1.2.3 + LIB = ./zlib-1.2.3 OLD_ZLIB = False GZIP_OS_CODE = AUTO_DETECT @@ -355,7 +355,7 @@ To help me help you, I need all of the following information: If you haven't installed Compress-Raw-Zlib then search Compress::Raw::Zlib.pm for a line like this: - $VERSION = "2.060" ; + $VERSION = "2.024" ; c. The version of zlib you have used. If you have successfully installed Compress-Raw-Zlib, this one-liner diff --git a/gnu/usr.bin/perl/cpan/DB_File/Changes b/gnu/usr.bin/perl/cpan/DB_File/Changes index a650c754701..781a8b728f6 100644 --- a/gnu/usr.bin/perl/cpan/DB_File/Changes +++ b/gnu/usr.bin/perl/cpan/DB_File/Changes @@ -1,42 +1,4 @@ -1.827 25 Jan 2012 - * DB_File.pm - Don't use "@_" construct - [RT ##79287] - -1.826 25 Jan 2012 - - * t/db-btree.t - fix use of "length @array" - [RT ##74336] - -1.825 24 Jan 2012 - - * t/db-btree.t - fix use of "length @array" - [RT ##74336] - -1.824 6 Aug 2011 - - * Amendments to tests to work in blead - [RT #70108] - -1.823 6 Aug 2011 - - * croak if attempt to freeze/thaw DB_File object - [RT #69985] - -1.822 12 March 2011 - - * Link rot - [rt.cpan.org #69739] - -1.822 12 March 2011 - - * Keep DB_File's warnings in sync with perl's - [rt.cpan.org #66339] - -1.821 10 January 2011 - - * Fixed typos & spelling errors. - [perl #81792] 1.820 28 March 2009 @@ -137,7 +99,7 @@ 1.807 1st November 2003 - * Fixed minor typos on pod documentation - reported by Jeremy Mates & + * Fixed minor typos on pod documetation - reported by Jeremy Mates & Mark Jason Dominus. * dbinfo updated to report when a database is encrypted. @@ -146,7 +108,7 @@ * Fixed problem when trying to build with a multi-threaded perl. - * Tidied up the recursion detection code. + * Tidied up the recursion detetion code. * merged core patch 17844 - missing dTHX declarations. @@ -162,7 +124,7 @@ * added code to guard against calling the callbacks (compare,hash & prefix) recursively. - * passing undef for the flags and/or mode when opening a database could cause + * pasing undef for the flags and/or mode when opening a database could cause a "Use of uninitialized value in subroutine entry" warning. Now silenced. * DBM filter code beefed up to cope with read-only $_. @@ -177,7 +139,7 @@ 1.803 1st March 2002 * Fixed a problem with db-btree.t where it complained about an "our" - variable redeclaration. + variable redeclaation. * FETCH, STORE & DELETE don't map the flags parameter into the equivalent Berkeley DB function anymore. @@ -197,7 +159,7 @@ 1.800 23rd November 2001 - * use pport.h for perl backward compatibility code. + * use pport.h for perl backward compatability code. * use new ExtUtils::Constant module to generate XS constants. @@ -254,7 +216,7 @@ * Fixed perl core patch 7703 - * Added support to allow DB_File to be built with Berkeley DB 3.2 -- + * Added suppport to allow DB_File to be built with Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb needed to be changed. * Updated dbinfo to support Berkeley DB 3.2 file format changes. @@ -332,7 +294,7 @@ * Merged changes from 5.005_58 - * Fixed a bug in R_IBEFORE & R_IAFTER processing in Berkeley DB + * Fixed a bug in R_IBEFORE & R_IAFTER procesing in Berkeley DB 2 databases. * Added some of the examples in the POD into the test harness. diff --git a/gnu/usr.bin/perl/cpan/Devel-PPPort/Changes b/gnu/usr.bin/perl/cpan/Devel-PPPort/Changes index e4159f9c962..fb8ba3a0970 100644 --- a/gnu/usr.bin/perl/cpan/Devel-PPPort/Changes +++ b/gnu/usr.bin/perl/cpan/Devel-PPPort/Changes @@ -1,37 +1,3 @@ -3.20 - 2011-09-10 - - * fix CPAN #56749: isASCII and isCNTRL macros are buggy - (thanks to Karl Williamson for providing a patch and patiently - waiting almost two years for me to integrate it) - * fix CPAN #70427: RealPPPort.xs:1587: error: lvalue required as unary ‘&’ operand - -3.19_03 - 2011-04-13 - - * keep up with latest core changes - -3.19_02 - 2010-03-07 - - * fix a warning emitted by the test suite with older perls - * added support for the following API - newSVpvs_share - get_cvn_flags - get_cvs - (thanks to Goro Fuji for providing a patch to - implement all of these, fixes CPAN #47174) - -3.19_01 - 2010-02-20 - - * fix CPAN #50763: mistaken use of $[ - (thanks to Zefram for spotting this) - * remove spurious PUSHMARK from Perl_ppaddr_t - (thanks to Gerard Goossen for providing a patch) - * improved support for newer compilers in buildperl.pl - (thanks to Philippe Bruhat (BooK) for providing a patch) - * added support for the following API - memEQs - memNEs - * lots of small toolchain updates - 3.19 - 2009-06-14 * updated base/todo files diff --git a/gnu/usr.bin/perl/cpan/Devel-PPPort/README b/gnu/usr.bin/perl/cpan/Devel-PPPort/README index 2ccd6af2831..fc243099647 100644 --- a/gnu/usr.bin/perl/cpan/Devel-PPPort/README +++ b/gnu/usr.bin/perl/cpan/Devel-PPPort/README @@ -69,7 +69,7 @@ to create a ticket for the module. 5. COPYRIGHT ------------ -Version 3.x, Copyright (C) 2004-2010, Marcus Holland-Moritz. +Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. Version 2.x, Copyright (C) 2001, Paul Marquess. Version 1.x, Copyright (C) 1999, Kenneth Albanowski. diff --git a/gnu/usr.bin/perl/cpan/Digest-MD5/README b/gnu/usr.bin/perl/cpan/Digest-MD5/README index 031c8f10f13..3c48079a3db 100644 --- a/gnu/usr.bin/perl/cpan/Digest-MD5/README +++ b/gnu/usr.bin/perl/cpan/Digest-MD5/README @@ -4,6 +4,8 @@ algorithm takes as input a message of arbitrary length and produces as output a 128-bit "fingerprint" or "message digest" of the input. MD5 is described in RFC 1321. +You will need perl version 5.6 or better to install this module. + Copyright 1998-2003 Gisle Aas. Copyright 1995-1996 Neil Winton. Copyright 1990-1992 RSA Data Security, Inc. diff --git a/gnu/usr.bin/perl/cpan/Digest-SHA/Changes b/gnu/usr.bin/perl/cpan/Digest-SHA/Changes index 98915238731..ad5bd06b359 100644 --- a/gnu/usr.bin/perl/cpan/Digest-SHA/Changes +++ b/gnu/usr.bin/perl/cpan/Digest-SHA/Changes @@ -1,123 +1,5 @@ Revision history for Perl extension Digest::SHA. -5.84 Sat Mar 9 17:36:08 MST 2013 - - untweaked Makefile.PL to remove dependencies of SHA.c - -- dependencies were breaking builds on VMS - -- retaining dependencies provides too little benefit - for cost of portable workaround - -5.83 Mon Mar 4 08:12:00 MST 2013 - - removed code for standalone C operation (no longer used) - -- eliminates need for external symbols - -- consolidates SHA and HMAC code - -- reduces size of object files - -- thanks to Marc Lehmann for suggestions - - tweaked Makefile.PL to show dependencies of SHA.c - -5.82 Thu Jan 24 04:54:12 MST 2013 - - introduced workaround to SvPVbyte bug in Perl 5.6 - -- module behavior now consistent under all Perls 5.6+ - -- ref: new test script t/unicode.t - -- SHA routines now always croak on wide chars (5.6+) - - removed "static" message schedules from C code - -- default "auto" is now just as fast - -- thread-safe option (-t) no longer necessary - -- still allowed, but ignored - -- simplifies source and header files - -- eliminates SHA_STO_CLASS and SHA_THREAD_SAFE - -- ref. Bug #82784 - -- thanks to Steve Hay for initial patch - - provided documentation to describe Unicode handling - -- ref: Bug #82378 - - updated documentation of NIST statement on SHA-1 - -5.81 Mon Jan 14 05:17:08 MST 2013 - - corrected load subroutine (SHA.pm) to prevent double-free - -- Bug #82655: Security issue - segfault - -- thanks to Victor Efimov and Nicholas Clark - for technical expertise and suggestions - -5.80 Mon Dec 10 14:15:26 MST 2012 - - obtained noticeable speedup on Intel/gcc - -- by setting -O1 and -fomit-frame-pointer - -- SHA-1 about 63% faster, SHA-2 improves 11-20% - -5.74 Sat Nov 24 03:10:18 MST 2012 - - handle wide-string input by converting to bytes first - -- viz. use SvPVbyte instead of SvPV in SHA.xs - -- thanks to Eric Brine for summary and code - -5.73 Wed Oct 31 04:32:44 MST 2012 - - provided workaround for DEC compiler bug (ref. Makefile.PL) - -5.72 Mon Sep 24 15:22:08 MST 2012 - - adjusted module installation directory for later Perls - -- As of 5.11 Perl searches 'site' first, so use that - -- ref. INSTALLDIRS in Makefile.PL - -- thanks to Robert Sedlacek for patch - -5.71 Wed Feb 29 04:06:10 MST 2012 - - prevented $! from getting clobbered in _bail() routine - -- thanks to Zefram for patch - - added example of BITS mode usage to shasum documentation - -5.70 Wed Dec 14 02:32:10 MST 2011 - - added BITS mode to addfile method and shasum - -- partial-byte inputs now possible via files/STDIN - -- allows shasum to check all 8074 NIST Msg vectors - -- previously required special programming - -5.63 Tue Nov 8 02:36:42 MST 2011 - - added code to allow very large data inputs all at once - -- previously limited to several hundred MB at a time - -- many thanks to Thomas Drugeon for his elegant patch - - removed outdated reference URLs from several test scripts - -- these URLs aren't essential, and often go stale - -- thanks to Leon Brocard for spotting this - -- ref. rt.cpan.org #68740 - -5.62 Sat May 14 04:00:34 MST 2011 - - removed unnecessary loading of MIME::Base64 module - -- thanks to dolmen for pointing this out - -5.61 Wed Mar 9 05:26:36 MST 2011 - - corrected bug in 'algorithm' method - - fixed -x option in Makefile.PL - -- not often used since it deliberately excludes - all 64-bit SHA transforms - - addressed minor documentation oversights - -5.60 Thu Mar 3 05:26:42 MST 2011 - - added new SHA-512/224 and SHA-512/256 transforms - -- ref. NIST Draft FIPS 180-4 (February 2011) - - simplified shasum by removing duplicative text - - improved efficiency of Addfile - -- expensive -T test now occurs only in portable mode - -5.50 Tue Dec 14 06:20:08 MST 2010 - - adopted convention that '-' always means STDIN - -- actual filename '-' accessed as './-' - -- accords with behavior of sha1sum/md5sum - - corrected undefined subroutine oversight in shasum - -- inadvertent migration of _bail() from SHA.pm - -5.49 Sun Dec 12 07:22:04 MST 2010 - - modified Addfile to accept all POSIX filenames - -- standard allows all characters except NUL and '/' - - updated shasum to more closely mimic sha1sum/md5sum - -- added "backslash processing" to handle newlines - and backslashes in filenames - -- now accepts all POSIX filenames via Addfile - -- thanks to Sean Burke for identifying edge cases - -5.48 Mon Jan 4 16:32:52 MST 2010 - - fixed "shasum -a0" option (ref. rt.cpan.org #53319) - -- incorrectly accepted 0 as a valid algorithm - -- thanks to Zefram for patch - - updated URL for NIST test vectors - -- ref. files t/nistbit.t, t/nistbyte.t - -- thanks to Leon Brocard for patch - 5.47 Wed Apr 30 04:00:54 MST 2008 - modified Makefile.PL to install in core for Perls >= 5.10 -- thanks to Jerry Hedden for patch diff --git a/gnu/usr.bin/perl/cpan/Digest-SHA/README b/gnu/usr.bin/perl/cpan/Digest-SHA/README index 98317ba4824..8cd68bd8371 100644 --- a/gnu/usr.bin/perl/cpan/Digest-SHA/README +++ b/gnu/usr.bin/perl/cpan/Digest-SHA/README @@ -1,11 +1,11 @@ -Digest::SHA version 5.84 +Digest::SHA version 5.47 ======================== Digest::SHA is a complete implementation of the NIST Secure Hash Standard. It gives Perl programmers a convenient way to calculate -SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, SHA-512/224, and SHA-512/256 -message digests. The module can handle all types of input, including -partial-byte data. +SHA-1, SHA-224, SHA-256, SHA-384, and SHA-512 message digests. +The module can handle all types of input, including partial-byte +data. Digest::SHA is written in C for speed. If your platform lacks a C compiler, you can install the functionally-equivalent (but much @@ -28,15 +28,13 @@ The Makefile.PL options are: -t : build a thread-safe version of module -x : exclude support for SHA-384/512 - NOTE: Option -t is still allowed but no longer necessary. - DEPENDENCIES None COPYRIGHT AND LICENSE -Copyright (C) 2003-2013 Mark Shelor +Copyright (C) 2003-2008 Mark Shelor This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/cpan/Digest-SHA/t/dumpload.t b/gnu/usr.bin/perl/cpan/Digest-SHA/t/dumpload.t index a1f1cf41012..92b92867e33 100755 --- a/gnu/usr.bin/perl/cpan/Digest-SHA/t/dumpload.t +++ b/gnu/usr.bin/perl/cpan/Digest-SHA/t/dumpload.t @@ -4,7 +4,7 @@ use FileHandle; my $MODULE; BEGIN { - $MODULE = (-d "src") ? "Digest::SHA" : "Digest::SHA::PurePerl"; + $MODULE = ($ENV{PERL_CORE} || -d "src") ? "Digest::SHA" : "Digest::SHA::PurePerl"; eval "require $MODULE" || die $@; $MODULE->import(qw(sha384_hex sha512_hex)); } @@ -51,7 +51,7 @@ while (@sharsp) { if ($alg == 384) { $skip = sha384_hex("") ? 0 : 1 } if ($alg == 512) { $skip = sha512_hex("") ? 0 : 1 } if ($skip) { - print "ok ", $testnum++, " # skip: no 64-bit\n"; + print "ok ", $testnum++, " # skip: no 64 bit\n"; next; } my $digest; diff --git a/gnu/usr.bin/perl/cpan/Encode/MANIFEST b/gnu/usr.bin/perl/cpan/Encode/MANIFEST index 830cebcc6b8..48fa14353c7 100644 --- a/gnu/usr.bin/perl/cpan/Encode/MANIFEST +++ b/gnu/usr.bin/perl/cpan/Encode/MANIFEST @@ -97,7 +97,6 @@ t/perlio.t test script t/piconv.t test script t/rt.pl even more test script t/unibench.pl benchmark script -t/utf8ref.t test script t/utf8strict.t test script ucm/8859-1.ucm Unicode Character Map ucm/8859-10.ucm Unicode Character Map @@ -202,4 +201,3 @@ ucm/posix-bc.ucm Unicode Character Map ucm/shiftjis.ucm Unicode Character Map ucm/symbol.ucm Unicode Character Map ucm/viscii.ucm Unicode Character Map -META.json Module JSON meta-data (added by MakeMaker) diff --git a/gnu/usr.bin/perl/cpan/Encode/META.yml b/gnu/usr.bin/perl/cpan/Encode/META.yml index 398a230678c..2a5c1ab762b 100644 --- a/gnu/usr.bin/perl/cpan/Encode/META.yml +++ b/gnu/usr.bin/perl/cpan/Encode/META.yml @@ -1,21 +1,20 @@ ---- -abstract: unknown -author: - - unknown -build_requires: - ExtUtils::MakeMaker: 0 +--- #YAML:1.0 +name: Encode +version: 2.39 +abstract: ~ +author: [] +license: unknown +distribution_type: module configure_requires: - ExtUtils::MakeMaker: 0 -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' -license: perl -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 -name: Encode + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: {} no_index: - directory: - - t - - inc -requires: {} -version: 2.49 + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.55_02 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/MANIFEST b/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/MANIFEST index 72feb7d3b78..b242cc55f60 100644 --- a/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/MANIFEST +++ b/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/MANIFEST @@ -1,37 +1,12 @@ -.perlcriticrc +.gitignore bin/instmodsh -bundled/CPAN-Meta-YAML/CPAN/Meta/YAML.pm -bundled/CPAN-Meta/CPAN/Meta.pm -bundled/CPAN-Meta/CPAN/Meta/Converter.pm -bundled/CPAN-Meta/CPAN/Meta/Feature.pm -bundled/CPAN-Meta/CPAN/Meta/History.pm -bundled/CPAN-Meta/CPAN/Meta/Prereqs.pm -bundled/CPAN-Meta/CPAN/Meta/Spec.pm -bundled/CPAN-Meta/CPAN/Meta/Validator.pm -bundled/ExtUtils-Command/ExtUtils/Command.pm -bundled/ExtUtils-Install/ExtUtils/Install.pm -bundled/ExtUtils-Install/ExtUtils/Installed.pm -bundled/ExtUtils-Install/ExtUtils/Packlist.pm -bundled/ExtUtils-Manifest/ExtUtils/Manifest.pm -bundled/ExtUtils-Manifest/ExtUtils/MANIFEST.SKIP -bundled/File-Copy-Recursive/File/Copy/Recursive.pm -bundled/File-Temp/File/Temp.pm -bundled/JSON-PP-Compat5006/JSON/PP/Compat5006.pm -bundled/JSON-PP/JSON/PP.pm -bundled/JSON-PP/JSON/PP/Boolean.pm -bundled/Parse-CPAN-Meta/Parse/CPAN/Meta.pm -bundled/README -bundled/Scalar-List-Utils/List/Util.pm -bundled/Scalar-List-Utils/List/Util/PP.pm -bundled/Scalar-List-Utils/Scalar/Util.pm -bundled/Scalar-List-Utils/Scalar/Util/PP.pm -bundled/Version-Requirements/Version/Requirements.pm -bundled/version/version.pm -bundled/version/version.pod -bundled/version/version/Internals.pod -bundled/version/version/vpp.pm Changes -INSTALL +inc/ExtUtils/Command.pm +inc/ExtUtils/Install.pm +inc/ExtUtils/Installed.pm +inc/ExtUtils/Manifest.pm +inc/ExtUtils/MANIFEST.SKIP +inc/ExtUtils/Packlist.pm lib/ExtUtils/Command/MM.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/Liblist/Kid.pm @@ -61,15 +36,12 @@ lib/ExtUtils/MM_Win95.pm lib/ExtUtils/MY.pm lib/ExtUtils/testlib.pm Makefile.PL -MANIFEST +MANIFEST This list of files MANIFEST.SKIP -my/bundles.pm NOTES PATCHING README -README.packaging t/00compile.t -t/01perl_bugs.t t/arch_check.t t/backwards.t t/basic.t @@ -77,7 +49,6 @@ t/build_man.t t/cd.t t/config.t t/dir_target.t -t/echo.t t/FIRST_MAKEFILE.t t/fix_libs.t t/fixin.t @@ -93,7 +64,6 @@ t/lib/MakeMaker/Test/Setup/MPV.pm t/lib/MakeMaker/Test/Setup/PL_FILES.pm t/lib/MakeMaker/Test/Setup/Problem.pm t/lib/MakeMaker/Test/Setup/Recurs.pm -t/lib/MakeMaker/Test/Setup/SAS.pm t/lib/MakeMaker/Test/Setup/XS.pm t/lib/MakeMaker/Test/Utils.pm t/lib/Test/Builder.pm @@ -104,31 +74,9 @@ t/lib/Test/Simple.pm t/lib/TieIn.pm t/lib/TieOut.pm t/Liblist.t -t/liblist/win32/__test.lib -'t/liblist/win32/di r/dir_test.lib' -t/liblist/win32/dir/dir_test.lib -t/liblist/win32/double.lib -t/liblist/win32/imp.dll.a -t/liblist/win32/lib/CORE/c_test.lib -t/liblist/win32/lib/CORE/double.lib -t/liblist/win32/lib__test.lib -t/liblist/win32/lib_test.lib -t/liblist/win32/libpath/lp_test.lib -t/liblist/win32/pl.lib -'t/liblist/win32/space lib.lib' -t/liblist/win32/test.a.lib -t/liblist/win32/test.lib -t/liblist/win32/test.meep -t/liblist/win32/test2.lib -t/liblist/win32/vc/vctest.lib -t/Liblist_Kid.t t/make.t t/MakeMaker_Parameters.t t/maketext_filter.t -t/meta_convert.t -t/META_for_testing.json -t/META_for_testing.yml -t/META_for_testing_tricky_version.yml t/metafile_data.t t/metafile_file.t t/min_perl_version.t @@ -143,7 +91,6 @@ t/MM_Unix.t t/MM_VMS.t t/MM_Win32.t t/oneliner.t -t/parse_abstract.t t/parse_version.t t/PL_FILES.t t/pm.t @@ -157,7 +104,6 @@ t/problems.t t/prompt.t t/recurs.t t/revision.t -t/several_authors.t t/split_command.t t/test_boilerplate.t t/testdata/reallylongdirectoryname/arch1/Config.pm @@ -168,3 +114,4 @@ t/WriteEmptyMakefile.t t/writemakefile_args.t t/xs.t TODO +META.yml Module meta-data (added by MakeMaker) diff --git a/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/README b/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/README index 8629a53cbed..9586c0ba173 100644 --- a/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/README +++ b/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/README @@ -1,11 +1,57 @@ This is a CPAN distribution of the venerable MakeMaker module. It has been -backported to work with Perl 5.6.0 and up. +backported to work with Perl 5.005_03 and up. -See INSTALL for installation instrucitons. Run "perldoc -ExtUtils::MakeMaker" (while in this source directory before -installation) for more documentation. +If you do not have a make program, several can be found... + +Most Unixen: The make utility which comes with your operating system +should work fine. If you don't have one, GNU make is recommended, +most others (Sun, BSD, etc...) will work fine as well. +http://www.gnu.org/software/make/make.html GNU make + +Windows: nmake or dmake will work. GNU make will *not*. +ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe nmake +http://search.cpan.org/dist/dmake/ dmake + +VMS: MMS or the free MadGoat MaKe utility (MMK) will work. +http://www.madgoat.com/mmk.html MMK + +If all else fails there is a pure Perl version of make available on +CPAN which should work on most Unixen. +http://search.cpan.org/author/NI-S/Make-1.00/ pmake + + +PLEASE NOTE: This distribution does not include the xsubpp or typemap +programs. They are extremely specific to your version or Perl, so +MakeMaker will simply use the one which came with your copy of Perl. +Do not delete your old ExtUtils/ directory. An upgraded version of xsubpp +can be found in the ExtUtils::ParseXS module. + +Known Good Systems: + +Every stable MakeMaker release is tested at least on: + +MacOS X +Linux/x86 +ActivePerl on Windows +Cygwin +OpenVMS + +Covering the major portability flavors MakeMaker has to cover. +(I'm always on the lookout for DJGPP, Solaris, *BSD and OS/2 users) + + +Known Problems: + +(See http://rt.cpan.org for a full list of open problems.) + +Windows will likely be broken if Perl is installed in C:\Program Files or +other prefix with a space in the name. + +Using the MMS utility on VMS causes lots of extra newlines. Unknown +why this is so, might be a bug in MMS. Problem not seen with MMK. + +GNU make does not work with MakeMaker on Windows. -See http://rt.cpan.org for a full list of open problems. Please report any bugs via http://rt.cpan.org. Send questions and discussion to makemaker@perl.org diff --git a/gnu/usr.bin/perl/cpan/Getopt-Long/CHANGES b/gnu/usr.bin/perl/cpan/Getopt-Long/CHANGES index ec8a0247dea..679da2abae6 100644 --- a/gnu/usr.bin/perl/cpan/Getopt-Long/CHANGES +++ b/gnu/usr.bin/perl/cpan/Getopt-Long/CHANGES @@ -1,30 +1,3 @@ -Changes in version 2.39 ------------------------ - -* Fix unneccessary warnings when @ARGV contains undefs (yes, it - happens). - -* Passing an object as first argument to the callback handler for <> - turned out to be a problem in cases where the argument was passed to - other modules, e.g., Archive::Tar. Revert the change since the added - functionality of the object is not really relevant for the <> - callback function. - -* Silence the deprecation warnings from newgetopt.pl for the purpose - of testing. These tests will be removed along with newgetopt.pl in - the next major release of perl. - http://perl5.git.perl.org/perl.git/commit/b814bbfa9a2087bc - -* Eliminiate spurious warning. - -* Retain taintedness of command line option values. - -* Document that you need to check GetOptions return value :). - -* Several other minor documentation fixes and enhancements. - -* Fix bug #67577 Parsing of type 'o' not correct for multiple values - Changes in version 2.38 ----------------------- @@ -37,9 +10,6 @@ Changes in version 2.38 * Bugfix for Ticket 24941: Autoabbrev with + incorrect. -* Bugfix: Reject syntax 'foo|!' for option spec. This was illegal - anyway. - Changes in version 2.37 ----------------------- @@ -101,7 +71,7 @@ Changes in version 2.35 prefix_pattern has now been complemented by a new configuration option 'long_prefix_pattern' that allows the user to specify what - prefix patterns should have long option style semantics applied. + prefix patterns should have long option style sematics applied. This will enable people to do things like foo.pl /option=value @@ -289,7 +259,7 @@ Changes in version 2.27 generated. E.g., GetOptions('foo', 'foo'). Thanks to Wolfgang Laun. -* Lots of internal restructuring to make room for extensions. +* Lots of internal restructoring to make room for extensions. * Redesigned the regression tests. diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/Changes b/gnu/usr.bin/perl/cpan/IO-Compress/Changes index 0b823273680..c98bef1d5e5 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/Changes +++ b/gnu/usr.bin/perl/cpan/IO-Compress/Changes @@ -1,266 +1,6 @@ CHANGES ------- - 2.060 7 January 2013 - - * Updated POD - RT# 82138: Example code not clear - gunzip() takes filenames! - - * IO::Compress::Base - Remove the flush call when opening a filehandle. - - 2.059 10 December 2012 - - * IO::Compress::Base - Added "Encode" option. - Fixes the encoding half of RT# 42656. Decode is still TODO - - 2.058 12 November 2012 - - * RT# 81119: Latest IO::Compress 2.057 fails tests on 5.8.x - - 2.057 10 November 2012 - - * IO::Compress::Zip - Allow member name & Zip Comment to be "0" - - * IO::Compress::Base::Common - Remove "-r" test - the file open will catch this. - RT# 80855: IO::Compress::Base::Common returns that it cannot read readable files in NFS - - * RT# 79820: Install to 'site' instead of 'perl' when perl version is 5.11+ - - * General Performance improvements. - - 2.055 5 August 2012 - - * FAQ - Added a few paragraphs on how to deal with pbzip2 files - [RT# #77743: Interoperability problems with pbzip2] - - * Compress::Zip - speed up compress, uncompress, memGzip & memGunzip. - [RT# #77350: Compress::Zlib::uncompress() is slowed down needlessly - by parameter validation - - 2.052 29 April 2012 - - * IO::Compress::Zip - Force a ZIP64 archive when it contains >= 0xFFFF entries. - - * Typos in POD - [RT# #76130: Gunzip Pod typo in OO section: $$output instead of $$input - - 2.049 18 February 2012 - - * IO::Compress::Zip - Error in t/cz-03zlib-v1.t that caused warnings with 5.15 - [RT# 110736: warnings from cpan/IO-Compress/t/cz-03zlib-v1.t] - - 2.048 29 January 2012 - - * Set minimum zlib version to 1.2.0 - - * IO::Compress test suite fails with Compress::Raw::Zlib 2.047 - and zlib < 1.2.4 - [RT# 74503] - - 2.047 28 January 2012 - - * Set minimum Perl version to 5.6 - - * IO::Compress::Zip - - In one-shot zip, set the Text Flag if "-T" thinks the file is a - text file. - - In one-shot mode, wrote mod time & access time in wrong order - in the "UT" extended field. - - 2.046 18 December 2011 - - * Minor update to bin/zipdetails - - * Typo in name of IO::Compress::FAQ.pod - - * IO::Uncompress::Unzip - - Example for walking a zip file used eof to control the outer - loop. This is wrong. - - * IO::Compress::Zip - - Change default for CanonicalName to false. - [RT# 72974] - - 2.045 3 December 2011 - - * Restructured IO::Compress::FAQ.pod - - 2.044 2 December 2011 - - * Moved FAQ.pod under the lib directory so it can get installed - - * Added bin/zipdetails - - * IO::Compress::Zip - - In one-shot mode enable Zip64 mode if the input file/buffer - >= 0xFFFFFFFF bytes. - - * IO::Compress::FAQ - - Updates - - 2.043 20 November 2011 - - * IO::Compress::Base - - Fixed issue that with handling of Zip files with two (or more) - entries that were STORED. Symptom is the first is uncompressed - ok, but the next will terminate early if the size of the file is - greater than BlockSize. - Regression test added to t/006zip.t - [RT# 72548] - - 2.042 17 November 2011 - - * IO::Compress::Zip - - Added exUnixN option to allow creation of the "ux" extra field. - This allows 32-bit UID/GID to be stored. - - In one-shot mode use exUnixN rather than exUnix2 for the UID/GID. - - * IO::Compress::Zlib::Extra::parseExtraField - - Fixed bad test for length of ID field - [RT# 72329 & #72505] - - 2.040 28 October 2011 - - * t/105oneshot-zip-only.t - - CanonicalName test failure on Windows - [RT# 68926] - - * IO::Compress::Zip - - ExtAttr now populates MSDOS attributes - - 2.039 28 October 2011 - - * IO::Compress::Zip - - Added CanonicalName option. - Note this option is set to true by default. - - Added FilterName option - - * IO::Unompress::Base - - Fixed issue where setting $\ would corrupt the uncompressed data. - Thanks to Steffen Goeldner for reporting the issue. - - * t/050interop-*.t - - Handle case when external command contains a whitespace - RT #71335 - - 2.037 22 June 2011 - - * IO::Uncompress - - get globmapper tests working on VMS - [RT# 68926] - - * IO::Uncompress::Unzip - - Fixed limitation where Streamed Stored content was not supported. - - 2.036 18 June 2011 - - * IO::Compress::Zip & IO::Uncompress::Unzip - - Added support for LZMA (method 14) compression/uncompresion. - - * IO::Compress::Unzip - - Fixed CRC issue when compression is Store or Bzip2 and Strict option - is set. - - * IO::Compress::Zip - - Fixed Zip64 issue where the content size is exactly 0xFFFFFFFF - - 2.035 6 May 2011 - - * RT #67931: Test failure on Windows - - 2.034 2 May 2011 - - * Compress::Zlib - - Silence pod warnings. - [RT# 64876] - - - Removed duplicate words in pod. - - * IO::Compress::Base - - - RT #56942: Testsuite fails when being run in parallel - - - Reduce symbol import - patch from J. Nick Koston - - - If the output buffer parameter passed to read has a value of - undef, and Append mode was specified when the file was opened, - and eof is reached, then the buffer paramer was left as undef. - This is different from when Append isn't specified - the buffer - parameter is set to an empty string. - - - There area couple of issues with reading a file that contains an - empty file that is compressed. - Create with -- touch /tmp/empty; gzip /tmp/empty. - Issue 1 - eof is not true immediately. Have to read from the file - to trigger eof. - Issue 2 - readline incorrectly returns an empty string the first - time it is called, and (correctly) undef thereafter. - [RT #67554] - - 2.033 11 Jan 2011 - - * Fixed typos & spelling errors. - [perl# 81816] - - 2.032 4 Jan 2011 - - * IO::Uncompress::Base - - An input file that had a valid header, and so would allow - creation of the uncompression object, but was then followed by - corrupt data would trigger an infinite loop when using the - input line oprator. - [RT #61915] - - * IO::Compress::Gzip - - XFL default settings for max compression & fastest algorithm were - the wrong way around. Thanks to Andrey Zholos for spotting this. - - * IO::Compress::Base::Common - - Fixed precedence problem in parameter parsing code. - - 2.030 22 July 2010 - - * IO::Compress::Zip - - Updates to documentation. - - Changes default value for ExtAttr on Unix to 0100644 - - * IO::Uncompress::Unzip - Reworked the "Name" option and examples in the pod. - - * IO::Uncompress::Base - Fixed problem with nextStream not returning 0 when there is no - next stream and Transparent is false. - - 2.027 24 April 2010 - - * Compress::Zlib - Remove autoload code from Zlib.pm. - [perl #74088] - - 2.026 7 April 2010 - - * IO::Uncompress::Zip - - Some updates to IO::Compress::Zip documentation. - - Fixed default setting for ExtAttr. - - - 2.025 27 March 2010 - - * IO::Uncompress::Unzip - The "Name" option wasn't documented. - - * Allow zlib version check to be disabled by setting - TEST_SKIP_VERSION_CHECK environment variable. - [RT #54510] - 2.024 7 January 2010 * Compress::Zlib @@ -342,7 +82,7 @@ CHANGES 2.018 3 May 2009 - * IO::Uncompress::Bunzip2 + * IO::Unompress::Bunzip2 - The interface to Compress-Raw-Bzip2 now uses the new LimitOutput feature. This will make all of the bzip2-related IO-Compress modules less greedy in their memory consumption. @@ -492,7 +232,7 @@ CHANGES FNAME & FCOMMENT fields for EBCDIC. * Compress::Zlib - lib/Compress/Zlib.pm -- 1.x Backward Compatibility issues + lib/Compress/Zlib.pm -- 1.x Backward Compatability issues gzclose - documented return value was wrong, should be 0 for ok. gzflush - return value didn't match 1.x, should return 0 if ok. [rt.cpan.org #29215] and Debian bug #440943 http://bugs.debian.org/440943 @@ -588,7 +328,7 @@ CHANGES * Add an explicit use_ok test for Scalar::Util in the test harness. The error message reported by 01misc implied the problem was somewhere else. - Also explicitly check that 'dualvar' is available. + Also explictly check that 'dualvar' is available. * Compress::Zlib - Fix append mode with gzopen. @@ -611,7 +351,7 @@ CHANGES Thanks to Andreas J. Koenig for spotting the problem. * IO::Uncompress::AnyUncompress - Added IO::Uncompress::Lzf to the list of supported uncompressors. + Added IO::Uncompress::Lzf to the list of supported uncompresors. * IO::Uncompress::Base Added TrailingData to one-shot interface. @@ -638,7 +378,7 @@ CHANGES * IO::Uncompress::UnZip Tighten up the zip64 extra field processing to cope with the case - wheere only some of the local header fields are superseded. + wheere only some of the local header fields are superceeded. * IO::Uncompress::AnyInflate Remove raw-deflate (RFC 1951) from the default list of compressors @@ -738,7 +478,7 @@ CHANGES Changed gzread so that its behaviour matches C::Z::gzread 1.x if it is called after eof. In this case it will write an empty string into the output parameter. This change is solely for backward - compatibility reasons. + compatability reasons. 2.000_09 3 March 2006 @@ -892,7 +632,7 @@ Compress-Zlib version 1 Changes 1.31 - 29 October 2003 * Reinstated the creation of .bak files - $^I seems to need a - backup file on Windows. For OpenVMS, the extension _bak is used. + backup file on Windows. For OpenVMS, the extenstion _bak is used. 1.30 - 28 October 2003 @@ -989,7 +729,7 @@ Compress-Zlib version 1 Changes 1.13 - 31st June 2001 - * Make sure config.in is consistent when released. + * Make sure config.in is consistant when released. 1.12 - 28th April 2001 diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/Makefile.PL b/gnu/usr.bin/perl/cpan/IO-Compress/Makefile.PL index a0e8ce3a7fe..00902f676be 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/Makefile.PL +++ b/gnu/usr.bin/perl/cpan/IO-Compress/Makefile.PL @@ -1,9 +1,9 @@ #! perl -w use strict ; -require 5.006 ; +require 5.004 ; -$::VERSION = '2.060' ; +$::VERSION = '2.024' ; use private::MakeUtil; use ExtUtils::MakeMaker 5.16 ; @@ -39,9 +39,7 @@ WriteMakefile( : () ), - INSTALLDIRS => ($] >= 5.009 && $] < 5.011 ? 'perl' : 'site'), - - EXE_FILES => ['bin/zipdetails'], + INSTALLDIRS => ($] >= 5.009 ? 'perl' : 'site'), ( $] >= 5.009 && $] <= 5.011001 && ! $ENV{PERL_CORE} @@ -49,12 +47,6 @@ WriteMakefile( : () ), - META_MERGE => { - no_index => { - directory => [ 't', 'private' ], - }, - }, - ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? ('LICENSE' => 'perl') : ()), diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/README b/gnu/usr.bin/perl/cpan/IO-Compress/README index 1af8b7148d3..3974cd4e392 100644 --- a/gnu/usr.bin/perl/cpan/IO-Compress/README +++ b/gnu/usr.bin/perl/cpan/IO-Compress/README @@ -1,11 +1,11 @@ - IO-Compress + IO-Compress - Version 2.060 + Version 2.024 - 7th January 2013 + 7th January 2010 - Copyright (c) 1995-2013 Paul Marquess. All rights reserved. + Copyright (c) 1995-2010 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -32,7 +32,7 @@ PREREQUISITES Before you can build IO-Compress you need to have the following installed on your system: - * Perl 5.006 or better. + * Perl 5.004 or better. * Compress::Raw::Zlib * Compress::Raw::Bzip2 @@ -89,7 +89,7 @@ To help me help you, I need all of the following information: If you haven't installed IO-Compress then search IO::Compress::Gzip.pm for a line like this: - $VERSION = "2.060" ; + $VERSION = "2.024" ; 2. If you are having problems building IO-Compress, send me a complete log of what happened. Start by unpacking the IO-Compress diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-bzip2.t b/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-bzip2.t index 2248535f7d1..9bb5eb20e74 100755 --- a/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-bzip2.t +++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-bzip2.t @@ -66,8 +66,12 @@ EOM my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ; -my ($file1, $file2, $stderr) ; -my $lex = new LexFile $file1, $file2, $stderr ; +my $file1 = "hello1.gz" ; +my $file2 = "hello2.gz" ; +my $stderr = "err.out" ; + +for ($file1, $file2, $stderr) { 1 while unlink $_ } ; + bzip2 \$hello1 => $file1 ; bzip2 \$hello2 => $file2 ; @@ -77,7 +81,8 @@ sub check my $command = shift ; my $expected = shift ; - my $lex = new LexFile my $stderr ; + my $stderr = 'err.out'; + 1 while unlink $stderr; my $cmd = "$command 2>$stderr"; my $stdout = `$cmd` ; @@ -132,3 +137,9 @@ for ($file1, $file2, $stderr) { 1 while unlink $_ } ; title "bzcat" ; check "$Perl ${examples}/bzcat $file2", $hello1 ; } + +END +{ + for ($file1, $file2, $stderr) { 1 while unlink $_ } ; +} + diff --git a/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-zlib.t b/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-zlib.t index 70e71410884..712c0b49343 100755 --- a/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-zlib.t +++ b/gnu/usr.bin/perl/cpan/IO-Compress/t/010examples-zlib.t @@ -66,8 +66,12 @@ EOM my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ; -my ($file1, $file2, $stderr) ; -my $lex = new LexFile $file1, $file2, $stderr ; +my $file1 = "hello1.gz" ; +my $file2 = "hello2.gz" ; +my $stderr = "err.out" ; + +for ($file1, $file2, $stderr) { 1 while unlink $_ } ; + gzip \$hello1 => $file1 ; gzip \$hello2 => $file2 ; @@ -77,8 +81,8 @@ sub check my $command = shift ; my $expected = shift ; - my $lex = new LexFile my $stderr ; - + my $stderr = 'err.out'; + 1 while unlink $stderr; my $cmd = "$command 2>$stderr"; my $stdout = `$cmd` ; @@ -133,3 +137,9 @@ for ($file1, $file2, $stderr) { 1 while unlink $_ } ; title "gzcat" ; check "$Perl ${examples}/gzcat $file2", $hello1 ; } + +END +{ + for ($file1, $file2, $stderr) { 1 while unlink $_ } ; +} + diff --git a/gnu/usr.bin/perl/cpan/IPC-SysV/Changes b/gnu/usr.bin/perl/cpan/IPC-SysV/Changes index 692637bcf70..ed605596c97 100644 --- a/gnu/usr.bin/perl/cpan/IPC-SysV/Changes +++ b/gnu/usr.bin/perl/cpan/IPC-SysV/Changes @@ -1,15 +1,3 @@ -2.03 - 2010-05-23 - - * fix CPAN #57530: IPC::Msg Documentation Bug - (thanks to Jonathan Hartzog for spotting this) - -2.02 - 2010-03-07 - - * fix CPAN #50762: mistaken use of $[ - (thanks to Zefram for spotting this) - * no need to specify an empty MAN3PODS in the core anymore - (thanks to Nicholas Clark for providing a patch) - 2.01 - 2009-03-15 released without changes diff --git a/gnu/usr.bin/perl/cpan/IPC-SysV/README b/gnu/usr.bin/perl/cpan/IPC-SysV/README index 4b34bb3133d..a9cb7bdd4d1 100644 --- a/gnu/usr.bin/perl/cpan/IPC-SysV/README +++ b/gnu/usr.bin/perl/cpan/IPC-SysV/README @@ -1,4 +1,4 @@ -Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz. +Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz. Version 1.x, Copyright (c) 1997, Graham Barr. diff --git a/gnu/usr.bin/perl/cpan/List-Util/Makefile.PL b/gnu/usr.bin/perl/cpan/List-Util/Makefile.PL index 5068e34598e..1cba5abdaaf 100644 --- a/gnu/usr.bin/perl/cpan/List-Util/Makefile.PL +++ b/gnu/usr.bin/perl/cpan/List-Util/Makefile.PL @@ -1,5 +1,5 @@ # -*- perl -*- -BEGIN { require 5.006; } +BEGIN { require 5.006; } # allow CPAN testers to get the point use strict; use warnings; use Config; @@ -7,6 +7,13 @@ use File::Spec; use ExtUtils::MakeMaker; my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV; +my $do_xs = $PERL_CORE || can_cc(); + +for (@ARGV) { + /^-pm/ and $do_xs = 0; + /^-xs/ and $do_xs = 1; +} + WriteMakefile( NAME => q[List::Util], ABSTRACT => q[Common Scalar and List utility subroutines], @@ -28,13 +35,14 @@ WriteMakefile( ( $PERL_CORE ? () : ( - INSTALLDIRS => ($] < 5.011 ? q[perl] : q[site]), + INSTALLDIRS => q[perl], PREREQ_PM => {'Test::More' => 0,}, (eval { ExtUtils::MakeMaker->VERSION(6.31) } ? (LICENSE => 'perl') : ()), + ($do_xs ? () : (XS => {}, C => [], OBJECT => '')), ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => { resources => { ## - repository => 'https://github.com/Scalar-List-Utils/Scalar-List-Utils', + repository => 'http://github.com/gbarr/Scalar-List-Utils', }, } ) @@ -44,3 +52,35 @@ WriteMakefile( ), ); + +sub can_cc { + + foreach my $cmd (split(/ /, $Config::Config{cc})) { + my $_cmd = $cmd; + return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); + + for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { + my $abs = File::Spec->catfile($dir, $_[1]); + return $abs if (-x $abs or $abs = MM->maybe_command($abs)); + } + } + + return; +} + +package MY; + +sub init_PM { + my $self = shift; + + $self->SUPER::init_PM(@_); + + return if $do_xs; + + my $pm = $self->{PM}; + my $pm_file = File::Spec->catfile(qw(lib List Util XS.pm)); + + # When installing pure perl, install XS.pp as XS.pm + $self->{PM}{'XS.pp'} = delete $self->{PM}{$pm_file}; +} + diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/dualvar.t b/gnu/usr.bin/perl/cpan/List-Util/t/dualvar.t index abd6479001b..5c0fe2140bd 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/dualvar.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/dualvar.t @@ -16,27 +16,22 @@ BEGIN { use Scalar::Util (); use Test::More (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) ? (skip_all => 'dualvar requires XS version') - : (tests => 41); -use Config; + : (tests => 13); Scalar::Util->import('dualvar'); -Scalar::Util->import('isdual'); $var = dualvar( 2.2,"string"); -ok( isdual($var), 'Is a dualvar'); ok( $var == 2.2, 'Numeric value'); ok( $var eq "string", 'String value'); $var2 = $var; -ok( isdual($var2), 'Is a dualvar'); ok( $var2 == 2.2, 'copy Numeric value'); ok( $var2 eq "string", 'copy String value'); $var++; -ok( ! isdual($var), 'No longer dualvar'); ok( $var == 3.2, 'inc Numeric value'); ok( $var ne "string", 'inc String value'); @@ -45,23 +40,15 @@ my $numtmp = int($numstr); # use $numstr as an int $var = dualvar($numstr, ""); -ok( isdual($var), 'Is a dualvar'); ok( $var == $numstr, 'NV'); SKIP: { skip("dualvar with UV value known to fail with $]",2) if $] < 5.006_001; - my $bits = ($Config{'use64bitint'}) ? 63 : 31; - $var = dualvar(1<<$bits, ""); - ok( isdual($var), 'Is a dualvar'); - ok( $var == (1<<$bits), 'UV 1'); - ok( $var > 0, 'UV 2'); + $var = dualvar(1<<31, ""); + ok( $var == (1<<31), 'UV 1'); + ok( $var > 0, 'UV 2'); } -# Create a dualvar "the old fashioned way" -$var = "10"; -ok( ! isdual($var), 'Not a dualvar'); -my $foo = $var + 0; -ok( isdual($var), 'Is a dualvar'); { package Tied; @@ -72,54 +59,12 @@ ok( isdual($var), 'Is a dualvar'); tie my $tied, 'Tied'; $var = dualvar($tied, "ok"); -ok(isdual($var), 'Is a dualvar'); ok($var == 7.5, 'Tied num'); ok($var eq 'ok', 'Tied str'); SKIP: { - skip("need utf8::is_utf8",3) unless defined &utf8::is_utf8; + skip("need utf8::is_utf8",2) unless defined &utf8::is_utf8; ok(!!utf8::is_utf8(dualvar(1,chr(400))), 'utf8'); ok( !utf8::is_utf8(dualvar(1,"abc")), 'not utf8'); } - - -SKIP: { - skip("Perl not compiled with 'useithreads'",20) unless ($Config{'useithreads'}); - require threads; import threads; - require threads::shared; import threads::shared; - skip("Requires threads::shared v1.42 or later",20) unless ($threads::shared::VERSION >= 1.42); - - my $siv :shared = dualvar(42, 'Fourty-Two'); - my $snv :shared = dualvar(3.14, 'PI'); - my $bits = ($Config{'use64bitint'}) ? 63 : 31; - my $suv :shared = dualvar(1<<$bits, 'Large unsigned int'); - - ok($siv == 42, 'Shared IV number preserved'); - ok($siv eq 'Fourty-Two', 'Shared string preserved'); - ok(isdual($siv), 'Is a dualvar'); - ok($snv == 3.14, 'Shared NV number preserved'); - ok($snv eq 'PI', 'Shared string preserved'); - ok(isdual($snv), 'Is a dualvar'); - ok($suv == (1<<$bits), 'Shared UV number preserved'); - ok($suv > 0, 'Shared UV number preserved'); - ok($suv eq 'Large unsigned int', 'Shared string preserved'); - ok(isdual($suv), 'Is a dualvar'); - - my @ary :shared; - $ary[0] = $siv; - $ary[1] = $snv; - $ary[2] = $suv; - - ok($ary[0] == 42, 'Shared IV number preserved'); - ok($ary[0] eq 'Fourty-Two', 'Shared string preserved'); - ok(isdual($ary[0]), 'Is a dualvar'); - ok($ary[1] == 3.14, 'Shared NV number preserved'); - ok($ary[1] eq 'PI', 'Shared string preserved'); - ok(isdual($ary[1]), 'Is a dualvar'); - ok($ary[2] == (1<<$bits), 'Shared UV number preserved'); - ok($ary[2] > 0, 'Shared UV number preserved'); - ok($ary[2] eq 'Large unsigned int', 'Shared string preserved'); - ok(isdual($ary[2]), 'Is a dualvar'); -} - diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/first.t b/gnu/usr.bin/perl/cpan/List-Util/t/first.t index 497cdd51882..1378c390449 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/first.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/first.t @@ -15,7 +15,7 @@ BEGIN { use List::Util qw(first); use Test::More; -plan tests => 22 + ($::PERL_ONLY ? 0 : 2); +plan tests => 19 + ($::PERL_ONLY ? 0 : 2); my $v; ok(defined &first, 'defined'); @@ -114,15 +114,6 @@ if (!$::PERL_ONLY) { SKIP: { } } -use constant XSUBC_TRUE => 1; -use constant XSUBC_FALSE => 0; - -is first(\&XSUBC_TRUE, 42, 1, 2, 3), 42, 'XSUB callbacks'; -is first(\&XSUBC_FALSE, 42, 1, 2, 3), undef, 'XSUB callbacks'; - - -eval { &first(1) }; -ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); eval { &first(1,2) }; ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); eval { &first(qw(a b)) }; diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/openhan.t b/gnu/usr.bin/perl/cpan/List-Util/t/openhan.t index e0dffb6f53f..bf4e6c16f86 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/openhan.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/openhan.t @@ -15,7 +15,7 @@ BEGIN { use strict; -use Test::More tests => 21; +use Test::More tests => 14; use Scalar::Util qw(openhandle); ok(defined &openhandle, 'defined'); @@ -36,20 +36,16 @@ SKIP: { skip "3-arg open only on 5.6 or later", 1 if $]<5.006; open my $fh, "<", $0; - skip "could not open $0 for reading: $!", 2 unless $fh; + skip "could not open $0 for reading: $!", 1 unless $fh; is(openhandle($fh), $fh, "works with indirect filehandles"); - close($fh); - is(openhandle($fh), undef, "works with indirect filehandles"); } SKIP: { - skip "in-memory files only on 5.8 or later", 2 if $]<5.008; + skip "in-memory files only on 5.8 or later", 1 if $]<5.008; open my $fh, "<", \"in-memory file"; - skip "could not open in-memory file: $!", 2 unless $fh; + skip "could not open in-memory file: $!", 1 unless $fh; is(openhandle($fh), $fh, "works with in-memory files"); - close($fh); - is(openhandle($fh), undef, "works with in-memory files"); } ok(openhandle(\*DATA), "works for \*DATA"); @@ -59,7 +55,7 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}"); { require IO::Handle; my $fh = IO::Handle->new_from_fd(fileno(*STDERR), 'w'); - skip "new_from_fd(fileno(*STDERR)) failed", 2 unless $fh; + skip "new_from_fd(fileno(*STDERR)) failed", 1 unless $fh; ok(openhandle($fh), "works for IO::Handle objects"); ok(!openhandle(IO::Handle->new), "unopened IO::Handle"); @@ -69,16 +65,14 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}"); require IO::File; my $fh = IO::File->new; $fh->open("< $0") - or skip "could not open $0: $!", 3; + or skip "could not open $0: $!", 1; ok(openhandle($fh), "works for IO::File objects"); - close($fh); - ok(!openhandle($fh), "works for IO::File objects"); ok(!openhandle(IO::File->new), "unopened IO::File" ); } SKIP: { - skip( "Tied handles only on 5.8 or later", 2) if $]<5.008; + skip( "Tied handles only on 5.8 or later", 1) if $]<5.008; use vars qw(*H); @@ -90,12 +84,6 @@ SKIP: { package main; tie *H, 'My::Tie'; ok(openhandle(*H), "tied handles are always ok"); - ok(openhandle(\*H), "tied handle refs are always ok"); } -ok !openhandle(undef), "undef is not a filehandle"; -ok !openhandle("STDIN"), "strings are not filehandles"; -ok !openhandle(0), "integers are not filehandles"; - - __DATA__ diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/reduce.t b/gnu/usr.bin/perl/cpan/List-Util/t/reduce.t index 4468ab86118..2e1257521ca 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/reduce.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/reduce.t @@ -16,7 +16,7 @@ BEGIN { use List::Util qw(reduce min); use Test::More; -plan tests => 29 + ($::PERL_ONLY ? 0 : 2); +plan tests => 27 + ($::PERL_ONLY ? 0 : 2); my $v = reduce {}; @@ -151,13 +151,6 @@ if (!$::PERL_ONLY) { SKIP: { } } -# XSUB callback -use constant XSUBC => 42; - -is reduce(\&XSUBC, 1, 2, 3), 42, "xsub callbacks"; - -eval { &reduce(1) }; -ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); eval { &reduce(1,2) }; ok($@ =~ /^Not a subroutine reference/, 'check for code reference'); eval { &reduce(qw(a b)) }; diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/reftype.t b/gnu/usr.bin/perl/cpan/List-Util/t/reftype.t index 31a5d3b8415..a7adafb9966 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/reftype.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/reftype.t @@ -13,7 +13,7 @@ BEGIN { } } -use Test::More tests => 32; +use Test::More tests => 29; use Scalar::Util qw(reftype); use vars qw($t $y $x *F); @@ -23,16 +23,12 @@ use Symbol qw(gensym); tie *F, 'MyTie'; my $RE = $] < 5.011 ? 'SCALAR' : 'REGEXP'; -my $s = []; # SvTYPE($s) is SVt_RV, and SvROK($s) is true -$s = undef; # SvTYPE($s) is SVt_RV, but SvROK($s) is false - @test = ( [ undef, 1, 'number' ], [ undef, 'A', 'string' ], [ HASH => {}, 'HASH ref' ], [ ARRAY => [], 'ARRAY ref' ], [ SCALAR => \$t, 'SCALAR ref' ], - [ SCALAR => \$s, 'SCALAR ref (but SVt_RV)' ], [ REF => \(\$t), 'REF ref' ], [ GLOB => \*F, 'tied GLOB ref' ], [ GLOB => gensym, 'GLOB ref' ], diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/sum.t b/gnu/usr.bin/perl/cpan/List-Util/t/sum.t index 3615b4ab416..ef484f96c59 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/sum.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/sum.t @@ -13,7 +13,7 @@ BEGIN { } } -use Test::More tests => 13; +use Test::More tests => 8; use List::Util qw(sum); @@ -58,40 +58,12 @@ use overload } } -use Math::BigInt; -my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65); -my $v2 = $v1 - 1; -$v = sum($v1,$v2); -is($v, $v1 + $v2, 'bigint'); +SKIP: { + eval { require bignum; } or skip("Need bignum for testing overloading",1); -$v = sum(42, $v1); -is($v, $v1 + 42, 'bigint + builtin int'); - -$v = sum(42, $v1, 2); -is($v, $v1 + 42 + 2, 'bigint + builtin int'); - -{ package example; - - use overload - '0+' => sub { $_[0][0] }, - '""' => sub { my $r = "$_[0][0]"; $r = "+$r" unless $r =~ m/^\-/; $r .= " [$_[0][1]]"; $r }, - fallback => 1; - - sub new { - my $class = shift; - - my $this = bless [@_], $class; - - return $this; - } -} - -{ - my $e1 = example->new(7, "test"); - $t = sum($e1, 7, 7); - is($t, 21, 'overload returning non-overload'); - $t = sum(8, $e1, 8); - is($t, 23, 'overload returning non-overload'); - $t = sum(9, 9, $e1); - is($t, 25, 'overload returning non-overload'); + my $v1 = 2**65; + my $v2 = 2**65; + my $v3 = $v1 + $v2; + $v = sum($v1,$v2); + is($v, $v3, 'bignum'); } diff --git a/gnu/usr.bin/perl/cpan/List-Util/t/tainted.t b/gnu/usr.bin/perl/cpan/List-Util/t/tainted.t index 8666117fe43..09ad330684c 100755 --- a/gnu/usr.bin/perl/cpan/List-Util/t/tainted.t +++ b/gnu/usr.bin/perl/cpan/List-Util/t/tainted.t @@ -16,7 +16,7 @@ BEGIN { } } -use Test::More tests => 5; +use Test::More tests => 4; use Scalar::Util qw(tainted); @@ -26,18 +26,9 @@ my $var = 2; ok( !tainted($var), 'known variable'); -my $key = (grep { !/^PERL/ } keys %ENV)[0]; +my $key = (keys %ENV)[0]; ok( tainted($ENV{$key}), 'environment variable'); $var = $ENV{$key}; ok( tainted($var), 'copy of environment variable'); - -{ - package Tainted; - sub TIESCALAR { bless {} } - sub FETCH { $^X } -} - -tie my $tiedvar, 'Tainted'; -ok( tainted($tiedvar), 'for magic variables'); diff --git a/gnu/usr.bin/perl/cpan/Locale-Codes/ChangeLog b/gnu/usr.bin/perl/cpan/Locale-Codes/ChangeLog index 427a6a314c6..c724b385256 100644 --- a/gnu/usr.bin/perl/cpan/Locale-Codes/ChangeLog +++ b/gnu/usr.bin/perl/cpan/Locale-Codes/ChangeLog @@ -1,3 +1,169 @@ -The ChangeLog has been moved to the Locale::Codes::Changes manual. -Please refer to it. + + ChangeLog for Locale-Codes Distribution + +2.07 2004-06-10 neilb + * made $_ local in the initialisation code for each module + change back-propagated from Perl distribution + * removed two non ISO-8859-1 characters from language names + change back-propagated from Perl distribution + * added the following aliases, with a test case for each + - Burma added to Myanmar + - French Southern and Antarctic Lands to + French Southern Territories + patch from TJ Mather + * "Canadian Dollar" was mis-spelled as "Candian Dollar" + - noted by Nick Cabatoff, patch from Michael Hennecke + * Changes to Locale::Country reflecting changes in ISO 3166 + - added Aland Islands (ax, ala, 248) + - YUGOSLAVIA is now SERBIA AND MONTENEGRO + YU => CS + YUG => SCG + 891 => 891 (unchanged) + (YUGOSLAVIA retained as an alias) + - EAST TIMOR changed to TIMOR-LESTE + (old name retained as an alias) + - three letter code for Romania changed from ROM to ROU + * ZAIRE is now CONGO, THE DEMOCRATIC REPUBLIC OF THE + ZR => CD + ZAR => COD + 180 => 180 (unchanged) + (ZAIRE retained as alias) + +2.06 2002-07-15 neilb + + * The four modules which have data after __DATA__ weren't + closing the DATA filehandle after reading from it, + which they should. Bug and patch from Steve Hay. + +2.05 2002-07-08 neilb + + * Added three letter codes for the countries that were missing + them. Patch from TJ Mather. + * Documentation bug: one of the examples used => where the + lvalue was a constant, which isn't allowed, unless you + put the () with the constant to force the right interpretation. + Pointed out by TJ Mather and MYT. + * Updated the URL for the appendix in the CIA world factbook. + Patch from TJ Mather. + +2.04 2002-05-23 neilb + + * updated according to changes in ISO 3166-1 described + in ISO 3166-1 newsletters V-4 and V-5, dated 2002-05-20: + - Kazakstan is now "Kazakhstan" + - Macau is now "Macao" + The old names are retained as aliases. + + The alpha-2 and alpha-3 codes for East Timor have changed: + tp -> tl + tmp -> tls + the numeric code stays 626. If you want to support the old + codes, you can use the semi-private function alias_code(). + +2.03 2002-03-24 neilb + + * Fixed a typo in the alias for the Vatican, reported (with patch) + by Philip Newton. + * Added "Moldova" as an alias for "Moldova, Republic of" + * Updated Makefile.PL to include AUTHOR and ABSTRACT + +2.02 2002-03-09 neilb + + * added semi-private routine rename_country() to Locale::Country, + based on a patch from Iain Chalmers. + * added test rename.t for the above function. + * renamed _alias_code to be alias_code. Have retained the old + name for backwards compatibility. Will remove it when the + major version number next changes. + +2.01 2002-02-18 neilb + + * Split the documentation for all modules into separate pod files. + * Made sure all =over were =over 4; some were other values. + * The code2code() methods had one more shift than was needed. + +2.00 2002-02-17 neilb + + * Created Locale::Script which provides an interface to the + ISO codes for identification of scripts (writing scripts, + rather than perl style scripts). The codes are defined + by ISO 15924, which is currently in final draft. + Thanks to Jarkko for pointing out this new standard. + All three code sets are supported, and a test-suite added. + + * Added support for country name variants to Locale::Country, + so that + country2code('USA') + country2code('United States') + country2code('United States of America') + will all return 'us'. + This had been in the LIMITATIONS section since the first version. + Patch from TJ Mather <tjmather@tjmather.com> with additional + variants from me. Added test-cases for these. + + * Added VERSION to Locale::Constants. Thanks to Jarkko for + pointing that it was missing. + + * Should really have bumped major version with previous release, + since there was a change to the API. + +1.06 2001-03-04 neilb + + Added Locale::Constants, which defines three symbols + for identifying which codeset is being used: + + LOCALE_CODE_ALPHA_2 + LOCALE_CODE_ALPHA_3 + LOCALE_CODE_NUMERIC + + Updated Locale::Country to support all three code sets + defined by ISO 3166. This was requested by Keith Wall. + I haven't added multiple codeset support to the other + modules yet - I'll wait until someone asks for them. + +1.05 Feb 2001 + + Added Locale::Currency, contribution from Michael Hennecke. + Added testsuite for it (t/currency.t) and added testcases + to t/all.t for the all_* functions. + +1.04 Dec 2000 + + Fixed very minor typos from 1.03! + +1.03 Dec 2000 + + Updated Locale::Country: + - fixed spelling of a few countries + - added link to a relevant page from CIA world factbook + + Updated Locale::Language: + - fixed typo in the documentation (ISO 939 should be 639) + +1.02 May 2000 + + Updated Locale::Country and Locale::Language to reflect changes + in the relevant ISO standards. These mainly reflect languages + which are new to the relevant standard, and changes in the + spelling of some country names. + + Added official URLs for the standards to the SEE ALSO sections + of the doc for each module. + + Thanks to Jarkko Hietaniemi for pointing me at the pages + with latest versions of ISO 3166 and 639. + +1.00 March 1998 + + Added Locale::Country::_alias_code() so that 'uk' can be added + as the code for "United Kingdom", if you want it. + This was prompted by Ed Jordan <ed@chronos.net> + + Added a new testsuite for handling this case, and extended the + existing test-suite to include testing of the case where + 'uk' hasn't been defined as a valid code. + +0.003 May 1997 + + First public release to CPAN diff --git a/gnu/usr.bin/perl/cpan/Log-Message-Simple/lib/Log/Message/Simple.pm b/gnu/usr.bin/perl/cpan/Log-Message-Simple/lib/Log/Message/Simple.pm index f9db4ffc1aa..18790365fdf 100644 --- a/gnu/usr.bin/perl/cpan/Log-Message-Simple/lib/Log/Message/Simple.pm +++ b/gnu/usr.bin/perl/cpan/Log-Message-Simple/lib/Log/Message/Simple.pm @@ -1,14 +1,13 @@ package Log::Message::Simple; -use if $] > 5.017, 'deprecate'; use strict; use Log::Message private => 0;; -BEGIN { - use vars qw[$VERSION]; - $VERSION = '0.10'; +BEGIN { + use vars qw[$VERSION]; + $VERSION = 0.06; } - + =pod @@ -46,7 +45,7 @@ Log::Message::Simple - Simplified interface to Log::Message local $Log::Message::Simple::MSG_FH = \*STDERR; local $Log::Message::Simple::ERROR_FH = \*STDERR; local $Log::Message::Simple::DEBUG_FH = \*STDERR; - + ### force a stacktrace on error local $Log::Message::Simple::STACKTRACE_ON_ERROR = 1 @@ -69,7 +68,7 @@ Exported by default, or using the C<:STD> tag. =head2 debug("message string" [,VERBOSE]) Records a debug message on the stack, and prints it to C<STDOUT> (or -actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below), +actually C<$DEBUG_FH>, see the C<GLOBAL VARIABLES> section below), if the C<VERBOSE> option is true. The C<VERBOSE> option defaults to false. @@ -84,10 +83,10 @@ The C<VERBOSE> options defaults to true. Exported by default, or using the C<:STD> tag. -=cut +=cut { package Log::Message::Handlers; - + sub msg { my $self = shift; my $verbose = shift || 0; @@ -128,8 +127,8 @@ Exported by default, or using the C<:STD> tag. my $msg = '['. $self->tag . '] ' . $self->message; - print $Log::Message::Simple::STACKTRACE_ON_ERROR - ? Carp::shortmess($msg) + print $Log::Message::Simple::STACKTRACE_ON_ERROR + ? Carp::shortmess($msg) : $msg . "\n"; select $old_fh; @@ -198,23 +197,23 @@ BEGIN { @ISA = 'Exporter'; @EXPORT = qw[error msg debug]; @EXPORT_OK = qw[carp cluck croak confess]; - + %EXPORT_TAGS = ( STD => \@EXPORT, CARP => \@EXPORT_OK, ALL => [ @EXPORT, @EXPORT_OK ], - ); + ); my $log = new Log::Message; for my $func ( @EXPORT, @EXPORT_OK ) { no strict 'refs'; - + ### up the carplevel for the carp emulation ### functions *$func = sub { local $Carp::CarpLevel += 2 if grep { $_ eq $func } @EXPORT_OK; - + my $msg = shift; $log->store( message => $msg, @@ -266,12 +265,10 @@ printed. This default to C<*STDOUT>. =item $STACKTRACE_ON_ERROR -If this option is set to C<true>, every call to C<error()> will +If this option is set to C<true>, every call to C<error()> will generate a stacktrace using C<Carp::shortmess()>. Defaults to C<false> -=back - =cut BEGIN { @@ -281,7 +278,7 @@ BEGIN { $ERROR_FH = \*STDERR; $MSG_FH = \*STDOUT; $DEBUG_FH = \*STDOUT; - + $STACKTRACE_ON_ERROR = 0; } diff --git a/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/02_imports.t b/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/02_imports.t index 4fc22ba4ecf..4910b971c90 100755 --- a/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/02_imports.t +++ b/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/02_imports.t @@ -9,50 +9,50 @@ my @Msg = qw[msg debug error]; ### test empty import { package Test::A; - + eval "use $Class ()"; Test::More::ok( !$@, "using $Class with no import" ); - + for my $func ( @Carp, @Msg ) { Test::More::ok( !__PACKAGE__->can( $func ), " $func not imported" ); } -} +} ### test :STD import { package Test::B; eval "use $Class ':STD'"; Test::More::ok( !$@, "using $Class with :STD import" ); - + for my $func ( @Carp ) { Test::More::ok( !__PACKAGE__->can( $func ), " $func not imported" ); } - + for my $func ( @Msg ) { Test::More::ok( __PACKAGE__->can( $func ), " $func imported" ); - } -} + } +} ### test :CARP import { package Test::C; eval "use $Class ':CARP'"; Test::More::ok( !$@, "using $Class with :CARP import" ); - + for my $func ( @Msg ) { Test::More::ok( !__PACKAGE__->can( $func ), " $func not imported" ); } - + for my $func ( @Carp ) { Test::More::ok( __PACKAGE__->can( $func ), " $func imported" ); - } -} + } +} ### test all import @@ -60,9 +60,9 @@ my @Msg = qw[msg debug error]; eval "use $Class ':ALL'"; Test::More::ok( !$@, "using $Class with :ALL import" ); - + for my $func ( @Carp, @Msg ) { Test::More::ok( __PACKAGE__->can( $func ), " $func imported" ); - } -} + } +} diff --git a/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/03_functions.t b/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/03_functions.t index 952efb9aae8..7d8a0d89949 100755 --- a/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/03_functions.t +++ b/gnu/usr.bin/perl/cpan/Log-Message-Simple/t/03_functions.t @@ -18,7 +18,7 @@ use_ok( $Class ); ### & friends will print there for my $name (@Carp, @Msg) { no strict 'refs'; - *$name = sub { + *$name = sub { local $^W; ### do the block twice to avoid 'used only once' @@ -36,41 +36,41 @@ use_ok( $Class ); local *STDERR; local $SIG{__WARN__} = sub { }; - + my $ref = $Class->can( $name ); $ref->( @_ ); }; - } + } } for my $name (@Carp, @Msg) { - + my $ref = $Pkg->can( $name ); ok( $ref, "Found function for '$name'" ); ### start with an empty stack? cmp_ok( scalar @{[$Class->stack]}, '==', 0, " Starting with empty stack" ); - ok(!$Class->stack_as_string," Stringified stack empty" ); - + ok(!$Class->stack_as_string," Stringified stack empty" ); + ### call the func... no output should appear ### eval this -- the croak/confess functions die eval { $ref->( $Text ); }; - + my @stack = $Class->stack; cmp_ok( scalar(@stack), '==', 1, " Text logged to stack" ); - - for my $re ( $Text, quotemeta '['.uc($name).']' ) { + + for my $re ( $Text, quotemeta '['.uc($name).']' ) { like( $Class->stack_as_string, qr/$re/, " Text as expected" ); } - ### empty stack again ### + ### empty stack again ### ok( $Class->flush, " Stack flushed" ); cmp_ok( scalar @{[$Class->stack]}, '==', 0, " Starting with empty stack" ); - ok(!$Class->stack_as_string," Stringified stack empty" ); + ok(!$Class->stack_as_string," Stringified stack empty" ); } diff --git a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message.pm b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message.pm index effcd133b9e..3b2f43e57da 100644 --- a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message.pm +++ b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message.pm @@ -1,5 +1,4 @@ package Log::Message; -use if $] > 5.017, 'deprecate'; use strict; @@ -12,7 +11,9 @@ local $Params::Check::VERBOSE = 1; BEGIN { use vars qw[$VERSION @ISA $STACK $CONFIG]; - $VERSION = '0.06'; + + $VERSION = 0.02; + $STACK = []; } @@ -88,7 +89,7 @@ More on this below. These are individual message items, which are objects that contain the user message as well as the meta-data described above. -See the L<Log::Message::Item> manpage to see how to extract this +See the L<Log::Message::Item> manpage to see how to extract this meta-data and how to work with the Item objects. You should never need to create your own Item objects, but knowing about their methods and accessors is important if you want to write @@ -178,8 +179,8 @@ provided. =item verbose Log::Message makes use of another module to validate its arguments, -which is called L<Params::Check>, which is a lightweight, yet -powerful input checker and parser. (See the L<Params::Check> +which is called L<Params::Check>, which is a lightweight, yet +powerful input checker and parser. (See the L<Params::Check> manpage for details). The verbose setting will control whether this module will @@ -313,7 +314,7 @@ sub _new_stack { }; my $args = check( $tmpl, \%hash, $CONFIG->verbose ) or ( - warn(loc(q[Could not create a new stack object: %1], + warn(loc(q[Could not create a new stack object: %1], Params::Check->last_error) ), return @@ -398,9 +399,9 @@ sub store { %hash = @_; } - my $args = check( $tmpl, \%hash ) or ( - warn( loc(q[Could not store error: %1], Params::Check->last_error) ), - return + my $args = check( $tmpl, \%hash ) or ( + warn( loc(q[Could not store error: %1], Params::Check->last_error) ), + return ); my $extra = delete $args->{extra}; @@ -487,10 +488,10 @@ sub retrieve { } my $args = check( $tmpl, \%hash ) or ( - warn( loc(q[Could not parse input: %1], Params::Check->last_error) ), - return + warn( loc(q[Could not parse input: %1], Params::Check->last_error) ), + return ); - + my @list = grep { $_->tag =~ /$args->{tag}/ ? 1 : 0 } grep { $_->level =~ /$args->{level}/ ? 1 : 0 } @@ -560,7 +561,7 @@ This removes all items from the stack and returns them to the caller sub flush { my $self = shift; - + return splice @{$self->{STACK}}; } diff --git a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Config.pm b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Config.pm index e326e40c94c..9769119ed32 100644 --- a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Config.pm +++ b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Config.pm @@ -1,5 +1,4 @@ package Log::Message::Config; -use if $] > 5.017, 'deprecate'; use strict; use Params::Check qw[check]; @@ -9,7 +8,7 @@ use Locale::Maketext::Simple Style => 'gettext'; BEGIN { use vars qw[$VERSION $AUTOLOAD]; - $VERSION = '0.06'; + $VERSION = 0.01; } sub new { diff --git a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Handlers.pm b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Handlers.pm index 956b0661be5..c7c35c6e389 100644 --- a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Handlers.pm +++ b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Handlers.pm @@ -1,9 +1,5 @@ package Log::Message::Handlers; -use if $] > 5.017, 'deprecate'; use strict; -use vars qw[$VERSION]; - -$VERSION = '0.06'; =pod @@ -115,7 +111,7 @@ sub warn { warn shift->message; } =head2 trace Will provide a traceback of this error item back to the first one that -occurred, clucking with every item as it comes across it. +occurrent, clucking with every item as it comes across it. =cut diff --git a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Item.pm b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Item.pm index 13e1e459cc3..85ae6fc6003 100644 --- a/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Item.pm +++ b/gnu/usr.bin/perl/cpan/Log-Message/lib/Log/Message/Item.pm @@ -1,8 +1,6 @@ package Log::Message::Item; -use if $] > 5.017, 'deprecate'; use strict; -use vars qw[$VERSION]; use Params::Check qw[check]; use Log::Message::Handlers; @@ -12,7 +10,7 @@ use Carp (); BEGIN { use vars qw[$AUTOLOAD $VERSION]; - $VERSION = '0.06'; + $VERSION = $Log::Message::VERSION; } ### create a new item. @@ -90,7 +88,7 @@ Log::Message::Item - Message objects for Log::Message $item->remove; # delete the item from the stack it was on # Besides these methods, you can also call the handlers on - # the object specifically. + # the object specificallly. # See the Log::Message::Handlers manpage for documentation on what # handlers are available by default and how to add your own diff --git a/gnu/usr.bin/perl/cpan/Log-Message/t/01_Log-Message-Config.t b/gnu/usr.bin/perl/cpan/Log-Message/t/01_Log-Message-Config.t index 0c7e08902b8..2f8a021d7e1 100755 --- a/gnu/usr.bin/perl/cpan/Log-Message/t/01_Log-Message-Config.t +++ b/gnu/usr.bin/perl/cpan/Log-Message/t/01_Log-Message-Config.t @@ -1,10 +1,10 @@ ### Log::Message::Config test suite ### -BEGIN { +BEGIN { if( $ENV{PERL_CORE} ) { chdir '../lib/Log/Message' if -d '../lib/Log/Message'; unshift @INC, '../../..'; } -} +} BEGIN { chdir 't' if -d 't' } @@ -81,4 +81,4 @@ use_ok( 'Log::Message' ) or diag "Module.pm not found. Dying", die; ); is_deeply( $mixed, $log->{CONFIG}, q[Config creation from file & options] ); } - + diff --git a/gnu/usr.bin/perl/cpan/Log-Message/t/02_Log-Message.t b/gnu/usr.bin/perl/cpan/Log-Message/t/02_Log-Message.t index 592c93be79b..83944585edc 100755 --- a/gnu/usr.bin/perl/cpan/Log-Message/t/02_Log-Message.t +++ b/gnu/usr.bin/perl/cpan/Log-Message/t/02_Log-Message.t @@ -1,10 +1,10 @@ ### Log::Message test suite ### -BEGIN { +BEGIN { if( $ENV{PERL_CORE} ) { chdir '../lib/Log/Message' if -d '../lib/Log/Message'; unshift @INC, '../../..'; } -} +} BEGIN { chdir 't' if -d 't' } @@ -18,7 +18,7 @@ for my $pkg ( qw[ Log::Message Log::Message::Config Log::Message::Item Log::Message::Handlers] ) { use_ok( $pkg ) or diag "'$pkg' not found. Dying"; -} +} ### test global stack { @@ -69,11 +69,11 @@ for my $pkg ( qw[ Log::Message Log::Message::Config ); { - ok( $log->retrieve( message => qr/baz/ ), + ok( $log->retrieve( message => qr/baz/ ), q[ Retrieving based on message] ); - ok( $log->retrieve( tag => qr/TAG/ ), + ok( $log->retrieve( tag => qr/TAG/ ), q[ Retrieving based on tag] ); - ok( $log->retrieve( level => qr/test/ ), + ok( $log->retrieve( level => qr/test/ ), q[ Retrieving based on level] ); } @@ -95,7 +95,7 @@ for my $pkg ( qw[ Log::Message Log::Message::Config like( $item->shortmess, qr/\w+/, q[ Item shortmess stored properly] ); - + ok( $item->longmess, q[Item longmess stored] ); like( $item->longmess, qr/Log::Message::store/s, q[ Item longmess stored properly] @@ -118,7 +118,7 @@ for my $pkg ( qw[ Log::Message Log::Message::Config { ok( $item->remove, q[Removing item from stack] ); - ok( (!grep{ $item eq $_ } $log->retrieve), + ok( (!grep{ $item eq $_ } $log->retrieve), q[ Item removed from stack] ); } @@ -127,36 +127,36 @@ for my $pkg ( qw[ Log::Message Log::Message::Config ok( @{$log->{STACK}} == 0, q[Flushing stack] ); } } - -### test errors + +### test errors { my $log = Log::Message->new( private => 1 ); - + ### store errors { ### dont make it print my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; - + my $rv = $log->store(); ok( !$rv, q[Logging empty message failed] ); like( $warnings, qr/message/, q[ Spotted the error] ); } - + ### retrieve errors { ### dont make it print my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; - + ### XXX whitebox test! local $Params::Check::VERBOSE = 1; # so the warnings are emitted local $Params::Check::VERBOSE = 1; # so the warnings are emitted - + my $rv = $log->retrieve( frobnitz => $$ ); ok( !$rv, q[Retrieval with bogus args] ); - like( $warnings, qr/not a valid key/, + like( $warnings, qr/not a valid key/, qq[ Spotted the error] ); } -} +} diff --git a/gnu/usr.bin/perl/cpan/Log-Message/t/conf/config_file b/gnu/usr.bin/perl/cpan/Log-Message/t/conf/config_file index 0c471319feb..834529ad9d5 100644 --- a/gnu/usr.bin/perl/cpan/Log-Message/t/conf/config_file +++ b/gnu/usr.bin/perl/cpan/Log-Message/t/conf/config_file @@ -27,4 +27,4 @@ # retrieve errors in chronological order, or not? # if none provided, set to '1' - chrono = 0
\ No newline at end of file + chrono = 0 diff --git a/gnu/usr.bin/perl/cpan/MIME-Base64/Changes b/gnu/usr.bin/perl/cpan/MIME-Base64/Changes index 428dcbc13b2..4b60a89d969 100644 --- a/gnu/usr.bin/perl/cpan/MIME-Base64/Changes +++ b/gnu/usr.bin/perl/cpan/MIME-Base64/Changes @@ -1,54 +1,3 @@ -2010-10-26 Gisle Aas <gisle@ActiveState.com> - - Release 3.13 - - The fix in v3.12 to try to preserve the SvUTF8 flag was buggy - and actually managed to set the flag on strings that did not - have it originally. - - - -2010-10-25 Gisle Aas <gisle@ActiveState.com> - - Release 3.12 - - Don't change SvUTF8 flag on the strings encoded [RT#60105] - - Documentation tweaks - - - -2010-10-24 Gisle Aas <gisle@ActiveState.com> - - Release 3.11 - - Provide encode_base64url and decode_base64url functions to process - the base64 scheme for "URL applications". - - The decode_base64() does not issue warnings on suspect input data - any more. - - - -2010-10-11 Gisle Aas <gisle@ActiveState.com> - - Release 3.10 - - Provide functions to calculate the length of encoded and decoded - base64 strings [RT#62404] - - - -2010-01-25 Gisle Aas <gisle@ActiveState.com> - - Release 3.09 - - The Quoted-Printable encoder would sometimes output lines - that were 77 characters long. The max line length should be 76. - [RT#53919] - - - 2009-06-09 Gisle Aas <gisle@ActiveState.com> Release 3.08 diff --git a/gnu/usr.bin/perl/cpan/MIME-Base64/Makefile.PL b/gnu/usr.bin/perl/cpan/MIME-Base64/Makefile.PL index 8307d2c3189..73004476907 100644 --- a/gnu/usr.bin/perl/cpan/MIME-Base64/Makefile.PL +++ b/gnu/usr.bin/perl/cpan/MIME-Base64/Makefile.PL @@ -10,36 +10,4 @@ WriteMakefile( NAME => 'MIME::Base64', VERSION_FROM => 'Base64.pm', @makefileopts, - - ABSTRACT => 'The RFC 2045 encodings; base64 and quoted-printable', - AUTHOR => 'Gisle Aas <gisle@activestate.com>', - LICENSE => 'perl', - MIN_PERL_VERSION => 5.006, - META_MERGE => { - resources => { - repository => 'http://github.com/gisle/mime-base64', - } - }, ); - -BEGIN { - # compatibility with older versions of MakeMaker - my $developer = -d ".git"; - my %mm_req = ( - LICENCE => 6.31, - META_MERGE => 6.45, - META_ADD => 6.45, - MIN_PERL_VERSION => 6.48, - ); - undef(*WriteMakefile); - *WriteMakefile = sub { - my %arg = @_; - for (keys %mm_req) { - unless (eval { ExtUtils::MakeMaker->VERSION($mm_req{$_}) }) { - warn "$_ $@" if $developer; - delete $arg{$_}; - } - } - ExtUtils::MakeMaker::WriteMakefile(%arg); - }; -} diff --git a/gnu/usr.bin/perl/cpan/MIME-Base64/README b/gnu/usr.bin/perl/cpan/MIME-Base64/README index 93eaa62e12e..fbd3d54cda8 100644 --- a/gnu/usr.bin/perl/cpan/MIME-Base64/README +++ b/gnu/usr.bin/perl/cpan/MIME-Base64/README @@ -21,7 +21,7 @@ In order to install and use this package you will need Perl version make test make install -Copyright 1995-1999,2001-2004,2010 Gisle Aas <gisle@ActiveState.com> +Copyright 1995-1999,2001-2004 Gisle Aas <gisle@ActiveState.com> This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/cpan/Module-Build/Changes b/gnu/usr.bin/perl/cpan/Module-Build/Changes index 5d7996861aa..ad9195c5456 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/Changes +++ b/gnu/usr.bin/perl/cpan/Module-Build/Changes @@ -1,447 +1,5 @@ Revision history for Perl extension Module::Build. -0.4003 - Sat Aug 18 11:17:49 CEST 2012 - - [BUG FIXES] - - - Get rid of outdated metadata tests [Steve Hay] - -0.4002 - Fri Jul 27 20:04:09 EEST 2012 - - [BUG FIXES] - - - Test for TAP::Harness version properly [Leon Timmermans] - - - Install to 'site' on 5.12+ [Leon Timmermans] - - [DOCUMENTATION] - - - Document extra_{compiler|linker}_flags accessors [Nick Wellnhofer] - -0.4001 - Tue Jun 26 20:54:15 CEST 2012 - [BUG FIXES] - - - Parse Pod name a litte more leniently [Paul Evans] - - [DOCUMENTATION] - - - Various spelling fixes [Leon Timmermans, Jonathan Yu] - - - Fixes configuration keys used for script location [Leon Timmermans, reported by Samuel Ferencik] - - [OTHER] - - - use warnings - -0.40 - Fri Feb 24 18:47:48 CET 2012 - - - Released 0.39_02 as 0.40 without any code changes - -0.39_02 - Thu Feb 17 00:33:18 MET 2012 - - [BUG FIXES] - - - Fixed bug where modules without $VERSION might have a version of '0' - listed in 'provides' metadata, which will be rejected by PAUSE - [David Golden, reported by Christopher Fields] - - - Fixed bug in PodParser to allow numerals in module names - [Tokuhirom] - - - Fixed bug where giving arguments twice led to them becoming arrays, - resulting in install paths like "ARRAY(0xdeadbeef)/lib/Foo.pm" - [Leon Timmermans] - - [DOCUMENTATION] - - - Fixed deviance from alphabetical order in documentation of - constructor parameters. [Eric Brine] - - - Add documentation for configure_requires constructor parameter. - [Eric Brine] - - - Change some of the docs' language describing relationship to - MakeMaker. [Ken Williams] - - [OTHER] - - - List Perl-Toolchain-Gang repo as official repo - -0.39_01 - Thu Jul 21 16:48:48 EDT 2011 - - [BUG FIXES] - - - Fixed bug with a nested directory named 'share' inside a ShareDir - (RT#68585) [David Golden] - - - Fixed failing tilde.t when run under UID without passwd entry - (RT#67893) [Dominic Hargreaves] - - [DOCUMENTATION] - - - Fixed typo in Module::Build (RT#67008) [David Golden] - - [OTHER] - - - Pod to HTML internals changed to support new Pod::Html work - in the Perl core - -0.3800 - Sat Mar 5 15:11:41 EST 2011 - - Summary of major changes since 0.3624: - - [ENHANCEMENTS] - - - Generates META.json and MYMETA.json consistent with version 2 of the - CPAN Meta Spec. [David Golden] - - Also in this release: - - [BUG FIXES] - - - Autogenerated documentation no longer includes private actions from - Module::Build's own release subclass. [Report by Timothy Appnel, - fix by David Golden] - -0.37_06 - Mon Feb 28 21:43:31 EST 2011 - - [BUG FIXES] - - - prerequisites with the empty string instead of a version are - normalized to "0". (RT#65909) - - [OTHER] - - - More Pod typo/link fixes [Hongwen Qiu] - -0.37_05 - Sat Feb 19 20:43:23 EST 2011 - - [BUG FIXES] - - - fixes failing ppm.t in perl core - - [OTHER] - - - Pod typo fixes [Hongwen Qiu] - -0.37_04 - Wed Feb 16 15:27:21 EST 2011 - - [OTHER] - - - moved scripts/ to bin/ for less confusing porting to bleadperl - -0.37_03 - Wed Feb 16 09:54:05 EST 2011 - - [BUG FIXES] - - - removed an irrelevant test in t/actions/installdeps.t that was causing - failures on some Cygwin platforms - - [OTHER] - - - dropped configure_requires as some CPAN clients apparently get - confused by having things in both configure_requires and requires - - - bumped Parse::CPAN::Meta build prereq to 1.4401 - - - bumped CPAN::Meta prereq to 2.110420 - - - Pod typo fixes [Hongwen Qiu] - -0.37_02 - Mon Feb 7 21:05:30 EST 2011 - - [BUG FIXES] - - - bumped CPAN::Meta prereq to 2.110390 to avoid a regression in 2.110360 - -0.37_01 - Thu Feb 3 03:44:38 EST 2011 - - [ENHANCEMENTS] - - - Generates META.json and MYMETA.json consistent with version 2 of the - CPAN Meta Spec. [David Golden] - - [BUG FIXES] - - - t/signature.t now uses a mocked Module::Signature; this should be - more robust across platforms as it only needs to confirm that - Module::Build is calling Module::Signature when expected - - [OTHER] - - - Added CPAN::Meta and Parse::CPAN::Meta to prerequisites and dropped - CPAN::Meta::YAML - -0.3624 - Thu Jan 27 11:38:39 EST 2011 - - - Fixed pod2html directory bugs and fixed creation of spurious blib - directory in core perl directory when running install.t (RT#63003) - [Chris Williams] - -0.3623 - Wed Jan 26 17:45:30 EST 2011 - - - Fixed bugs involving bootstrapping configure_requires prerequisites - on older CPANPLUS clients or for either CPAN/CPANPLUS when using - the compatibility Makefile.PL - - - Added diagnostic output when configure_requires are missing for - the benefit of users doing manual installation - -0.3622 - Mon Jan 24 21:06:50 EST 2011 - - - No changes from 0.36_21 - -0.36_21 - Fri Jan 21 11:01:28 EST 2011 - - - Changed YAML::Tiny references to the new CPAN::Meta::YAML module - instead, which is the YAML-variant that is going into the Perl core - -0.36_20 - Fri Dec 10 15:36:03 EST 2010 - - *** DEPRECATIONS *** - - - Module::Build::Version has been deprecated. Module::Build now depends - directly upon version.pm. A pure-perl version has been bundled in inc/ - solely for bootstrapping in case configure_requires is not supported. - M::B::Version remains as a wrapper around version.pm. - - - Module::Build::ModuleInfo has been deprecated. Module::Build now - depends directly upon Module::Metadata (which is an extraction of - M::B::ModuleInfo intended for general reuse). A pure-perl version has - been bundled in inc/ solely for bootstrapping in case - configure_requires is not supported. M::B::ModuleInfo remains as a - wrapper around Module::Metadata. - - - Module::Build::YAML has been deprecated. Module::Build now depends - directly upon YAML::Tiny. M::B::YAML remains as a subclass wrapper. - The YAML_support feature has been removed, as YAML is now an ordinary - dependency. - -0.36_19 - Tue Dec 7 13:43:42 EST 2010 - - Bug fixes: - - - Perl::OSType is declared as a 'configure_requires' dependency, but is - also bundled in inc (and loaded if needed) [David Golden] - -0.36_18 - Mon Dec 6 16:46:49 EST 2010 - - Changes: - - - Added dependency on Perl::OSType to refactor and centralize - management of OS type mapping [David Golden] - - - When parsing a version number out of a file, any trailing alphabetical - characters will be dropped to avoid fatal errors when comparing version - numbers. These would have been dropped (with a warning) anyway during - an ordinary numeric comparison. (RT#56071) [David Golden] - - Bug fixes: - - - A Perl interpreter mismatch between running Build.PL and running Build - is now a fatal error, not a warning (RT#55183) [David Golden] - - - Bundled Module::Build::Version updated to bring into sync with CPAN - version.pm 0.86 [David Golden] - - - No longer uses fake user 'foo' in t/tilde (RT#61793) [David Golden] - - - Won't fail tests if an ancient Tie::IxHash is installed - [Christopher J. Madsen] - - - Correctly report missing metafile field names [David Golden] - - - Suppress uninitialized value errors during Pod creation - on ActiveState Perl [David Golden] - - - Return to starting directory after install action; this is - an attempt to fix an install.t heisenbug (RT#63003) [David Golden] - - - A broken version.pm load won't cause Module::Build::Version to - die trying to install itself as a mock version (RT#59499) - [Eric Wilhelm and David Golden] - - - PERL_DL_NONLAZY is now always set when tests are run - (RT#56055) [Dmitry Karasik] - - - 'fakeinstall' will use .modulebuildrc actions for 'install' if - no specific 'fakeinstall' options are provided (RT#57279) - [David Golden] - - - Add install*script to search path for installdeps client - and search site, then vendor, then core paths - - - Skip noexec tmpdir check on Windows (RT#55667) [Jan Dubois] - - - Arguments with key value pairs may now have keys with "-" in them - (RT#53050) [David Golden] - - - Add quotemeta to t/tilde.t test to fix Cygwin fails - [Chris Williams and David Golden] - - - Build script now checks that M::B is at least the same version - of M::B as provided in 'configure_requires' in META - (RT#54954) [David Golden] - -0.36_17 - Wed Oct 27 18:08:36 EDT 2010 - - Enhancements: - - - Added 'distinstall' action to run 'Build install' inside the - generated distribution directory [Jeff Thalhammer] - -0.36_16 - Thu Aug 26 12:44:07 EDT 2010 - - Bug fixes: - - - Better error message in case package declaration is not found - when searching for version. [Alexandr Ciornii] - - - Skips 'release_status' tests on perl < 5.8.1 due to buggy - treatment of dotted-decimal version numbers [David Golden] - -0.36_15 - Wed Aug 25 10:41:28 EDT 2010 - - Bug fixes: - - - Added a mock Software::License to prevent t/properties/license.t - from failing. - -0.36_14 - Sun Aug 22 22:56:50 EDT 2010 - - Enhancements: - - - Adds 'release_status' and 'dist_suffix' properties in preparation - for adding CPAN Meta Spec 2 support. 'dist_suffix' will be set - to 'TRIAL' automatically when necessary. [David Golden] - - - Makes 'license' more liberal. You can now specify either a license - key from the approved list (c.f. Module::Build::API) or just a - Software::License subclass name (e.g. 'Perl_5'). This should - provide better support for custom or proprietary licenses. - [David Golden] - -0.36_13 - Wed Jul 28 22:40:25 EDT 2010 - - Bug-fixes: - - - Bundled Module::Build::Version updated to bring into sync with CPAN - version.pm 0.82 [David Golden] - -0.36_12 - Tue Jul 27 00:08:51 EDT 2010 - - Enhancements: - - - Module::Build::Compat will now convert dotted-decimal prereqs into - decimal rather than dying (and will warn about this). [Apocalypse] - - Bug fixes: - - - Caches case-sensitivity checks to boost performance, fixes - RT#55162 and RT#56513 [Reini Urban] - - - Won't try to use ActivePerl doc generation tools without confirming - that they are indeed installed. [David Golden] - - - Sets temporary $ENV{HOME} in testing to an absolute path, which fixes - some issues when tested as part of the Perl core [Nicholas Clark] - - - Module::Build::ModuleInfo now warns instead of dying when a module - has an invalid version. ->version now just returns undef - (RT#59593) [David Golden] - - Changes: - - - When authors do not specify Module::Build in configure_requires and - Module::Build is automatically added, a warning will be issued - showing the added prerequisite [David Golden] - - - Moved automatic configure_requires generation into get_metadata() - and added an 'auto' argument to toggle it (on for META and off - for MYMETA) [David Golden] - -0.36_11 - Thu May 27 09:41:23 EDT 2010 - - Bug fixes: - - - Handle META/MYMETA reading and writing within Module::Build to ensure - utf8 mode on filehandles. Now passes/gets only strings to YAML::Tiny - or Module::Build::YAML - -0.36_10 - Wed May 19 18:36:06 EDT 2010 - - Bug fixes: - - - Fix failing t/manifypods.t on Windows from 0.36_09 changes [Klaus - Eichner] - -0.36_09 - Tue May 11 09:19:12 EDT 2010 - - Bug fixes: - - - Improve HTML documentation generation on ActivePerl (RT#53478) - [Scott Renner and Klaus Eichner] - -0.36_08 - Mon Apr 26 08:00:15 EDT 2010 - - Enhancements: - - - Give a list of valid licenses when given one we don't recognize - (RT#55951) [Yanick Champoux] - - - Added 'Build manifest_skip' action to generate a default MANIFEST.SKIP - [David Golden] - - Changes: - - - When temporarily generating a MANIFEST.SKIP when none exists, it will - be removed on exit instead of hanging around until 'Build clean'. This - is less surprising/confusing and the 'Build manifest_skip' action - is now available instead to bootstrap the file [David Golden] - - Bug fixes: - - - Fixed runtime error on cygwin when searching for an executable command - during installdeps testing [David Golden] - -0.3607 - Thu Apr 1 11:27:16 EDT 2010 - - Bug fixes: - - - The 'dist' action now always ensures a clean dist directory before - creating the tarball [David Golden] - -0.36_06 - Thu Apr 1 01:23:58 EDT 2010 - - Other: - - - Migrated repository to git and updated META.yml to match - - - Removed bugtracker URL (let search.cpan.org use default) - - - Disabled SIGNATURE generation - -0.3605 - Wed Mar 31 12:05:11 EDT 2010 - - - No changes from 0.36_04 - -0.36_04 - Tue Mar 16 21:41:41 EDT 2010 - - Bug fixes: - - - Added missing newline to "Changing sharpbang" messages under verbose - output (RT#54474) [David Golden] - - - Added 'beos' to list of Unix-like os types (RT#53876) [Nigel Horne] - - - Sets $ENV{HOME} to a temporary directory during testing [David Golden] - - - For VMS: fixed prefix handling plus other test fixes [Craig Berry] - - - Support anonymous array of directories for c_source [Alberto Simões] - - - Small POD formatting fix [James Keenan] - 0.3603 - Mon Jan 18 22:28:59 EST 2010 (Oops, I released the last one before I realized this should have been diff --git a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm index 0be3dde62ec..9356325c9f4 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm +++ b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/Amiga.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Amiga; use strict; use vars qw($VERSION); -$VERSION = '0.4003'; +$VERSION = '0.3603'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm index 8c4349b5f6c..140e27872aa 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm +++ b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/EBCDIC.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::EBCDIC; use strict; use vars qw($VERSION); -$VERSION = '0.4003'; +$VERSION = '0.3603'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm index 5688a99329d..66bbdc95da6 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm +++ b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/MPEiX.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::MPEiX; use strict; use vars qw($VERSION); -$VERSION = '0.4003'; +$VERSION = '0.3603'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm index 6ed9d3d1c37..95e31515876 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm +++ b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/Platform/RiscOS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::RiscOS; use strict; use vars qw($VERSION); -$VERSION = '0.4003'; +$VERSION = '0.3603'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm index cf285693e2f..614a59a85e5 100644 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Devel/InnerPackage.pm @@ -4,15 +4,14 @@ use strict; use base qw(Exporter); use vars qw($VERSION @EXPORT_OK); -use if $] > 5.017, 'deprecate'; - -$VERSION = '0.4'; +$VERSION = '0.3'; @EXPORT_OK = qw(list_packages); =pod =head1 NAME + Devel::InnerPackage - find all the inner packages of a package =head1 SYNOPSIS @@ -84,12 +83,12 @@ sub list_packages { sub _loaded { my ($class, $name) = @_; - no strict 'refs'; + no strict 'refs'; # Handle by far the two most common cases # This is very fast and handles 99% of cases. return 1 if defined ${"${name}::VERSION"}; - return 1 if @{"${name}::ISA"}; + return 1 if defined @{"${name}::ISA"}; # Are there any symbol table entries other than other namespaces foreach ( keys %{"${name}::"} ) { diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm index 9e7962efab7..bbdb49b6bca 100644 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable.pm @@ -1,18 +1,15 @@ package Module::Pluggable; use strict; -use vars qw($VERSION $FORCE_SEARCH_ALL_PATHS); +use vars qw($VERSION); use Module::Pluggable::Object; -use if $] > 5.017, 'deprecate'; - # ObQuote: # Bob Porter: Looks like you've been missing a lot of work lately. # Peter Gibbons: I wouldn't say I've been missing it, Bob! -$VERSION = '4.7'; -$FORCE_SEARCH_ALL_PATHS = 0; +$VERSION = '3.9'; sub import { my $class = shift; @@ -25,7 +22,6 @@ sub import { my ($package) = $opts{'package'} || $pkg; $opts{filename} = $file; $opts{package} = $package; - $opts{force_search_all_paths} = $FORCE_SEARCH_ALL_PATHS unless exists $opts{force_search_all_paths}; my $finder = Module::Pluggable::Object->new(%opts); @@ -156,8 +152,9 @@ Optionally it instantiates those classes for you. =head1 ADVANCED USAGE + Alternatively, if you don't want to use 'plugins' as the method ... - + package MyClass; use Module::Pluggable sub_name => 'foo'; @@ -230,21 +227,6 @@ and then later ... my @filters = $self->filters; my @plugins = $self->plugins; - -=head1 PLUGIN SEARCHING - -Every time you call 'plugins' the whole search path is walked again. This allows -for dynamically loading plugins even at run time. However this can get expensive -and so if you don't expect to want to add new plugins at run time you could do - - - package Foo; - use strict; - use Module::Pluggable sub_name => '_plugins'; - - our @PLUGINS; - sub plugins { @PLUGINS ||= shift->_plugins } - 1; =head1 INNER PACKAGES @@ -325,62 +307,6 @@ the extensions F<.swp> or F<.swo>, or files beginning with F<.#>. Setting C<include_editor_junk> changes C<Module::Pluggable> so it does not ignore any files it finds. -=head2 follow_symlinks - -Whether, when searching directories, to follow symlinks. - -Defaults to 1 i.e do follow symlinks. - -=head2 min_depth, max_depth - -This will allow you to set what 'depth' of plugin will be allowed. - -So, for example, C<MyClass::Plugin::Foo> will have a depth of 3 and -C<MyClass::Plugin::Foo::Bar> will have a depth of 4 so to only get the former -(i.e C<MyClass::Plugin::Foo>) do - - package MyClass; - use Module::Pluggable max_depth => 3; - -and to only get the latter (i.e C<MyClass::Plugin::Foo::Bar>) - - package MyClass; - use Module::Pluggable min_depth => 4; - - -=head1 TRIGGERS - -Various triggers can also be passed in to the options. - -If any of these triggers return 0 then the plugin will not be returned. - -=head2 before_require <plugin> - -Gets passed the plugin name. - -If 0 is returned then this plugin will not be required either. - -=head2 on_require_error <plugin> <err> - -Gets called when there's an error on requiring the plugin. - -Gets passed the plugin name and the error. - -The default on_require_error handler is to C<carp> the error and return 0. - -=head2 on_instantiate_error <plugin> <err> - -Gets called when there's an error on instantiating the plugin. - -Gets passed the plugin name and the error. - -The default on_instantiate_error handler is to C<carp> the error and return 0. - -=head2 after_require <plugin> - -Gets passed the plugin name. - -If 0 is returned then this plugin will be required but not returned as a plugin. =head1 METHODs @@ -393,29 +319,7 @@ search_path. $self->search_path( add => "New::Path" ); # add $self->search_path( new => "New::Path" ); # replace -=head1 BEHAVIOUR UNDER TEST ENVIRONMENT -In order to make testing reliable we exclude anything not from blib if blib.pm is -in %INC. - -However if the module being tested used another module that itself used C<Module::Pluggable> -then the second module would fail. This was fixed by checking to see if the caller -had (^|/)blib/ in their filename. - -There's an argument that this is the wrong behaviour and that modules should explicitly -trigger this behaviour but that particular code has been around for 7 years now and I'm -reluctant to change the default behaviour. - -You can now (as of version 4.1) force Module::Pluggable to look outside blib in a test environment by doing either - - require Module::Pluggable; - $Module::Pluggable::FORCE_SEARCH_ALL_PATHS = 1; - import Module::Pluggable; - -or - - use Module::Pluggable force_search_all_paths => 1; - =head1 FUTURE PLANS @@ -428,12 +332,6 @@ Recently tried fixed to find inner packages and to make it However suggestions (and patches) are welcome. -=head1 DEVELOPMENT - -The master repo for this module is at - -https://github.com/simonwistow/Module-Pluggable - =head1 AUTHOR Simon Wistow <simon@thegestalt.org> diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm index 6b1d265456c..e0ee993075d 100644 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/lib/Module/Pluggable/Object.pm @@ -4,13 +4,11 @@ use strict; use File::Find (); use File::Basename; use File::Spec::Functions qw(splitdir catdir curdir catfile abs2rel); -use Carp qw(croak carp confess); +use Carp qw(croak carp); use Devel::InnerPackage; use vars qw($VERSION); -use if $] > 5.017, 'deprecate'; - -$VERSION = '4.6'; +$VERSION = '3.9'; sub new { @@ -27,74 +25,64 @@ sub new { sub plugins { - my $self = shift; - my @args = @_; + my $self = shift; - # override 'require' - $self->{'require'} = 1 if $self->{'inner'}; + # override 'require' + $self->{'require'} = 1 if $self->{'inner'}; - my $filename = $self->{'filename'}; - my $pkg = $self->{'package'}; + my $filename = $self->{'filename'}; + my $pkg = $self->{'package'}; - # Get the exception params instantiated - $self->_setup_exceptions; + # Get the exception params instantiated + $self->_setup_exceptions; - # automatically turn a scalar search path or namespace into a arrayref - for (qw(search_path search_dirs)) { - $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); - } + # automatically turn a scalar search path or namespace into a arrayref + for (qw(search_path search_dirs)) { + $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); + } - # default search path is '<Module>::<Name>::Plugin' - $self->{'search_path'} ||= ["${pkg}::Plugin"]; + # default search path is '<Module>::<Name>::Plugin' + $self->{'search_path'} = ["${pkg}::Plugin"] unless $self->{'search_path'}; - # default error handler - $self->{'on_require_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't require $plugin : $err"; return 0 }; - $self->{'on_instantiate_error'} ||= sub { my ($plugin, $err) = @_; carp "Couldn't instantiate $plugin: $err"; return 0 }; - # default whether to follow symlinks - $self->{'follow_symlinks'} = 1 unless exists $self->{'follow_symlinks'}; + #my %opts = %$self; - # check to see if we're running under test - my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! && !$self->{'force_search_all_paths'} ? grep {/blib/} @INC : @INC; - # add any search_dir params - unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; + # check to see if we're running under test + my @SEARCHDIR = exists $INC{"blib.pm"} && defined $filename && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC; - # set our @INC up to include and prefer our search_dirs if necessary - my @tmp = @INC; - unshift @tmp, @{$self->{'search_dirs'} || []}; - local @INC = @tmp if defined $self->{'search_dirs'}; + # add any search_dir params + unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'}; - my @plugins = $self->search_directories(@SEARCHDIR); - push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; - - # return blank unless we've found anything - return () unless @plugins; - - # remove duplicates - # probably not necessary but hey ho - my %plugins; - for(@plugins) { - next unless $self->_is_legit($_); - $plugins{$_} = 1; - } - # are we instantiating or requring? - if (defined $self->{'instantiate'}) { - my $method = $self->{'instantiate'}; - my @objs = (); - foreach my $package (sort keys %plugins) { - next unless $package->can($method); - my $obj = eval { $package->$method(@_) }; - $self->{'on_instantiate_error'}->($package, $@) if $@; - push @objs, $obj if $obj; + my @plugins = $self->search_directories(@SEARCHDIR); + push(@plugins, $self->handle_innerpackages($_)) for @{$self->{'search_path'}}; + + # push @plugins, map { print STDERR "$_\n"; $_->require } list_packages($_) for (@{$self->{'search_path'}}); + + # return blank unless we've found anything + return () unless @plugins; + + + + # remove duplicates + # probably not necessary but hey ho + my %plugins; + for(@plugins) { + next unless $self->_is_legit($_); + $plugins{$_} = 1; } - return @objs; - } else { - # no? just return the names - my @objs= sort keys %plugins; - return @objs; - } + + # are we instantiating or requring? + if (defined $self->{'instantiate'}) { + my $method = $self->{'instantiate'}; + return map { ($_->can($method)) ? $_->$method(@_) : () } keys %plugins; + } else { + # no? just return the names + return keys %plugins; + } + + } sub _setup_exceptions { @@ -139,16 +127,12 @@ sub _is_legit { my %except = %{$self->{_exceptions}->{except_hash}||{}}; my $only = $self->{_exceptions}->{only}; my $except = $self->{_exceptions}->{except}; - my $depth = () = split '::', $plugin, -1; return 0 if (keys %only && !$only{$plugin} ); return 0 unless (!defined $only || $plugin =~ m!$only! ); return 0 if (keys %except && $except{$plugin} ); return 0 if (defined $except && $plugin =~ m!$except! ); - - return 0 if defined $self->{max_depth} && $depth>$self->{max_depth}; - return 0 if defined $self->{min_depth} && $depth<$self->{min_depth}; return 1; } @@ -209,7 +193,7 @@ sub search_paths { next if ($in_pod || $line =~ /^=cut/); # skip pod text next if $line =~ /^\s*#/; # and comments if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) { - @pkg_dirs = split /::/, $1 if defined $1;; + @pkg_dirs = split /::/, $1; $name = $2; last; } @@ -236,7 +220,10 @@ sub search_paths { next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i; - $self->handle_finding_plugin($plugin, \@plugins) + my $err = $self->handle_finding_plugin($plugin); + carp "Couldn't require $plugin : $err" if $err; + + push @plugins, $plugin; } # now add stuff that may have been in package @@ -265,33 +252,12 @@ sub _is_editor_junk { } sub handle_finding_plugin { - my $self = shift; - my $plugin = shift; - my $plugins = shift; - my $no_req = shift || 0; - + my $self = shift; + my $plugin = shift; + + return unless (defined $self->{'instantiate'} || $self->{'require'}); return unless $self->_is_legit($plugin); - unless (defined $self->{'instantiate'} || $self->{'require'}) { - push @$plugins, $plugin; - return; - } - - $self->{before_require}->($plugin) || return if defined $self->{before_require}; - unless ($no_req) { - my $tmp = $@; - my $res = eval { $self->_require($plugin) }; - my $err = $@; - $@ = $tmp; - if ($err) { - if (defined $self->{on_require_error}) { - $self->{on_require_error}->($plugin, $err) || return; - } else { - return; - } - } - } - $self->{after_require}->($plugin) || return if defined $self->{after_require}; - push @$plugins, $plugin; + $self->_require($plugin); } sub find_files { @@ -307,8 +273,7 @@ sub find_files { { # for the benefit of perl 5.6.1's Find, localize topic local $_; File::Find::find( { no_chdir => 1, - follow => $self->{'follow_symlinks'}, - wanted => sub { + wanted => sub { # Inlined from File::Find::Rule C< name => '*.pm' > return unless $File::Find::name =~ /$file_regex/; (my $path = $File::Find::name) =~ s#^\\./##; @@ -329,7 +294,10 @@ sub handle_innerpackages { my @plugins; foreach my $plugin (Devel::InnerPackage::list_packages($path)) { - $self->handle_finding_plugin($plugin, \@plugins, 1); + my $err = $self->handle_finding_plugin($plugin); + #next if $err; + #next unless $INC{$plugin}; + push @plugins, $plugin; } return @plugins; @@ -337,11 +305,11 @@ sub handle_innerpackages { sub _require { - my $self = shift; - my $pack = shift; + my $self = shift; + my $pack = shift; + local $@; eval "CORE::require $pack"; - die ($@) if $@; - return 1; + return $@; } diff --git a/gnu/usr.bin/perl/cpan/Module-Pluggable/t/19can_ok_clobber.t b/gnu/usr.bin/perl/cpan/Module-Pluggable/t/19can_ok_clobber.t index 60616f6a300..07c598b4ba1 100755 --- a/gnu/usr.bin/perl/cpan/Module-Pluggable/t/19can_ok_clobber.t +++ b/gnu/usr.bin/perl/cpan/Module-Pluggable/t/19can_ok_clobber.t @@ -10,7 +10,7 @@ use Test::More tests=>5; #use_ok( 'MyTest' ); #diag "Module::Pluggable::VERSION $Module::Pluggable::VERSION"; -my @plugins = sort MyTest->plugins; +my @plugins = MyTest->plugins; my @plugins_after; use_ok( 'MyTest::Plugin::Foo' ); @@ -21,16 +21,16 @@ is_deeply( \@plugins_after, \@plugins, "plugins haven't been clobbered", -) or diag Dumper(\@plugins_after,\@plugins); +); can_ok ($foo, 'frobnitz'); -@plugins_after = sort MyTest->plugins; +@plugins_after = MyTest->plugins; is_deeply( \@plugins_after, \@plugins, "plugins haven't been clobbered", -) or diag Dumper(\@plugins_after,\@plugins); +) or diag Dumper ; diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/lib/Object/Accessor.pm b/gnu/usr.bin/perl/cpan/Object-Accessor/lib/Object/Accessor.pm index 9a930905c2e..7166200af19 100644 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/lib/Object/Accessor.pm +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/lib/Object/Accessor.pm @@ -1,16 +1,16 @@ package Object::Accessor; -use if $] > 5.017, 'deprecate'; use strict; use Carp qw[carp croak]; use vars qw[$FATAL $DEBUG $AUTOLOAD $VERSION]; use Params::Check qw[allow]; +use Data::Dumper; ### some objects might have overload enabled, we'll need to ### disable string overloading for callbacks require overload; -$VERSION = '0.46'; +$VERSION = '0.36'; $FATAL = 0; $DEBUG = 0; @@ -36,7 +36,7 @@ Object::Accessor - interface to create per object accessors $bool = $obj->mk_aliases( # create an alias to an existing alias_name => 'method'); # method name - + $clone = $obj->mk_clone; # create a clone of original # object without data $bool = $obj->mk_flush; # clean out all data @@ -59,7 +59,7 @@ Object::Accessor - interface to create per object accessors $obj = My::Class->new; # create base object $bool = $obj->mk_accessors('foo'); # create accessors, etc... - ### make all attempted access to non-existent accessors fatal + ### make all attempted access to non-existant accessors fatal ### (defaults to false) $Object::Accessor::FATAL = 1; @@ -69,11 +69,11 @@ Object::Accessor - interface to create per object accessors ### advanced usage -- callbacks { my $obj = Object::Accessor->new('foo'); $obj->register_callback( sub { ... } ); - + $obj->foo( 1 ); # these calls invoke the callback you registered - $obj->foo() # which allows you to change the get/set + $obj->foo() # which allows you to change the get/set # behaviour and what is returned to the caller. - } + } ### advanced usage -- lvalue attributes { my $obj = Object::Accessor::Lvalue->new('foo'); @@ -82,12 +82,12 @@ Object::Accessor - interface to create per object accessors ### advanced usage -- scoped attribute values { my $obj = Object::Accessor->new('foo'); - + $obj->foo( 1 ); print $obj->foo; # will print 1 ### bind the scope of the value of attribute 'foo' - ### to the scope of '$x' -- when $x goes out of + ### to the scope of '$x' -- when $x goes out of ### scope, 'foo's previous value will be restored { $obj->foo( 2 => \my $x ); print $obj->foo, ' ', $x; # will print '2 2' @@ -117,8 +117,8 @@ inheritable. Any arguments given to C<new> are passed straight to C<mk_accessors>. If you want to be able to assign to your accessors as if they -were C<lvalue>s, you should create your object in the -C<Object::Accessor::Lvalue> namespace instead. See the section +were C<lvalue>s, you should create your object in the +C<Object::Acccessor::Lvalue> namespace instead. See the section on C<LVALUE ACCESSORS> below. =cut @@ -126,9 +126,9 @@ on C<LVALUE ACCESSORS> below. sub new { my $class = shift; my $obj = bless {}, $class; - + $obj->mk_accessors( @_ ) if @_; - + return $obj; } @@ -151,7 +151,7 @@ For example: foo => qr/^\d+$/, # digits only bar => [0,1], # booleans zot => \&my_sub # a custom verification sub - } ); + } ); Returns true on success, false on failure. @@ -161,27 +161,27 @@ global variable C<$FATAL> to true. See the section on C<GLOBAL VARIABLES> for details. Note that you can bind the values of attributes to a scope. This allows -you to C<temporarily> change a value of an attribute, and have it's +you to C<temporarily> change a value of an attribute, and have it's original value restored up on the end of it's bound variable's scope; -For example, in this snippet of code, the attribute C<foo> will -temporarily be set to C<2>, until the end of the scope of C<$x>, at +For example, in this snippet of code, the attribute C<foo> will +temporarily be set to C<2>, until the end of the scope of C<$x>, at which point the original value of C<1> will be restored. my $obj = Object::Accessor->new; - + $obj->mk_accessors('foo'); $obj->foo( 1 ); print $obj->foo; # will print 1 ### bind the scope of the value of attribute 'foo' - ### to the scope of '$x' -- when $x goes out of + ### to the scope of '$x' -- when $x goes out of ### scope, 'foo' previous value will be restored { $obj->foo( 2 => \my $x ); print $obj->foo, ' ', $x; # will print '2 2' } print $obj->foo; # will print 1 - + Note that all accessors are read/write for everyone. See the C<TODO> section for details. @@ -191,11 +191,11 @@ section for details. sub mk_accessors { my $self = $_[0]; my $is_hash = UNIVERSAL::isa( $_[1], 'HASH' ); - + ### first argument is a hashref, which means key/val pairs ### as keys + allow handlers for my $acc ( $is_hash ? keys %{$_[1]} : @_[1..$#_] ) { - + ### already created apparently if( exists $self->{$acc} ) { __PACKAGE__->___debug( "Accessor '$acc' already exists"); @@ -206,7 +206,7 @@ sub mk_accessors { ### explicitly vivify it, so that exists works in ls_accessors() $self->{$acc}->[VALUE] = undef; - + ### set the allow handler only if one was specified $self->{$acc}->[ALLOW] = $_[1]->{$acc} if $is_hash; } @@ -223,7 +223,7 @@ by one to the C<can> method. =cut sub ls_accessors { - ### metainformation is stored in the stringified + ### metainformation is stored in the stringified ### key of the object, so skip that when listing accessors return sort grep { $_ ne "$_[0]" } keys %{$_[0]}; } @@ -240,7 +240,7 @@ sub ls_allow { my $self = shift; my $key = shift or return; return exists $self->{$key}->[ALLOW] - ? $self->{$key}->[ALLOW] + ? $self->{$key}->[ALLOW] : sub { 1 }; } @@ -256,7 +256,7 @@ This allows you to do the following: $self->mk_accessors('foo'); $self->mk_aliases( bar => 'foo' ); - + $self->bar( 42 ); print $self->foo; # will print 42 @@ -265,7 +265,7 @@ This allows you to do the following: sub mk_aliases { my $self = shift; my %aliases = @_; - + while( my($alias, $method) = each %aliases ) { ### already created apparently @@ -294,7 +294,7 @@ sub mk_clone { my $class = ref $self; my $clone = $class->new; - + ### split out accessors with and without allow handlers, so we ### don't install dummy allow handers (which makes O::A::lvalue ### warn for example) @@ -348,7 +348,7 @@ object has been filled with values satisfying their own allow criteria. sub mk_verify { my $self = $_[0]; - + my $fail; for my $name ( $self->ls_accessors ) { unless( allow( $self->$name, $self->ls_allow( $name ) ) ) { @@ -361,7 +361,7 @@ sub mk_verify { return if $fail; return 1; -} +} =head2 $bool = $self->register_callback( sub { ... } ); @@ -373,31 +373,31 @@ You are free to return whatever you wish. On a C<set> call, the data is even stored in the object. Below is an example of the use of a callback. - + $object->some_method( "some_value" ); - + my $callback = sub { my $self = shift; # the object my $meth = shift; # "some_method" - my $val = shift; # ["some_value"] + my $val = shift; # ["some_value"] # could be undef -- check 'exists'; # if scalar @$val is empty, it was a 'get' - + # your code here return $new_val; # the value you want to be set/returned - } + } To access the values stored in the object, circumventing the callback structure, you should use the C<___get> and C<___set> methods -documented further down. +documented further down. =cut sub register_callback { my $self = shift; my $sub = shift or return; - + ### use the memory address as key, it's not used EVER as an ### accessor --kane $self->___callback( $sub ); @@ -430,20 +430,19 @@ sub can { my($self, $method) = @_; ### it's one of our regular methods - my $code = $self->UNIVERSAL::can($method); - if( $code ) { - carp( "Can '$method' -- provided by package" ) if $DEBUG; - return $code; + if( $self->UNIVERSAL::can($method) ) { + __PACKAGE__->___debug( "Can '$method' -- provided by package" ); + return $self->UNIVERSAL::can($method); } ### it's an accessor we provide; if( UNIVERSAL::isa( $self, 'HASH' ) and exists $self->{$method} ) { - carp( "Can '$method' -- provided by object" ) if $DEBUG; + __PACKAGE__->___debug( "Can '$method' -- provided by object" ); return sub { $self->$method(@_); } } ### we don't support it - carp( "Cannot '$method'" ) if $DEBUG; + __PACKAGE__->___debug( "Cannot '$method'" ); return; } @@ -471,21 +470,21 @@ sub ___autoload { if ( not exists $self->{$method} ) { __PACKAGE__->___error("No such accessor '$method'", 1); return; - } - + } + ### a method on something else, die with a descriptive error; - } else { + } else { local $FATAL = 1; - __PACKAGE__->___error( + __PACKAGE__->___error( "You called '$AUTOLOAD' on '$self' which was interpreted by ". __PACKAGE__ . " as an object call. Did you mean to include ". "'$method' from somewhere else?", 1 ); - } + } ### is this is an alias, redispatch to the original method if( my $original = $self->{ $method }->[ALIAS] ) { return $self->___autoload( $original, @_ ); - } + } ### assign? my $val = $assign ? shift(@_) : $self->___get( $method ); @@ -495,43 +494,43 @@ sub ___autoload { ### any binding? if( $_[0] ) { if( ref $_[0] and UNIVERSAL::isa( $_[0], 'SCALAR' ) ) { - + ### tie the reference, so we get an object and ### we can use it's going out of scope to restore ### the old value my $cur = $self->{$method}->[VALUE]; - - tie ${$_[0]}, __PACKAGE__ . '::TIE', + + tie ${$_[0]}, __PACKAGE__ . '::TIE', sub { $self->$method( $cur ) }; - + ${$_[0]} = $val; - + } else { - __PACKAGE__->___error( - "Can not bind '$method' to anything but a SCALAR", 1 + __PACKAGE__->___error( + "Can not bind '$method' to anything but a SCALAR", 1 ); } } - + ### need to check the value? - if( defined $self->{$method}->[ALLOW] ) { + if( exists $self->{$method}->[ALLOW] ) { ### double assignment due to 'used only once' warnings local $Params::Check::VERBOSE = 0; local $Params::Check::VERBOSE = 0; - + allow( $val, $self->{$method}->[ALLOW] ) or ( - __PACKAGE__->___error( - "'$val' is an invalid value for '$method'", 1), - return - ); + __PACKAGE__->___error( + "'$val' is an invalid value for '$method'", 1), + return + ); } } - + ### callbacks? if( my $sub = $self->___callback ) { $val = eval { $sub->( $self, $method, ($assign ? [$val] : []) ) }; - + ### register the error $self->___error( $@, 1 ), return if $@; } @@ -540,16 +539,16 @@ sub ___autoload { if( $assign ) { $self->___set( $method, $val ) or return; } - + return [$val]; } =head2 $val = $self->___get( METHOD_NAME ); Method to directly access the value of the given accessor in the -object. It circumvents all calls to allow checks, callbacks, etc. +object. It circumvents all calls to allow checks, callbakcs, etc. -Use only if you C<Know What You Are Doing>! General usage for +Use only if you C<Know What You Are Doing>! General usage for this functionality would be in your own custom callbacks. =cut @@ -565,21 +564,21 @@ sub ___get { =head2 $bool = $self->___set( METHOD_NAME => VALUE ); Method to directly set the value of the given accessor in the -object. It circumvents all calls to allow checks, callbacks, etc. +object. It circumvents all calls to allow checks, callbakcs, etc. -Use only if you C<Know What You Are Doing>! General usage for +Use only if you C<Know What You Are Doing>! General usage for this functionality would be in your own custom callbacks. -=cut +=cut sub ___set { my $self = shift; my $method = shift or return; - + ### you didn't give us a value to set! - @_ or return; + exists $_[0] or return; my $val = shift; - + ### if there's more arguments than $self, then ### replace the method called by the accessor. ### XXX implement rw vs ro accessors! @@ -593,7 +592,7 @@ sub ___set { Method to directly alias one accessor to another for this object. It circumvents all sanity checks, etc. -Use only if you C<Know What You Are Doing>! +Use only if you C<Know What You Are Doing>! =cut @@ -601,9 +600,9 @@ sub ___alias { my $self = shift; my $alias = shift or return; my $method = shift or return; - + $self->{ $alias }->[ALIAS] = $method; - + return 1; } @@ -612,9 +611,10 @@ sub ___debug { my $self = shift; my $msg = shift; + my $lvl = shift || 0; local $Carp::CarpLevel += 1; - + carp($msg); } @@ -632,13 +632,13 @@ sub ___error { sub ___callback { my $self = shift; my $sub = shift; - + my $mem = overload::Overloaded( $self ) ? overload::StrVal( $self ) : "$self"; $self->{$mem} = $sub if $sub; - + return $self->{$mem}; } @@ -651,7 +651,7 @@ C<Object::Accessor::Lvalue>. For example: my $obj = Object::Accessor::Lvalue->new('foo'); $obj->foo += 1; print $obj->foo; - + will actually print C<1> and work as expected. Since this is an optional feature, that's not desirable in all cases, we require you to explicitly use the C<Object::Accessor::Lvalue> class. @@ -674,7 +674,7 @@ C<perl 5.8.x> feature. See perldoc L<perl58delta> for details. =item * Allow handlers Due to the nature of C<lvalue subs>, we never get access to the -value you are assigning, so we can not check it against your allow +value you are assigning, so we can not check it againt your allow handler. Allow handlers are therefor unsupported under C<lvalue> conditions. @@ -685,7 +685,7 @@ See C<perldoc perlsub> for details. Due to the nature of C<lvalue subs>, we never get access to the value you are assigning, so we can not check provide this value to your callback. Furthermore, we can not distinguish between -a C<get> and a C<set> call. Callbacks are therefor unsupported +a C<get> and a C<set> call. Callbacks are therefor unsupported under C<lvalue> conditions. See C<perldoc perlsub> for details. @@ -702,7 +702,7 @@ See C<perldoc perlsub> for details. *VALUE = *Object::Accessor::VALUE; *ALLOW = *Object::Accessor::ALLOW; - ### largely copied from O::A::Autoload + ### largely copied from O::A::Autoload sub AUTOLOAD : lvalue { my $self = shift; my($method) = ($AUTOLOAD =~ /([^:']+$)/); @@ -720,27 +720,28 @@ See C<perldoc perlsub> for details. sub mk_accessors { my $self = shift; my $is_hash = UNIVERSAL::isa( $_[0], 'HASH' ); - + $self->___error( "Allow handlers are not supported for '". __PACKAGE__ ."' objects" ) if $is_hash; - + return $self->SUPER::mk_accessors( @_ ); - } - + } + sub register_callback { my $self = shift; $self->___error( "Callbacks are not supported for '". __PACKAGE__ ."' objects" ); return; - } -} + } +} ### standard tie class for bound attributes { package Object::Accessor::TIE; use Tie::Scalar; + use Data::Dumper; use base 'Tie::StdScalar'; my %local = (); @@ -751,18 +752,18 @@ See C<perldoc perlsub> for details. my $ref = undef; my $obj = bless \$ref, $class; - ### store the restore sub + ### store the restore sub $local{ $obj } = $sub; return $obj; } - + sub DESTROY { my $tied = shift; my $sub = delete $local{ $tied }; ### run the restore sub to set the old value back - return $sub->(); - } + return $sub->(); + } } =back @@ -771,7 +772,7 @@ See C<perldoc perlsub> for details. =head2 $Object::Accessor::FATAL -Set this variable to true to make all attempted access to non-existent +Set this variable to true to make all attempted access to non-existant accessors be fatal. This defaults to C<false>. @@ -792,11 +793,11 @@ release should make it possible to have read-only accessors as well. If you use codereferences for your allow handlers, you will not be able to freeze the data structures using C<Storable>. -Due to a bug in storable (until at least version 2.15), C<qr//> compiled -regexes also don't de-serialize properly. Although this bug has been +Due to a bug in storable (until at least version 2.15), C<qr//> compiled +regexes also don't de-serialize properly. Although this bug has been reported, you should be aware of this issue when serializing your objects. -You can track the bug here: +You can track the bug here: http://rt.cpan.org/Ticket/Display.html?id=1827 @@ -810,7 +811,7 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/00_Object-Accessor.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/00_Object-Accessor.t index bc207c24e3b..e0f2f13b628 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/00_Object-Accessor.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/00_Object-Accessor.t @@ -23,7 +23,7 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; isa_ok( $Object, $Class ); } -### check non existent accessor +### check non existant accessor { my $warning; local $SIG{__WARN__} = sub { $warning .= "@_" }; diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t index 29823e962e0..8ebe7f1343f 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/01_Object-Accessor-Subclassed.t @@ -14,7 +14,7 @@ use_ok($Class); ### establish another package that subclasses our own { package My::Class; use base 'Object::Accessor'; -} +} my $Object = $MyClass->new; @@ -22,24 +22,24 @@ my $Object = $MyClass->new; { ok( $Object, "Object created" ); isa_ok( $Object, $MyClass ); isa_ok( $Object, $Class ); -} +} -### create an accessor +### create an accessor { ok( $Object->mk_accessors( $Acc ), "Accessor '$Acc' created" ); ok( $Object->can( $Acc ), " Object can '$Acc'" ); ok( $Object->$Acc(1), " Objects '$Acc' set" ); ok( $Object->$Acc(), " Objects '$Acc' retrieved" ); -} - +} + ### check if we do the right thing when we call an accessor that's -### not a defined function in the base class, and not an accessors +### not a defined function in the base class, and not an accessors ### in the object either { my $sub = eval { $MyClass->can( $$ ); }; ok( !$sub, "No sub from non-existing function" ); ok( !$@, " Code handled it gracefully" ); -} +} ### check if a method called on a class, that's not actually there ### doesn't get confused as an object call; @@ -48,4 +48,4 @@ my $Object = $MyClass->new; ok( $@, "Calling '$$' on '$MyClass' dies" ); like( $@, qr/from somewhere else/, " Dies with an informative message" ); -} +} diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/02_Object-Accessor-allow.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/02_Object-Accessor-allow.t index 53ddf62690c..396ef2b6f02 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/02_Object-Accessor-allow.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/02_Object-Accessor-allow.t @@ -44,15 +44,15 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; { ### bad { my $warning; local $SIG{__WARN__} = sub { $warning .= "@_" }; - + ok( !$Object->$Acc( $0 ), "'$Acc' NOT set to '$0'" ); is( $Object->$Acc(), undef, " '$Acc' still holds '<undef>'" ); like( $warning, $Err_re, " Warnings logged" ); - + ### reset warnings; undef $warning; - - + + my $ok = $Object->mk_verify; ok( !$ok, " Internal verify fails" ); like( $warning, $Ver_re, " Warning logged" ); @@ -63,14 +63,14 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; ### good { my $warning; local $SIG{__WARN__} = sub { $warning .= "@_" }; - + ok( $Object->$Acc( $$ ), "'$Acc' set to '$$'" ); is( $Object->$Acc(), $$, " '$Acc' still holds '$$'" ); ok(!$warning, " No warnings logged" ); ### reset warnings; undef $warning; - + my $ok = $Object->mk_verify; ok( $ok, " Internal verify succeeds" ); ok( !$warning, " No warnings" ); diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/03_Object-Accessor-local.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/03_Object-Accessor-local.t index 1a9b070ef6b..f085683c3a5 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/03_Object-Accessor-local.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/03_Object-Accessor-local.t @@ -40,11 +40,11 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; $Object->$Acc( $$ ); is( $Object->$Acc, $$, " Value set to $$" ); - + ### set it to a scope { $Object->$Acc( $0 => \my $temp ); is( $Object->$Acc, $0, " Value set to $0" ); } - + is( $Object->$Acc, $$, " Value restored to $$" ); -} +} diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t index 6eb45b3cb27..092c74169a7 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/04_Object-Accessor-lvalue.t @@ -6,10 +6,10 @@ use Data::Dumper; BEGIN { require Test::More; - Test::More->import( + Test::More->import( # silly bbedit [ - $] >= 5.008 - ? 'no_plan' + $] >= 5.008 + ? 'no_plan' : ( skip_all => "Lvalue objects require perl >= 5.8" ) ); } @@ -37,7 +37,7 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; ### create an accessor; { ok( $Object->mk_accessors( $Acc ), "Accessor '$Acc' created" ); - + eval { $Object->$Acc = $$ }; ok( !$@, "lvalue assign successful $@" ); ok( $Object->$Acc, "Accessor '$Acc' set" ); @@ -60,8 +60,8 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; " Got warning about allow handlers" ); } - ok( eval{ $clone->$acc = $$ }, - " Allow handler ignored" ); + ok( eval{ $clone->$acc = $$ }, + " Allow handler ignored" ); ok( ! $@, " No error occurred" ); is( $clone->$acc, $$, " Setting '$acc' worked" ); } @@ -69,7 +69,7 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; ### test registering callbacks { my $clone = $Object->mk_clone; ok( $clone, "Cloned the lvalue object" ); - + { my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; ok( ! $clone->register_callback( sub { } ), @@ -77,6 +77,6 @@ $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV; like( $warnings, qr/not supported/, " Got warning about callbacks" ); - } + } } diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/05_Object-Accessor-callback.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/05_Object-Accessor-callback.t index a2bbb170b02..5411bbdd0dc 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/05_Object-Accessor-callback.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/05_Object-Accessor-callback.t @@ -26,18 +26,18 @@ my $Sub = sub { my $obj = shift; my $meth = shift; my $val = shift; - + $Called++; - + ok( 1, " In callback now" ); ok( $obj, " Object received" ); isa_ok( $obj, $Class, " Object"); is( $meth, $Acc, " Method is '$Acc'" ); isa_ok( $val, "ARRAY", " Value" ); - scalar @$val + scalar @$val ? is( $val->[0], $SetVal, " Attempted to set $SetVal" ) - : ok( ! scalar @$val, + : ok( ! exists $val->[0], " This was a GET request" ); return $RetVal; @@ -57,30 +57,30 @@ my $Sub = sub { my $clone = $Object->mk_clone; ok( $clone, "Object cloned" ); - + my $val = $clone->___get($Acc); is( $val, undef, " Direct get returns <undef>" ); ok( $clone->___set( $Acc => $SetVal ), " Direct set is able to set the value" ); is( $clone->___get( $Acc ), $SetVal, " Direct get returns $SetVal" ); - ok( !$Called, " Callbacks didn't get called" ); + ok( !$Called, " Callbacks didn't get called" ); } ### test callbacks on regular objects ### XXX callbacks DO NOT work on lvalue objects. This is verified ### in the lvalue test file, so we dont test here { #diag("Running GET tests on regular objects"); - + my $clone = $Object->mk_clone; $Called = 0; is( $clone->$Acc, $RetVal, " Method '$Acc' returns '$RetVal' " ); is( $clone->___get($Acc), undef, - " Direct get returns <undef>" ); + " Direct get returns <undef>" ); ok( $Called, " Callback called" ); - + #diag("Running SET tests on regular objects"); $Called = 0; ok( $clone->$Acc($SetVal), " Setting $Acc" ); diff --git a/gnu/usr.bin/perl/cpan/Object-Accessor/t/06_Object-Accessor-alias.t b/gnu/usr.bin/perl/cpan/Object-Accessor/t/06_Object-Accessor-alias.t index f302a09523d..2a8aa81f0d3 100755 --- a/gnu/usr.bin/perl/cpan/Object-Accessor/t/06_Object-Accessor-alias.t +++ b/gnu/usr.bin/perl/cpan/Object-Accessor/t/06_Object-Accessor-alias.t @@ -9,48 +9,25 @@ my $Class = 'Object::Accessor'; use_ok($Class); -my $Object = $Class->new; -my $Acc = 'foo'; -my $Alias = 'bar'; - -ok( $Object, "Object created" ); -isa_ok( $Object, $Class, " Object" ); - -### add an accessor -{ my $rv = $Object->mk_accessors( $Acc ); - ok( $rv, "Created accessor '$Acc'" ); - ok( $Object->$Acc( $$ )," Set value" ); - is( $Object->$Acc, $$, " Retrieved value" ); -} - -### add an alias -{ my $rv = $Object->mk_aliases( $Alias => $Acc ); - ok( $rv, "Created alias '$Alias'" ); - ok( $Object->can( $Alias ), - " Alias '$Alias' exists" ); - is( $Object->$Alias, $Object->$Acc, - " Alias & original return the same value" ); - - ok( $Object->$Alias( $$.$$ ), - " Changed value using alias" ); - is( $Object->$Alias, $Object->$Acc, - " Alias & original return the same value" ); -} - -### test if cloning works -{ my $clone = $Object->mk_clone; - ok( $clone, "Cloned object" ); - - is_deeply( [sort $clone->ls_accessors], [sort $Object->ls_accessors], - " All accessors cloned" ); - - ok( $clone->$Acc( $$ ), " Set value" ); - is( $clone->$Alias, $clone->$Acc, - " Alias & original return the same value" ); - - ok( $clone->$Alias( $$.$$ ), - " Changed value using alias" ); - is( $clone->$Alias, $clone->$Acc, - " Alias & original return the same value" ); +my $Object = $Class->new; +my $Acc = 'foo'; +my $Alias = 'bar'; + +### basic sanity test +{ ok( $Object, "Object created" ); + + ok( $Object->mk_accessors( $Acc ), + " Accessor ->$Acc created" ); + ok( $Object->$Acc( $$ ), " ->$Acc set to $$" ); } +### alias tests +{ ok( $Object->mk_aliases( $Alias => $Acc ), + "Alias ->$Alias => ->$Acc" ); + ok( $Object->$Alias, " ->$Alias returns value" ); + is( $Object->$Acc, $Object->$Alias, + " ->$Alias eq ->$Acc" ); + ok( $Object->$Alias( $0 ), " Set value via alias ->$Alias" ); + is( $Object->$Acc, $Object->$Alias, + " ->$Alias eq ->$Acc" ); +} diff --git a/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/Changes b/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/Changes index 90f11dbfe29..0ba34c5c237 100644 --- a/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/Changes +++ b/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/Changes @@ -1,42 +1,5 @@ Changes for Perl programming language extension Parse-CPAN-Meta -1.4404 Sun Apr 05 2012 - - Protected tests from user PERL_YAML/JSON_BACKEND - -1.4403 Sun Apr 01 2012 - - Bumped prereqs: JSON::PP to 2.27200 and CPAN::Meta::YAML to 0.008 - -1.4402 Tue Feb 07 2012 - - Minor maintenance: standardized newlines to Unix style - -1.4401 Fri Feb 04 2011 - - Removed Module::Load::Conditional dependency - -1.4400 Fri Feb 04 2011 - - Added 'json_backend' and 'yaml_backend' methods to provide - the names of modules used for deserialization - -1.4200 Mon Jan 24 2011 - - No changes from 1.41_04 - -1.41_04 Mon Jan 3 2011 - - Support PERL_JSON_BACKEND environment (defaulting to JSON::PP) - - Support PERL_YAML_BACKEND environment (defaulting to CPAN::Meta:YAML) - - Update Makefile.PL to install to sitelib on Perl 5.12+ - -1.41_03 Fri Dec 17 2010 - - Throw exception when CPAN::Meta::YAML has a parse error - (RT#47608) - -1.41_02 Fri Dec 17 2010 - - Convert to using CPAN::Meta::YAML instead of YAML::Tiny - -1.41_01 Fri Dec 10 2010 - - add support for JSON metafiles and load_* methods (RJBS) - - Move binary file unpacking to test file from Makefile.PL so tests - will pass in the Perl core using a generated Makefile.PL - - Move bundled uupacktool.pl to t/bin/ - 1.40 Sat 25 Jul 2009 - Add core perl 5.10.1's uupacktool.pl - Repackage t/data/utf_16_le_bom.yml as ASCII for https://rt.cpan.org/Ticket/Display.html?id=47844 diff --git a/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/t/01_compile.t b/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/t/01_compile.t index 43563054879..7e64db79179 100755 --- a/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/t/01_compile.t +++ b/gnu/usr.bin/perl/cpan/Parse-CPAN-Meta/t/01_compile.t @@ -1,7 +1,6 @@ #!/usr/bin/perl -delete $ENV{PERL_YAML_BACKEND}; -delete $ENV{PERL_JSON_BACKEND}; +# Load testing for YAML::Tiny BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/pod2latex.t b/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/pod2latex.t index 7a003d9370a..965c9ccaff3 100755 --- a/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/pod2latex.t +++ b/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/pod2latex.t @@ -8,22 +8,24 @@ # will probably not match what is currently there. You # will need to adjust it to match (assuming it is correct). -use Test::More tests => 177; +use Test; use strict; +BEGIN { plan tests => 177 } + +use Pod::LaTeX; + # The link parsing changed between v0.22 and v0.30 of Pod::ParseUtils use Pod::ParseUtils; my $linkver = $Pod::ParseUtils::VERSION; -BEGIN { - use_ok( "Pod::LaTeX" ); -} - # Set up an END block to remove the test output file END { unlink "test.tex"; }; +ok(1); + # First thing to do is to read the expected output from # the DATA filehandle and store it in a scalar. # Do this until we read an =pod @@ -35,7 +37,7 @@ while (my $line = <DATA>) { # Create a new parser my $parser = Pod::LaTeX->new; -isa_ok($parser, "Pod::LaTeX"); +ok($parser); $parser->Head1Level(1); # Add the preamble but remember not to compare the timestamps $parser->AddPreamble(1); @@ -57,7 +59,7 @@ close(OUTFH) or die "Error closing OUTFH test.tex: $!\n"; open(INFH, "< test.tex") or die "Unable to read test tex file: $!\n"; my @output = <INFH>; -is(scalar @output, scalar @reference, "Count lines"); +ok(@output, @reference); for my $i (0..$#reference) { next if $reference[$i] =~ /^%%/; # skip timestamp comments @@ -69,7 +71,7 @@ for my $i (0..$#reference) { $reference[$i] =~ s/Standard link: \\emph\{Pod::LaTeX\}/Standard link: the \\emph\{Pod::LaTeX\} manpage/; $reference[$i] =~ s/\\textsf\{sec\} in \\emph\{Pod::LaTeX\}/the section on \\textsf\{sec\} in the \\emph\{Pod::LaTeX\} manpage/; } - is($output[$i], $reference[$i], "Check line $i"); + ok($output[$i], $reference[$i]); } close(INFH) or die "Error closing INFH test.tex: $!\n"; diff --git a/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/user.t b/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/user.t index bd8c21100a0..04776de5ace 100755 --- a/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/user.t +++ b/gnu/usr.bin/perl/cpan/Pod-LaTeX/t/user.t @@ -6,12 +6,12 @@ # Variant provided by # Adriano Rodrigues Ferreira <ferreira@triang.com.br> -use Test::More tests => 17; +use Test; use strict; -BEGIN { - use_ok( "Pod::LaTeX" ); -} +BEGIN { plan tests => 17 } + +use Pod::LaTeX; # The link parsing changed between v0.22 and v0.30 of Pod::ParseUtils use Pod::ParseUtils; @@ -22,6 +22,8 @@ END { unlink "test.tex"; }; +ok(1); + # First thing to do is to read the expected output from # the DATA filehandle and store it in a scalar. # Do this until we read an =pod @@ -50,7 +52,7 @@ my %params = ( ); my $parser = Pod::LaTeX->new(%params); -isa_ok($parser, "Pod::LaTeX"); +ok($parser); # Create an output file open(OUTFH, "> test.tex" ) or die "Unable to open test tex file: $!\n"; @@ -65,11 +67,11 @@ close(OUTFH) or die "Error closing OUTFH test.tex: $!\n"; open(INFH, "< test.tex") or die "Unable to read test tex file: $!\n"; my @output = <INFH>; -is(scalar @output, scalar @reference, "Count lines"); +ok(@output, @reference); for my $i (0..$#reference) { next if $reference[$i] =~ /^%%/; # skip timestamp comments - is($output[$i], $reference[$i], "Compare line $i"); + ok($output[$i], $reference[$i]); } close(INFH) or die "Error closing INFH test.tex: $!\n"; diff --git a/gnu/usr.bin/perl/cpan/Pod-Simple/ChangeLog b/gnu/usr.bin/perl/cpan/Pod-Simple/ChangeLog index 73583f63e15..fa17d2c578d 100644 --- a/gnu/usr.bin/perl/cpan/Pod-Simple/ChangeLog +++ b/gnu/usr.bin/perl/cpan/Pod-Simple/ChangeLog @@ -1,314 +1,6 @@ # ChangeLog for Pod::Simple dist #--------------------------------------------------------------------------- -2013-05-04 David E. Wheeler <david@justatheory.org> - * Release 3.28 - - Removed use of 'done_testing' in t/white.t, which was added in - v3.27. Thanks to Paul Howarth for the catch. - - Fixed inproperly calculated number of skipped tests in t/xhtml01.t - when HTML::Entities is not intalled. - -2013-05-03 David E. Wheeler <david@justatheory.org> - * Release 3.27 - - Added new warnings as defined by Pod::Checker, thanks to RJBS: - + "=over" without "=back" - + "L<>" starts or ends with whitespace - + raw "|" or "/" in "L<text|link>" text - - Added ->keep_encoding_directive, which is false by default, to - prevent formatters from emitting a document's '=encoding' - directive in most cases. That they emitted the encoding was a bug - introduced in v3.26 (RT #84093). Now, only the DumpAsText and - DumpAsXML formats set it to true. Patch from Patrice Dumas. - -2013-02-27 David E. Wheeler <david@justatheory.org> - * Release 3.26 - - Fixed another test script to skip all tests when Encode is not - installed. - - Added 'encoding()' and 'detected_encoding()' to return the current - encoding and the encoding actually to decode the input file. The - value from "=encoding" is also now kept in the output tree. Patch - from Patrice Dumas (RT #74390). - -2013-02-16 David E. Wheeler <david@justatheory.org> - * Release 3.25 - - Improved the warning when "=item" types mismatch within one - "=over"/"=back" block. - -2013-02-14 David E. Wheeler <david@justatheory.org> - * Release 3.24 - - Fixed corner case bug for unlikely scenario in which non-UTF-8 - text could be parsed as UTF-8. Grant McLean. - - XHTML IDs can no longer end with punctuation. Thanks to Smylers - for the patch. - - Fixed test failure on Perl 5.6.2. - - Changed the default installation location from "perl" to "site" on - 5.12 and higher, since as of that version of Perl, dual-life - modules no longer need to be installed in "perl" to replace - in-core versions. Patch from tzccinct. - - Fixed hash order dependency test failures on Perl 5.17. Thanks to - Yves Orton for the patch. - - Inlined the code that tries to guess a Pod file's encoding. This - reduces the time Pod::Simple takes to build the core Perl - documentation by 15-20%. Thanks to Dagfinn Ilmari MannsÃ¥ker for - the patch! - - Added a warning when "=item" types mismatch within one - "=over"/"=back" block. Marc Green/Google Summer of Code, with - assist from RJBS. - - Fixed regression introduced in 3.22 in which "C< >" tags were - incorrectly treated as verbatim text in table of contents items - emitted by Pod::Simple::XHTML. Thanks to Randy Stauner for the - report and to Thomas Sibley for the fix! - - Loosened up the matching of "L< >" tags for man pages so that they - allow names with dots, underscores, and any other chararacters - other than "/", just so long as they end in '[(][-a-zA-Z0-9]+[)]'. - Thanks to Dave Rolsky and Kevin Ryde for the reports (RT #82975 & - RT #82972). - - Fixed inverted mapping of "keyboard" to "kbd" in - Pod::Simple::HTML. Thanks to Robert Boisvert for the bug report - (RT #79201). - - Added two new Tagmap entries to Pod::Simple::HTML: "preformat" - maps to "pre", and "teletype" maps to "tt". Suggested by Robert - Boisvert (RT #79201). - - "X< >" tags are now ignored by the pull parser when it searches - for titles, as is any trailing whitespace. Thanks to Patrice Dumas - for the report (RT #74389). - -2012-08-14 David E. Wheeler <david@justatheory.org> - * Release 3.23 - - Eliminated nested elements in table of contents (index) items - output of Pod::Simple::XHTML. This was especially problematic for - headers that included links, as the TOC then got nested anchor - elements, which simply would not work. Thanks to Ben Bullock for - the report and test case (RT #77686). - - Fixed semantically invalid nested XHTML generated by - Pod::Simple::XHTML since v3.21. Gisle Aas. - - Improved support for nested "C< >" tags in Pod::Simple::XHTML. - Gisle Aas. - - No longer tries to decode a string with the "utf8" flag set, as - the double-decoding only triggered an error. Grant McLean. - - Added documentation note that the API expects encoded text - (octets). Grant McLean. - - Added "parse_characters()" option to specify that strings to are - already decoded from octets into characters. Grant McLean. - -2012-05-27 David E. Wheeler <david@justatheory.org> - * Release 3.22 - - Fix but where Pod::Simple would whine about non-ASCII bytes in - code or comments. Now only does so for Pod (in the absence of an - "=encoding" tag. Broken in 3.21. Grant McLean. - -2012-05-23 David E. Wheeler <david@justatheory.org> - * Release 3.21 - - NOTE: COMPATABILITY CHANGE: The 'codes_in_verbatim' option in - Pod::Simple::XHTML is no longer enabled by default. This brings it - agreement with the other formatting classes, and eliminates - unexpected behavior in XHTML-formatted Pod. Users who depended on - this functionality can still get it by enabling - 'codes_in_verbatim' in their code. - - Fixed some typos in the documentation. Thanks to Jonathan Yu via - the Debian packagers via Florian Ragwitz (RT #75532). - - Now emit a warning the first time a non-ASCII byte is encountered - when no "=encoding" has been seen. Grant McLean. - - When a non-ASCII byte is encounted before an "=encoding" line has - been seen, a heuristic (as described in perlpodspec) is applied to - select UTF-8 encoding if the non-ASCII bytes form a valid UTF-8 - byte sequence, or Latin-1 otherwise. Grant McLean. - - Added 'handle_code' method to Pod::Simple::XHTML. This allows - subclasses to override the handling of verbatim blocks, and makes - for a more cohesive interface, to boot. Gisle Aas. - - Subsequent text segments are now joined together and passed as a - single unit to text handling code. This makes it easier for custom - handlers to process complete blocks of text in a single call to - 'handle_text', rather than in dribs and drabs. Gisle Aas. - - Replaced naive text wrapping code in Pod::Simple::DumpAsXML with - Text::Wrap, which was already used for similar purposes elsewhere - in Pod::Simple. Gisle Aas. - -2012-03-01 David E. Wheeler <david@justatheory.org> - * Release 3.20 - - Removed use of 'done_testing' in t/xhtml15.t, which was added in - v3.19. Thanks to Paul Howarth for the catch. - - Fixed quoting of links in a regular expression Pod::Simple::Text. - Reported by Father Chrysostomos. - - Fix test failure on case-insensitive, non-case-preserving file systems - (VMS I'm looking at *you*). Patch from Craig A. Berry. - - Pod::Simple::HTML no longer emits "href='#___top'" if a TOC - (index) is not output. Patch from Rick Myers. - - Fixed links in the TOC of XHTML output to use IDs derived from encoded - text, rather than raw Pod, so that it will link to the ID actually - generated for the section. Thanks to Randy Stauner for the report - (with test case!) (RT #72544). - - PullParser now throws an exception on an attempt to set a source - more than once. Necessary because data from the previous source - will be cached, so the new source would be ignored anyway. Create a - new PullParser, instead. Thanks to Paul Boldra for the report (RT - #74265). - -2011-08-23 David E. Wheeler <david@justatheory.org> - * Release 3.19 - - Fixed occasional test failure when tests are run in parallel - (HARNESS_OPTIONS=j6:c). Thanks to Alexei Znamensky for the report and - Marc Green for the fix. - - Added "pod_handler" option. This is a callback that can be used to - inspect the content on a "=pod" line. Marc Green/Google Summer of - Code. - - Added tests for proper line-ending parsing from the previous - release. The tests were in the repository, but didn't make it into - the MANIFEST or, therefore, the release. Reported by Marc Green. - - Added the "parse_empty_lists" option. When enabled, Pod::Simple - will recognize empty lists (that is, a blocks with '=over' and - '=back' but nothing in between). Disabled by default. Marc - Green/Google Summer of Code. - - Added the "whiteline_handler" attribute. It's much like - "code_handler", "cut_handler", and "pod_handler", except it's - triggered on lines that contain only whitespace characters. Marc - Green/Google Summer of Code. - - Added "raw" attribute to L<> treelet that contains the L<>'s raw - contents. Marc Green/Google Summer of Code. - - Pod directives autoclosed by Pod::Simple are now denoted as such - by the new "fake_closer" attribue. Marc Green/Google Summer of - Code. - - Fixed incompatibility with Pod::Simple::HTMLBatch in - Pod::Simple::XHTML. Patch by Eric Johnson. - -2011-07-16 David E. Wheeler <david@justatheory.org> - * Release 3.18 - - Pod::Simple now properly parses Pod files using Mac OS Classic line- - endings (\r). Marc Green/Google Summer of Code. - - Fixed test failure in 't/search50.t when the test finds a .pod but - the module is in a .pm. Thanks to the cpan-testers who reported - this when the test searched for Capture::Tiny. - -2011-07-09 David E. Wheeler <david@justatheory.org> - * Release 3.17 - - Documented tertiary methods. Patch from Shawn H Corey. - - Added "backlink" option to Pod::Simple::XHTML. Thanks to Marc - Green/Google Summer of Code for the pull request. - - Typos fixed in Pod::Simple::HTMLBatch. Reported by Shawn H Corey. - - Fixed quoting of value returned by a "strip_verbatim_indent()" - code reference so that regex meta characters are properly escaped. - - Added "anchor_items" option to Pod::Simple::XHMTL. This allows - text items (which are output as <dt> elements) to have IDs that - can be referenced in the "#" part of a URL. Marc Green/Google - Summer of Code. - - Added "recurse" option to Pod::Simple::Search. It's enabled by - default; disable it to turn off recursion into subdirectories. - Marc Green/Google Summer of Code. - - Added documentation to clarify the behavior of the "content_seen" - method. Thanks to Olaf Alders for the pull request. - -2011-03-14 David E. Wheeler <david@justatheory.org> - * Release 3.16 - - Fixed invalid HTML generated for nested lists by Pod::Simple::XHTML - (Fitz Elliott). - - Replaced the invalid "<nobr>" tag -- created for "S<>" -- with - '<span style="white-space: nowrap;">' (Fitz Elliott). - - Fixed some nerbles in our own Pod (Michael Stevens) - - Improved the "Minimal code" example in Pod::Simple::HTML. The key - is to use pase_file(), not parse_from_file() (which should - otherwise be undocumented, and is just there for Pod::Parser - compatibility. Thanks to prodding from Ævar Arnfjörð Bjarmason (RT - #65428). - - Added the html_charset() and html_encode_chars() attributes to - Pod::Simple::XHTML. Inspired by a bug report from Agent Zhang - (ç« äº¦æ˜¥) (RT #29587). - - Added "Minimal code" example to the Pod::Simple::XHTML documentation. - - Fixed mispelling of the "=encoding" markup in the parser (it was - spelled "=encode"). Thanks to "TTY" for the patch. (RT #24820). - -2010-11-11 David E. Wheeler <david@justatheory.org> - * Release 3.15 - - Removed "perlpod.pod" and "perlpodspec.pod". These now just live - in the Perl core. - - Fixed stylesheet names output by HTMLBatch to match the names of - the actual stylesheet files (broken in 3.09). Thanks to Kevin Ryde - for the report (RT #56725). - - Added missing closing slash to the CSS links in the XHTML output. - Thanks to HarleyPig for the patch! - - Added parens around bar "qw(...)" in t/xhtml05.t. Thanks to Jerry - D. Hedden for the patch. - - Improved the Pod::Simple::HTML docs. Thanks to Gabor Szabo for the - patch. - - Pod::Simple::XHTML now properly encodes entities in URLs in the - anchor tag. Thanks to John McNamara for the report (RT-60249). - - Pod::Simple::HTML and XHTML now strip whitespace from the end of - section names that appear as anchor names for headers (in HTML) - and IDs (in XHTML). Such whitespace appeared when "X<>" entities - were stripped out but not the space between them (RT-56572). - - Make test "t/search50.t" always pass on case-insensitive file - systems rather than just skip VMS. - 2009-04-27 * Release 3.14 @@ -367,7 +59,7 @@ Fixed the output of entities in L<> tags by Pod::Simple::XHTML. Fixed the output of POD links from Pod::Simple::XHTML so that the - section part (/foo) is turned into a proper fragment identifier (#foo) + section part (/foo) is turned into a proper fragment identfier (#foo) in the resulting search.cpan.org link. Pod::Simple::Text now outputs URLs for links created in the @@ -542,6 +234,7 @@ Just fixing some typos in the CSS generated by Pod::Simple:HTMLBatch. + 2004-05-24 Sean M. Burke <sburke@cpan.org> * Release 3.01 diff --git a/gnu/usr.bin/perl/cpan/Pod-Simple/README b/gnu/usr.bin/perl/cpan/Pod-Simple/README index 1ff257fd613..9ab762b0487 100644 --- a/gnu/usr.bin/perl/cpan/Pod-Simple/README +++ b/gnu/usr.bin/perl/cpan/Pod-Simple/README @@ -1,4 +1,4 @@ -=head1 Pod::Simple version 3.28 +=head1 Pod::Simple version 3.14 Pod::Simple is a Perl library for parsing text in the Pod ("plain old documentation") markup language that is typically used for writing @@ -24,7 +24,7 @@ pod-people@perl.org mail list. Send an empty email to pod-people-subscribe@perl.org to subscribe. This module is managed in an open GitHub repository, -L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or +L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or to clone L<git://github.com/theory/pod-simple.git> and send patches! Patches against Pod::Simple are welcome. Please send bug reports to diff --git a/gnu/usr.bin/perl/cpan/Sys-Syslog/Changes b/gnu/usr.bin/perl/cpan/Sys-Syslog/Changes index a30b4908bdf..2f6653baa83 100644 --- a/gnu/usr.bin/perl/cpan/Sys-Syslog/Changes +++ b/gnu/usr.bin/perl/cpan/Sys-Syslog/Changes @@ -1,71 +1,5 @@ Revision history for Sys-Syslog -0.32 -- 2012.09.14 -- Sebastien Aperghis-Tramoni (SAPER) - [BUGFIX] CPAN-RT#69040: Don't modify @_ in syslog(). - [BUGFIX] Restore compatibility with Perl 5.6.0. - [DOC] Perl-RT#81858: Fix some spelling errors (Peter J. Acklam). - -0.31 -- 2012.08.18 -- Sebastien Aperghis-Tramoni (SAPER) - [BUGFIX] Level 'emerg' could not be used since v0.29. - [BUGFIX] Setting a message facility with syslog() was broken since v0.29 - (Noel Butler). - [BUGFIX] CPAN-RT#69992: Make setlogsock() only use the requested mechanism, - restoring way it worked in v0.27 and before (Niko Tyni). - [BUGFIX] CPAN-RT#69986: setlogsock() doesn't return undef on failure - (Niko Tyni). - [BUGFIX] CPAN-RT#69997: Use the default UDP socket timeout on GNU/kFreeBSD - as well, and lower it to a more sensible value (Niko Tyni). - [BUGFIX] CPAN-RT#75827: syslog() logging everything regardless of log - mask when using using numeric LOG_* macros (Bryan Thale). - [TESTS] Added t/facilities-routing.t - [DOC] Don't highlight "the Rules of Sys::Syslog" from the Description. - [DIST] Add meta-information in Makefile.PL - -0.30 -- 2012.08.15 -- Sebastien Aperghis-Tramoni (SAPER) - [BUGFIX] CPAN-RT#69310: Avoid a POSIX::strftime issue on Windows - (Michael Ludwig). - [BUGFIX] CPAN-RT#77577: Build on Haiku-OS (Tony Cook). - [BUGFIX] CPAN-RT#77578: Silence a compilation warning (Tony Cook). - [BUGFIX] CPAN-RT#78044: Don't call getservbyname() when the port is - specified (Chan Wilson). - [TESTS] t/syslog.t no longer needs to chdir under PERL_CORE. - -0.29 -- 2011.04.18 -- Sebastien Aperghis-Tramoni (SAPER) #PerlQA2011 - [BUGFIX] CPAN-RT#55215: Sys::Syslog might call exit which triggers - DESTROY (Alexander Berger). - [BUGFIX] CPAN-RT#55151: Allow temporary facility with native mechanism - (Tim Jenkins). - [BUGFIX] CPAN-RT#50928: Convert Win32 files to Unix EOLs (Steve Hay). - [BUGFIX] CPAN-RT#50534: Unwanted space at the end of syslog message - (Eugene V. Lyubimkin). - [BUGFIX] CPAN-RT#49877: Options not reset after closelog() (Herbert Brezina). - [BUGFIX] CPAN-RT#48386: Add Win32::EventLog as a prerequisite (kmx and - Laurent Dami). - [FEATURE] CPAN-RT#50534: Added options noeol and nonul. - [DIST] Set INSTALLDIRS to "site" when installed on Perl 5.11+ - -0.28 -- 2011.04.16 -- Sebastien Aperghis-Tramoni (SAPER) #PerlQA2011 - [BUGFIX] CPAN-RT#56084: Reset connection tracking vars (Vladimir Marek). - [BUGFIX] CPAN-RT#56826: Avoid memory corruption when closelog() is - called twice (Andreas Jaekel). - [BUGFIX] CPAN-RT#64287: Make strftime() Windows-compatible (Dave Stafford). - [FEATURE] New API for setlogsock(), in order to allow the setting - of new options. Thanks to Jake Scott for the idea. - [CODE] Modify can_load() so it can print the warnings if desired. - [CODE] CPAN-RT#44410: Provide fallback macros in Syslog.xs in - order to compile on Novell Netware. - [TESTS] In blead, the distribution was moved from ext/Sys/Syslog - to ext/Sys-Syslog. t/constants.t had to be fixed (Vincent Pit). - [TESTS] CPAN-RT#53317: In core, Sys-Syslog was moved to cpan/, thus - making t/constants.t unable to find macros.all (David Mitchell). - [TESTS] CPAN-RT#64716: Skip t/data-validation.t if the available - version of POE::Component::Server::Syslog is too old. - [DIST] Bleadperl no longer require an empty MAN3PODS (Nicholas Clark). - [DIST] Removed unneeded modules in Makefile.PL (Nicholas Clark). - [DOC] Recreated Sys::Syslog history from the unified git repository. - [DOC] Added a section to list the matching Perl and Sys::Syslog version. - [DOC] CPAN-RT#49859: Removed a dead link (Leon Brocard). - 0.27 -- 2008.09.21 -- Sebastien Aperghis-Tramoni (SAPER) [BUGFIX] Fixed compilation on Win32, thanks to Serguei Trouchelle. Also added stubs so calling the XS functions will never fail. @@ -142,7 +76,7 @@ Revision history for Sys-Syslog [FEATURE] Each non-standard macro now fall backs to a standard macro. [CODE] Merged changes from Jerry D. Hedden to use ppport.h only when not built from core distribution (blead@30657). - [TESTS] t/syslog.t now generates a more detailed TAP output. + [TESTS] t/syslog.t now generates a more detailled TAP output. [TESTS] Merged change blead@29176: suppress taint mode from t/constants.t [TESTS] Added regression tests for CPAN-RT#21866 and #25488. [EG] Added example script eg/syslog.pl @@ -175,7 +109,7 @@ Revision history for Sys-Syslog 0.15 -- 2006.06.10 -- Sebastien Aperghis-Tramoni (SAPER) [FEATURE] CPAN-RT#17316: Added a "nofatal" option to openlog(). - [FEATURE] Sys::Syslog warnings can now be controlled by the warnings + [FEATURE] Sys::Syslog warnings can now be controled by the warnings category of the same name. [FEATURE] Added support for using the native C syslog(3) functions. [CODE] Removed most "our" variables. @@ -233,91 +167,11 @@ Revision history for Sys-Syslog [TESTS] Added t/distchk.t, t/podspell.t, t/podcover.t, t/portfs.t 0.09 -- 2005.12.06 -- Sebastien Aperghis-Tramoni (SAPER) - [BUGFIX] Escape percent signs in error message when interpolating %m - (Ronald J. Kimball). [CODE] Now setlogsock() really croak(), as documented. [DIST] CPANized from blead@26281. - [DIST] Modified Makefile.PL so that ExtUtils::Constant is conditionally + [DIST] Modified Makefile.PL so that ExtUtils::Constant is conditionaly used, with a fallback in the case it's not available. [DIST] Bumped version to 0.09 [DOC] Added support and license information. [TESTS] Rewrote and ported t/syslog.t to Test::More -0.08 -- 2005.12.03 - [FEATURES] syslog() can now accept a message without printf() escapes - and arguments (Gisle Aas ). - [DOC] Document that openlog() might die (Rafael Garcia-Suarez). - -0.07 -- 2005.06.27 - [CODE] Use XSLoader instead of DynaLoader (Alexey Tourbin). - [DOC] Shows the correct way to use syslog() (Dave Mitchell). - -0.06 -- 2004.12.14 - [FEATURE] Allow escaping %m as %%m in Sys::Syslog format strings (Rafael - Garcia-Suarez, suggested by Joshua Richardson and Yitzchak Scott-Thoennes). - [CODE] Make Sys::Syslog stricture-compliant (Rafael Garcia-Suarez). - [DOC] Document $Sys::Syslog::host (Jay Hannah). - -0.05 -- 2004.04.06 - [FEATURE] IRIX wants setlogsock("stream") (Jarkko Hietaniemi). - [FEATURE] Allow syslog() to use numeric constants in addition to strings - for facility names and priorities (Jim Schneider ). - [DOC] Remind users to always use openlog() (Jarkko Hietaniemi). - -0.04 -- 2003.08.13 - [BUGFIX] Do not use "udp" on some platforms (Slaven Rezic). - [BUGFIX] Perl-RT#18180: Fixed a problem with Sys:Syslog on Solaris 8 - with perl 5.8.0 (Joost van Baal). - [BUGFIX] Fixed some warnings (Jarkko Hietaniemi). - [BUGFIX] Better error messages (Jari Aalto). - -0.03 -- 2002.03.23 - [BUGFIX] Fixed copious warnings from Sys::Syslog (Andreas König). - [FEATURE] Failover to different communication modes by Nick Williams. - -0.02 -- 2001.06.04 - [BUGFIX] /dev/console may not be writable in Syslog.pm (Ask Bjoern Hansen). - [BUGFIX] Fixed for accidental arguments to autoloaded constants (Gurusamy Sarathy). - [BUGFIX] Make _PATH_LOG() return "" if not available (Gurusamy Sarathy). - [BUGFIX] Forked child may not exit correctly if it failed to open - /dev/console (Graham Barr). - [BUGFIX] More checking in case someone has broken their services or - protocol databases (Robert Spier). - [BUGFIX] xlate() doesn't handle LOG_EMERG (Mark J. Reed). - [CODE] Code for constant()s regenerated by Nicholas Clark. - [TESTS] Added syslog.t to check if Sys::Syslog works (Tom Hughes). - -0.01 -- 2000.02.04 -- Gurusamy Sarathy - [FEATURE] Sys::Syslog now uses XSUBs to access facilities from syslog.h - so it no longer requires syslog.ph to exist. Thanks to Tom Hughes. - As a consequence, Sys::Syslog moved from lib/ to ext/. - -perl 5.004_03 -- 1997.09.05 -- Tim Bunce - [BUGFIX] Handle missing _PATH_LOG (Ulrich Pfeifer). - -perl 5.004_02 -- 1997.08.07 -- Tim Bunce - [FEATURE] UNIX domain sockets support, by Sean Robinson and Tim Bunce. - -perl 5.004_01 -- 1997.06.11 -- Tim Bunce - [BUGFIX] Allows FQDN (even allowing "_"). - -perl 5.004 -- 1997.05.15 -- Chip Salzenberg - [BUGFIX] Fixed $whoami calulation (Marc Rouleau). - [BUGFIX] Allows hyphens in hostnames (Jerome Abela). - -perl 5.003_01 -- 1996.06.18 -- Charles Bailey - [CODE] Moved call to hostname() into connect() function, and eliminated - domain suffix. - [DOC] Correct documentation for calling sequence of syslog() function. - -perl 5.002_01 -- 1996.03.25 -- Charles Bailey - [CODE] Use Sys::Hostname::hostname() only when necessary. - -perl 5.002 -- 1996.02.29 -- Larry Wall - [CODE] Use constants from Socket.pm (Andy Dougherty). - [CODE] Connect to the name given by Sys::Hostname::hostname() instead - of "localhost" (Andy Dougherty). - [DOC] Added documentation, thanks to Hallvard B Furuseth. - -perl 5.000 -- 1994.10.17 -- Larry Wall - [DIST] Converted from lib/syslog.pl to lib/Sys/Syslog.pm diff --git a/gnu/usr.bin/perl/cpan/Sys-Syslog/README b/gnu/usr.bin/perl/cpan/Sys-Syslog/README index 203535b8266..68bf1b69e0e 100644 --- a/gnu/usr.bin/perl/cpan/Sys-Syslog/README +++ b/gnu/usr.bin/perl/cpan/Sys-Syslog/README @@ -21,9 +21,16 @@ INSTALLATION An ANSI-compliant compiler is required to compile the extension. - Sys::Syslog should work on any Perl since 5.6.0. This module is - regularly compiled and tested by the CPAN Testers on various - combinations of Perl and operating systems. + Sys::Syslog should work on any Perl since 5.6.0. This module has + been tested by the author on the following Perl and system versions + but is likely to run on many more: + + Perl Architecture GCC + ----------------------------------------------------- + 5.6.2 i686-linux 3.4.1 + 5.8.5 i386-linux-thread-multi 3.4.1 + 5.8.8 i386-freebsd-64int 3.4.4 + 5.8.6 darwin-thread-multi-2level (PowerPC) 4.0.1 See also the corresponding CPAN Testers page: http://testers.cpan.org/show/Sys-Syslog.html @@ -41,8 +48,8 @@ SUPPORT AND DOCUMENTATION Search CPAN http://search.cpan.org/dist/Sys-Syslog/ - MetaCPAN - https://metacpan.org/module/Sys::Syslog + Kobes' CPAN Search + http://cpan.uwinnipeg.ca/dist/Sys-Syslog CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Sys-Syslog @@ -56,7 +63,7 @@ SUPPORT AND DOCUMENTATION COPYRIGHT AND LICENCE - Copyright (C) 1990-2012 by Larry Wall and others. + Copyright (C) 1990-2008 by Larry Wall and others. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/cpan/Sys-Syslog/README.win32 b/gnu/usr.bin/perl/cpan/Sys-Syslog/README.win32 index cecb8dc4812..adf253ab961 100644 --- a/gnu/usr.bin/perl/cpan/Sys-Syslog/README.win32 +++ b/gnu/usr.bin/perl/cpan/Sys-Syslog/README.win32 @@ -11,7 +11,7 @@ DESCRIPTION by Sys::Syslog is PerlLog.mc, located in the win32/ subdirectory. If the message file is updated then you need to go in the win32/ - subdirectory and run the "compile.pl" command to update the relevant + subdirectory and run the "compile.pl" command to update the relevent files. Note that Sys::Syslog::Win32 is built by this process. The following files are in the win32 directory: diff --git a/gnu/usr.bin/perl/cpan/Term-ANSIColor/ChangeLog b/gnu/usr.bin/perl/cpan/Term-ANSIColor/ChangeLog index aec8803b4ea..9888ad1afbc 100644 --- a/gnu/usr.bin/perl/cpan/Term-ANSIColor/ChangeLog +++ b/gnu/usr.bin/perl/cpan/Term-ANSIColor/ChangeLog @@ -1,223 +1,3 @@ -2013-01-07 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Version 4.02 released. - - * Makefile.PL: Add the minimum Perl version to the package - metadata. - - * t/basic256.t: List the tag first in the import list for - compatibility with the Exporter from Perl 5.6.2. Thanks to David - Cantrell for the testing and debugging. - -2012-12-31 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Version 4.01 released. - - * t/strict.t: During coverage checking, skip generic tests that - don't run module code for a significant speed-up. - - * examples/generate-colors: Add POD documentation. - * t/critic.t: Also check the examples directory. - * t/pod.t: Likewise. - * t/pod-spelling.t: Likewise. - - * t/aliases-env.t: Fix logic for skipping tests when Test::Warn is - not installed. - -2012-12-30 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Version 4.00 released. - - * LICENSE: New file summarizing copyright and license information. - - * examples/generate-colors: Add support for "basic" and "bright" - test file types that test all the other supported attributes. - * tests/README: Remove VT100 test files. The license was unclear, - and the new generate-colors example script does everything they do - of significance for this package plus more. - * tests/ansicolor: Likewise. - * tests/vt100-torture: Likewise. - - * ANSIColor.pm (PUSHCOLOR): Take an array like all the other - constant functions and join all arguments together before - manipulating it. - * t/basic.t: Multiple new tests for various weird edge cases. - - * ANSIColor.pm (AUTOLOAD): Only honor ANSI_COLORS_DISABLED if it - is set to a true value. - (color): Likewise. - (colored): Likewise. - * t/basic.t: Test that ANSI_COLORS_DISABLED must be true. - - * t/synopsis.t: New test for SYNOPSIS syntax. - - * ANSIColor.pm: Add COMPATIBILITY section to the documentation, - collecting all information about when features were introduced and - adding the version of Perl that they shipped with. Add - appropriate version numbers to the use statements in the SYNOPSIS. - - * ANSIColor.pm: Use coloralias to load aliases from the - environment. Improve commenting in the SYNOPSIS. Document the - new alias name restrictions. - (coloralias): New function to set a color alias. Enforce - restrictions on the acceptable alias name. - - * t/aliases-env.t: Adjust warning test for new error message. - * t/aliases-func.t: New test of coloralias. - -2012-12-29 Stephen Thirlwall <stephen.thirlwall@strategicdata.com.au> - Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Add support for custom color names configured with - the ANSI_COLORS_ALIASES environment variable as set during module - load. - (color): Support custom colors. - (colorvalid): Likewise. - * t/aliases-env.t: New test of custom colors from the environment. - * t/basic.t: Delete ANSI_COLORS_ALIASES from the environment before - module load to avoid any effects from the test runner's settings. - * t/basic256.t: Likewise. - * t/eval.t: Likewise. - * t/stringify.t: Likewise. - * t/taint.t: Likewise. - -2012-12-28 Kurt Starsinic <kstarsinic@gmail.com> - Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Add constants (with tag :constants256) and - attributes for 256-color emulators. - (uncolor): Support the three-part 256-color codes. - * t/basic256.t: New test for 256-color support. - * examples/generate-colors: New script to generate 256-color test - or demonstration files. - -2012-12-28 Russ Allbery <rra@stanford.edu> - - * t/basic.t: Test uncolor with \e[m and '' as only arguments. - - * ANSIColor.pm: $AUTOLOCAL takes precedence over $AUTORESET, - reversing the previous behvior. Document the precedence. - * t/basic.t: Test for $AUTOLOCAL vs. $AUTORESET precedence. - - * t/taint.t: New check for proper untainting in AUTOLOAD. - * ANSIColor.pm: Comment the untainting of $AUTOLOAD so that it - isn't accidentally removed as apparently unnecessary. - - * t/strict.t: Ignore t/taint.t for coverage checking, since - Test::Strict doesn't know how to invoke tests that require - tainting. - - * t/strict.t: Add test suite coverage checking if running the test - in maintainer mode. - * ANSIColor.pm (AUTOLOAD): Drop a redundant check on the result of - eval so that 100% test coverage can be achieved. - * t/basic.t: Remove taint checking, which is incompatible with - coverage testing. Add tests to achieve 100% coverage. - * t/eval.t: Remove taint checking. - * t/stringify.t: Likewise. - - * ANSIColor.pm: Document $Term::ANSIColor::AUTOLOCAL. - - * ANSIColor.pm (AUTOLOAD): Support ANSI_COLORS_DISABLED in the - generated constant subs. Fixes a bug where the environment - variable would be ignored if the constant were used before it was - set. - * t/basic.t: Test for proper ANSI_COLORS_DISABLED support in - generated constant subs. - - * t/critic.t: New test that runs perlcritic (and perltidy) on all - source files and checks for violations. - * t/data/perlcriticrc: New file. - * t/data/perltidyrc: New file. - * ANSIColor.pm: Substantial reworking to improve coding style and - layout. Update to Perl 5.6 syntax. Unconditionally load Carp for - simplicity. - * Makefile.PL: Require Perl 5.6. Remove conditionals for - configuration that was not supported prior to Perl 5.6. - * t/basic.t: Update coding style. - * t/eval.t: Likewise. - * t/stringify.t: Likewise. - - * t/minimum-version.t: New test for the minimum required version - of Perl. - - * t/pod-coverage.t: New test for POD coverage. - - * ANSIColor.pm: Add use warnings. - * Makefile.PL: Add use strict and use warnings. - * t/strict.t: New test for strict and warnings in all code. - - * t/pod.t: Update coding style. - * t/pod-spelling.t: Use Test::Spelling instead of including a - less-tested version of the same code. Update coding style. - -2012-03-18 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Version 3.02 released. - - * ANSIColor.pm (AUTOLOAD): Only return pass-through behavior if - the function that was called was one of our constants, rather than - turning every unknown function in the Term::ANSIColor namespace - into a passthrough join function when colors are disabled. - * t/basic.t: Test proper error reporting with colors disabled. - - * ANSIColor.pm (AUTOLOAD): Preserve an existing value of $@ when - generating a constant sub and restore it afterwards. Diagnose - errors in creating the constant sub and die instead of ignoring - them. - * t/eval.t: New test for $@ preservation. - - * ANSIColor.pm: Add italic and the ITALIC constant. Document that - the support for it is rare. - * t/basic.t: Test italic and ITALIC support. - - * ANSIColor.pm: Add "mistyped" as a stopword, required by the - latest aspell on Debian. - -2011-07-20 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Version 3.01 released. - - * Makefile.PL: Change the DISTNAME to Term-ANSIColor. - - * ANSIColor.pm (colored): Only interpret an initial array - reference as a list of colors, not any initial reference, allowing - the colored function to work properly on objects with - stringification defined. Thanks, Revilo Reegiles. - * t/stringify.t: New test for proper behavior with non-array - references in colored. - -2011-03-13 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Fix two syntax errors in the SYNOPSIS. Thanks, - Jan Hartung. - -2010-10-08 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Warn in the documentation that attributes are not - supported in and will not work with Perl formats. - -2010-04-11 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Update the URL for ECMA-048 in the documentation. - -2010-01-24 Russ Allbery <rra@stanford.edu> - - * ANSIColor.pm: Version 3.00 released. - - * t/basic.t: Add some basic tests for bright color support. - - * ANSIColor.pm: Reorganize the documentation and be clearer about - the function interface parameters. Reword the explanation of - bright and regular colors, and provide some advice about which to - use. - -2010-01-24 Jakob Ilves <illvilja@gmail.com> - - * ANSIColor.pm: Add bright versions of the basic eight foreground - and background colors using the 9x and 10x codes, supported by - emulators with 16 color support. - 2009-08-30 Russ Allbery <rra@stanford.edu> * ANSIColor.pm: Version 2.02 released. diff --git a/gnu/usr.bin/perl/cpan/Term-ANSIColor/README b/gnu/usr.bin/perl/cpan/Term-ANSIColor/README index 597b54a72c2..94391c006fa 100644 --- a/gnu/usr.bin/perl/cpan/Term-ANSIColor/README +++ b/gnu/usr.bin/perl/cpan/Term-ANSIColor/README @@ -1,98 +1,74 @@ - Term::ANSIColor version 4.02 + Term::ANSIColor version 2.02 (A simple ANSI text attribute control module) - This program is free software; you may redistribute it and/or modify it - under the same terms as Perl itself. Please see the section LICENSE - below for more information. + Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2007, 2009 + Russ Allbery <rra@stanford.edu> and Zenin. This program is free + software; you may redistribute it and/or modify it under the same terms + as Perl itself. + + I welcome bug reports and patches for this package at rra@stanford.edu. + However, please be aware that I tend to be extremely busy and to get a + lot of mail. I'll save your mail and get to it as soon as I can, but + depending on how busy I am it may take me a couple of months. BLURB - Term::ANSIColor provides constants and simple functions for setting ANSI + Term::ANSIColor provides constants and simple functions for sending ANSI text attributes, most notably colors. It can be used to set the current text attributes or to apply a set of attributes to a string and reset - the current text attributes at the end of that string. Eight-color, - sixteen-color, and 256-color escape sequences are all supported. + the current text attributes at the end of that string. DESCRIPTION - This Perl module is a simple and convenient interface to the ANSI - terminal escape sequences for color (from ECMA-48, also included in ISO - 6429). The color sequences are provided in two forms, either as - constants for each color or via a function that takes the names of - colors and returns the appropriate escape codes or wraps them around the - provided text. The non-color text style codes from ANSI X3.64 (bold, - dark, underline, and reverse, for example), which were also included in - ECMA-48 and ISO 6429, are also supported. Also supported are the - extended colors used for sixteen-color and 256-color emulators. - - This module is very stable, and I've used it in a wide variety of - applications. It has been included in the core Perl distribution - starting with version 5.6.0, so you don't need to download and install - it yourself unless you have an old version of Perl or need a newer - version of the module than comes with your version of Perl. I continue - to maintain it as a separate module, and the version included in Perl is - resynced with mine before each release. - - The original module came out of a discussion in comp.lang.perl.misc and - is a combination of two approaches, one with constants by Zenin and one - with functions that I wrote. I offered to maintain a combined module - that included both approaches. + This module grew out of a thread on comp.lang.perl.misc where several of + us were throwing around different ways to print colored text from Perl + scripts and Zenin posted his old library to do that. I (Russ) disagreed + with the implementation and offered my own (the color() and colored() + functions implemented in this package), Zenin convinced me that the + constants had their place as well, and we started figuring out the best + ways of implementing both. + + While ANSI color escape codes are fairly simple, it can be hard to + remember the codes for all of the attributes and the code resulting from + hard-coding them into your script is definitely difficult to read. This + module is designed to fix those problems, as well as provide a + convenient interface to do a few things for you automatically (like + resetting attributes after the text you print out so that you don't + accidentally leave attributes set). + + Despite its name, this module can also handle non-color ANSI text + attributes (bold, underline, reverse video, and blink). It uses either + of two interfaces, one of which uses "constants" for each different + attribute and the other of which uses two subs which take strings of + attributes as arguments. See the POD documentation for complete details, features, and usage. + This module is distributed as part of the Perl core distribution as of + Perl 5.6.0. You only need to install this module if you want a newer + version than came with Perl or if you have an old version of Perl. + REQUIREMENTS Term::ANSIColor is written in pure Perl and has no module dependencies that aren't found in Perl core. It should work with any version of Perl - after 5.6, although it hasn't been tested with old versions in some + after 5.001, although it hasn't been tested with old versions in some time. - In order to actually see color, you will need to use a terminal window - that supports the ANSI escape sequences for color. Any recent version - of xterm, most xterm derivatives and replacements, and most telnet and - ssh clients for Windows and Macintosh should work, as will the MacOS X - Terminal application (although Terminal.app reportedly doesn't support - 256 colors). The console windows for Windows NT and Windows 2000 will - not work, as they do not even attempt to support ANSI X3.64. - - For a complete (to my current knowledge) compatibility list, see the - Term::ANSIColor module documentation. If you have any additions to the - table in the documentation, please send them to me. - - The test suite requires Perl and Test::More (part of Perl since 5.6.2). - It also makes use of additional Perl modules for some tests. These - tests will be skipped automatically if the modules aren't available. To - run the full set of default tests, you will need the Perl modules: - - Perl::Critic - Test::MinimumVersion - Test::Pod - Test::Pod::Coverage - Test::Strict - Test::Synopsis - Test::Warn - - and their dependencies. These modules are all available from CPAN. - - Some parts of the test suite are suppressed by default because those - tests are normally only useful for the maintainer. This includes tests - of POD spelling and Perl coding style. To enable those tests, set the - environment variable RRA_MAINTAINER_TESTS to a true value. For these - tests, the additional Perl modules: - - Devel::Cover - Test::Perl::Critic - Test::Spelling - - and their dependencies as well as a spell-checking program (several are - supported by Test::Spelling) are required. These modules are all - available from CPAN. + The test suite requires the Test::More module. To check the POD + documentation, Test::Pod is also required. To check spelling, + Pod::Spell and either aspell or ispell with the american dictionary are + also required. The user's path is searched for aspell or ispell and + aspell is preferred. Spelling tests are disabled by default since + spelling dictionaries differ too much between systems. To enable those + tests, set RRA_MAINTAINER_TESTS to a true value. INSTALLATION WARNING: Installation of this package will replace the Term::ANSIColor - that came with Perl. You may want to save a backup copy of the standard - version first. + that came with Perl for Perl 5.6.0 or later. Term::ANSIColor that came + with Perl. You may want to save a backup copy of the standard version + first. Follow the standard installation procedure for Perl modules, which is to type the following commands: @@ -106,7 +82,7 @@ INSTALLATION install the module by hand, simply copy it into a directory named Term in your Perl library directory. -SUPPORT +HOMEPAGE AND SOURCE REPOSITORY The Term::ANSIColor web page at: @@ -115,18 +91,6 @@ SUPPORT will always have the current version of this package, the current documentation, and pointers to any additional resources. - For bug tracking, this package uses the CPAN bug tracker at: - - https://rt.cpan.org/Public/Dist/Display.html?Name=Term-ANSIColor - - I welcome bug reports and patches for this package at rra@stanford.edu - or via the CPAN bug tracker. However, please be aware that I tend to be - extremely busy and work projects often take priority. I'll save your - mail and get to it as soon as I can, but it may take me a couple of - months. - -SOURCE REPOSITORY - Term::ANSIColor is maintained using Git. You can access the current source by cloning the repository at: @@ -136,9 +100,6 @@ SOURCE REPOSITORY http://git.eyrie.org/?p=perl/ansicolor.git - When contributing modifications, patches (possibly generated by - git-format-patch) are preferred to Git pull requests. - THANKS To Jon Lennox for looking at early versions of this module, providing @@ -169,9 +130,8 @@ THANKS To Daniel Lindsley for the information about what Mac OS X Terminal supports. - To Joe Smith for the original test files that exercise a wide variety of - VT100 escape sequences including the ECMA-48 color control codes. These - have been replaced by an example script, but they were very useful. + To Joe Smith for the test files that exercise a wide variety of VT100 + escape sequences including the ECMA-48 color control codes. To James Bowlin for catching a bug in colored when $EACHLINE is set that caused it to not color lines consisting solely of 0. @@ -192,59 +152,4 @@ THANKS To Paul Miller for the idea and initial implementation of colorstrip. - To Jakob Ilves for sixteen-color support and the initial documentation - of bright color issues. - - To Revilo Reegiles for reporting problems with the colored function and - non-array references with stringification defined, and providing a test - case. - - To Kent Fredric for the request for italic and the report of a terminal - emulator that supports it. - - To Simon Wistow for reporting that Term::ANSIColor was inadvertantly - clobbering $@ when generating constant subs. - - To Kurt Starsinic for the initial implementation of 256-color support. - - To Magnus Woldrich for Term::ExtendedColor and for research on which - emulators support 256 colors. - - To Stephen Thirlwall for the initial implementation of custom color - support. - - To BlueT - Matthew Lien - 練喆明 for quick testing of 4.00 and reporting - a problem with skipping one of the tests. - - To David Cantrell for testing with Perl 5.6.2 and debugging why a test - case didn't work with its version of Exporter. - To Larry Wall, as always, for Perl. - -LICENSE - - The Term-ANSIColor distribution as a whole is covered by the following - copyright statement and license: - - Copyright 1996 Zenin - Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, - 2010, 2011, 2012, 2013 Russ Allbery <rra@stanford.edu> - Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com> - - This program is free software; you may redistribute it and/or modify - it under the same terms as Perl itself. This means that you may - choose between the two licenses that Perl is released under: the GNU - GPL and the Artistic License. Please see your Perl distribution for - the details and copies of the licenses. - - PUSH/POP support submitted 2007 by openmethods.com voice solutions - - All individual files without an explicit exception below are released - under this license. Some files may have additional copyright holders as - noted in those files. There is detailed information about the licensing - of each file in the LICENSE file in this distribution. - - Some files in this distribution are individually released under - different licenses, all of which are compatible with the above general - package license but which may require preservation of additional - notices. All required notices are preserved in the LICENSE file. diff --git a/gnu/usr.bin/perl/cpan/Term-UI/lib/Term/UI.pm b/gnu/usr.bin/perl/cpan/Term-UI/lib/Term/UI.pm index fb335272c07..136f75bb6ad 100644 --- a/gnu/usr.bin/perl/cpan/Term-UI/lib/Term/UI.pm +++ b/gnu/usr.bin/perl/cpan/Term-UI/lib/Term/UI.pm @@ -1,7 +1,5 @@ package Term::UI; -use if $] > 5.017, 'deprecate'; - use Carp; use Params::Check qw[check allow]; use Term::ReadLine; @@ -13,7 +11,7 @@ use strict; BEGIN { use vars qw[$VERSION $AUTOREPLY $VERBOSE $INVALID]; $VERBOSE = 1; - $VERSION = '0.34'; + $VERSION = '0.20'; $INVALID = loc('Invalid selection, please try again: '); } @@ -37,7 +35,7 @@ Term::UI - Term::ReadLine UI made easy my $reply = $term->get_reply( prompt => 'What is your favourite colour?', choices => [qw|blue red green|], - default => 'blue', + default => blue, ); my $bool = $term->ask_yn( @@ -57,7 +55,7 @@ Term::UI - Term::ReadLine UI made easy ### always pick the default (good for non-interactive terms) ### -- default is '0' $Term::UI::AUTOREPLY = 1; - + ### Retrieve the entire session as a printable string: $hist = Term::UI::History->history_as_string; $hist = $term->history_as_string; @@ -75,12 +73,12 @@ For asking a yes or no question, there's even a shortcut. =head1 HOW IT WORKS -C<Term::UI> places itself at the back of the C<Term::ReadLine> +C<Term::UI> places itself at the back of the C<Term::ReadLine> C<@ISA> array, so you can call its functions through your term object. C<Term::UI> uses C<Term::UI::History> to record all interactions with the commandline. You can retrieve this history, or alter -the filehandle the interaction is printed to. See the +the filehandle the interaction is printed to. See the C<Term::UI::History> manpage or the C<SYNOPSIS> for details. =head1 METHODS @@ -104,8 +102,8 @@ toggling the C<multi> flag. Note that a list of answers will then be returned to you, rather than a simple string. By specifying an C<allow> hander, you can yourself validate the answer -a user gives. This can be any of the types that the Params::Check C<allow> -function allows, so please refer to that manpage for details. +a user gives. This can be any of the types that the Params::Check C<allow> +function allows, so please refer to that manpage for details. Finally, you have the option of adding a C<print_me> argument, which is simply printed before the prompt. It's printed to the same file handle @@ -137,16 +135,16 @@ sub get_reply { ### add this to the prompt to indicate the default ### answer to the question if there is one. my $prompt_add; - + ### if you supplied several choices to pick from, - ### we'll print them separately before the prompt + ### we'll print them seperately before the prompt if( @{$args->{choices}} ) { my $i; for my $choice ( @{$args->{choices}} ) { $i++; # the answer counter -- but humans start counting # at 1 :D - + ### so this choice is the default? add it to 'prompt_add' ### so we can construct a "foo? [DIGIT]" type prompt $prompt_add = $i if (defined $args->{default} and $choice eq $args->{default}); @@ -155,7 +153,7 @@ sub get_reply { $args->{print_me} .= sprintf "\n%3s> %-s", $i, $choice; } - ### we listed some choices -- add another newline for + ### we listed some choices -- add another newline for ### pretty printing $args->{print_me} .= "\n" if $i; @@ -171,14 +169,14 @@ sub get_reply { ### we set up the defaults, prompts etc, dispatch to the readline call return $term->_tt_readline( %$args, prompt_add => $prompt_add ); -} +} =head2 $bool = $term->ask_yn( prompt => "your question", [default => (y|1,n|0), print_me => "extra text to print & record"] ) Asks a simple C<yes> or C<no> question to the user, returning a boolean indicating C<true> or C<false> to the caller. -The C<default> answer will automatically returned, if the user hits +The C<default> answer will automatically returned, if the user hits C<enter> or if C<$AUTOREPLY> is set to true. See the C<GLOBAL VARIABLES> section further below. @@ -201,7 +199,7 @@ sub ask_yn { default => { default => undef, allow => [qw|0 1 y n|], strict_type => 1 }, prompt => { default => '', required => 1, strict_type => 1 }, - print_me => { default => '', strict_type => 1 }, + print_me => { default => '', strict_type => 1 }, multi => { default => 0, no_override => 1 }, choices => { default => [qw|y n|], no_override => 1 }, allow => { default => [qr/^y(?:es)?$/i, qr/^n(?:o)?$/i], @@ -210,7 +208,7 @@ sub ask_yn { }; my $args = check( $tmpl, \%hash, $VERBOSE ) or return undef; - + ### uppercase the default choice, if there is one, to be added ### to the prompt in a 'foo? [Y/n]' type style. my $prompt_add; @@ -219,10 +217,10 @@ sub ask_yn { ### if you supplied the default as a boolean, rather than y/n ### transform it to a y/n now - $args->{default} = $args->{default} =~ /\d/ + $args->{default} = $args->{default} =~ /\d/ ? { 0 => 'n', 1 => 'y' }->{ $args->{default} } : $args->{default}; - + @list = map { lc $args->{default} eq lc $_ ? uc $args->{default} : $_ @@ -233,7 +231,7 @@ sub ask_yn { } my $rv = $term->_tt_readline( %$args, prompt_add => $prompt_add ); - + return $rv =~ /^y/i ? 1 : 0; } @@ -249,11 +247,11 @@ sub _tt_readline { my ($default, $prompt, $choices, $multi, $allow, $prompt_add, $print_me); my $tmpl = { - default => { default => undef, strict_type => 1, + default => { default => undef, strict_type => 1, store => \$default }, prompt => { default => '', strict_type => 1, required => 1, store => \$prompt }, - choices => { default => [], strict_type => 1, + choices => { default => [], strict_type => 1, store => \$choices }, multi => { default => 0, allow => [0, 1], store => \$multi }, allow => { default => qr/.*/, store => \$allow, }, @@ -267,29 +265,24 @@ sub _tt_readline { ### it can display wonky on some terminals. history( $print_me ) if $print_me; - - if ($prompt_add) { - ### we might have to add a default value to the prompt, to - ### show the user what will be picked by default: - $prompt .= " [$prompt_add]: " ; - } - else { - $prompt .= " : "; - } + + ### we might have to add a default value to the prompt, to + ### show the user what will be picked by default: + $prompt .= " [$prompt_add]: " if $prompt_add; ### are we in autoreply mode? if ($AUTOREPLY) { - + ### you used autoreply, but didnt provide a default! - carp loc( + carp loc( q[You have '%1' set to true, but did not provide a default!], - '$AUTOREPLY' + '$AUTOREPLY' ) if( !defined $default && $VERBOSE); ### print it out for visual feedback history( join ' ', grep { defined } $prompt, $default ); - + ### and return the default return $default; } @@ -297,16 +290,16 @@ sub _tt_readline { ### so, no AUTOREPLY, let's see what the user will answer LOOP: { - + ### annoying bug in T::R::Perl that mucks up lines with a \n ### in them; So split by \n, save the last line as the prompt ### and just print the rest { my @lines = split "\n", $prompt; $prompt = pop @lines; - + history( "$_\n" ) for @lines; } - + ### pose the question my $answer = $term->readline($prompt); $answer = $default unless length $answer; @@ -322,12 +315,12 @@ sub _tt_readline { ### the return value list my @rv; - + if( @$choices ) { - + for my $answer (@answers) { - - ### a digit implies a multiple choice question, + + ### a digit implies a multiple choice question, ### a non-digit is an open answer if( $answer =~ /\D/ ) { push @rv, $answer if allow( $answer, $allow ); @@ -335,24 +328,24 @@ sub _tt_readline { ### remember, the answer digits are +1 compared to ### the choices, because humans want to start counting - ### at 1, not at 0 - push @rv, $choices->[ $answer - 1 ] + ### at 1, not at 0 + push @rv, $choices->[ $answer - 1 ] if $answer > 0 && defined $choices->[ $answer - 1]; - } + } } - + ### no fixed list of choices.. just check if the answers ### (or otherwise the default!) pass the allow handler - } else { + } else { push @rv, grep { allow( $_, $allow ) } - scalar @answers ? @answers : ($default); + scalar @answers ? @answers : ($default); } ### if not all the answers made it to the return value list, - ### at least one of them was an invalid answer -- make the + ### at least one of them was an invalid answer -- make the ### user do it again - if( (@rv != @answers) or - (scalar(@$choices) and not scalar(@answers)) + if( (@rv != @answers) or + (scalar(@$choices) and not scalar(@answers)) ) { $prompt = $INVALID; $prompt .= "[$prompt_add] " if $prompt_add; @@ -490,10 +483,10 @@ This defaults to C<*STDOUT>. ### ask a user (with an open question) for their favourite colour $reply = $term->get_reply( prompt => 'Your favourite colour? ); - + which would look like: - Your favourite colour? + Your favourite colour? and C<$reply> would hold the text the user typed. @@ -503,15 +496,15 @@ and C<$reply> would hold the text the user typed. $reply = $term->get_reply( prompt => 'Your favourite colour?', choices => [qw|red green blue|] ); - + which would look like: 1> red 2> green 3> blue - - Your favourite colour? - + + Your favourite colour? + C<$reply> will hold one of the choices presented. C<Term::UI> will repose the question if the user attempts to enter an answer that's not in the list of choices. The string presented is held in the C<$Term::UI::INVALID> @@ -530,8 +523,8 @@ which would look like: 1> red 2> green 3> blue - - Your favourite colour? [3]: + + Your favourite colour? [3]: Note the default answer after the prompt. A user can now just hit C<enter> (or set C<$Term::UI::AUTOREPLY> -- see the C<GLOBAL VARIABLES> section) and @@ -539,10 +532,10 @@ the sensible answer 'blue' will be returned. =head2 get_reply using print_me & multi - ### allow the user to pick more than one colour and add an + ### allow the user to pick more than one colour and add an ### introduction text @reply = $term->get_reply( - print_me => 'Tell us what colours you like', + print_me => 'Tell us what colours you like', prompt => 'Your favourite colours?', choices => [qw|red green blue|], multi => 1 ); @@ -553,20 +546,20 @@ which would look like: 1> red 2> green 3> blue - + Your favourite colours? An answer of C<3 2 1> would fill C<@reply> with C<blue green red> =head2 get_reply & allow - ### pose an open question, but do a custom verification on - ### the answer, which will only exit the question loop, if + ### pose an open question, but do a custom verification on + ### the answer, which will only exit the question loop, if ### the answer matches the allow handler. $reply = $term->get_reply( prompt => "What is the magic number?", allow => 42 ); - + Unless the user now enters C<42>, the question will be reposed over and over again. You can use more sophisticated C<allow> handlers (even subroutines can be used). The C<allow> handler is implemented using @@ -578,18 +571,18 @@ C<Params::Check>'s C<allow> function. Check its manpage for details. ### and inform him first what cookies are. $bool = $term->ask_yn( prompt => 'Do you like cookies?', default => 'y', - print_me => 'Cookies are LOVELY!!!' ); + print_me => 'Cookies are LOVELY!!!' ); -would print: +would print: Cookies are LOVELY!!! - Do you like cookies? [Y/n]: + Do you like cookies? [Y/n]: -If a user then simply hits C<enter>, agreeing with the default, -C<$bool> would be set to C<true>. (Simply hitting 'y' would also +If a user then simply hits C<enter>, agreeing with the default, +C<$bool> would be set to C<true>. (Simply hitting 'y' would also return C<true>. Hitting 'n' would return C<false>) -We could later retrieve this interaction by printing out the Q&A +We could later retrieve this interaction by printing out the Q&A history as follows: print $term->history_as_string; @@ -621,7 +614,7 @@ This module by Jos Boumans E<lt>kane@cpan.orgE<gt>. =head1 COPYRIGHT -This library is free software; you may redistribute and/or modify it +This library is free software; you may redistribute and/or modify it under the same terms as Perl itself. =cut diff --git a/gnu/usr.bin/perl/cpan/Term-UI/t/00_load.t b/gnu/usr.bin/perl/cpan/Term-UI/t/00_load.t index affc3d0d975..aacd60f7117 100755 --- a/gnu/usr.bin/perl/cpan/Term-UI/t/00_load.t +++ b/gnu/usr.bin/perl/cpan/Term-UI/t/00_load.t @@ -1,7 +1,7 @@ use Test::More 'no_plan'; use strict; -BEGIN { +BEGIN { chdir 't' if -d 't'; use File::Spec; use lib File::Spec->catdir( qw[.. lib] ); diff --git a/gnu/usr.bin/perl/cpan/Term-UI/t/01_history.t b/gnu/usr.bin/perl/cpan/Term-UI/t/01_history.t index 23c7cc004c7..b0219de735a 100755 --- a/gnu/usr.bin/perl/cpan/Term-UI/t/01_history.t +++ b/gnu/usr.bin/perl/cpan/Term-UI/t/01_history.t @@ -1,7 +1,7 @@ use Test::More 'no_plan'; use strict; -BEGIN { +BEGIN { chdir 't' if -d 't'; use File::Spec; use lib File::Spec->catdir( qw[.. lib] ); @@ -16,56 +16,56 @@ my $Verbose = 0; # print to STDOUT? for my $pkg ( $Class, __PACKAGE__ ) { can_ok( $pkg, $Func ); - } + } } ### test string recording -{ history( $$, $Verbose ); +{ history( $$, $Verbose ); my $str = $Class->history_as_string; ok( $str, "Message recorded" ); is( $str, $$, " With appropriate content" ); - + $Class->flush; ok( !$Class->history_as_string, " Stack flushed" ); } -### test filehandle printing -SKIP: { +### test filehandle printing +SKIP: { my $file = "$$.tmp"; - + { open my $fh, ">$file" or skip "Could not open $file: $!", 6; - + ### declare twice for 'used only once' warning local $Term::UI::History::HISTORY_FH = $fh; - local $Term::UI::History::HISTORY_FH = $fh; - + local $Term::UI::History::HISTORY_FH = $fh; + history( $$ ); close $fh; - } + } my $str = $Class->history_as_string; ok( $str, "Message recorded" ); is( $str, $$, " With appropriate content" ); - + ### check file contents { ok( -e $file, "File $file exists" ); ok( -s $file, " File has size" ); - + open my $fh, $file or skip "Could not open $file: $!", 2; my $cont = do { local $/; <$fh> }; chomp $cont; - + is( $cont, $str, " File has same content" ); - } + } $Class->flush; - + ### for VMS etc 1 while unlink $file; - + ok( ! -e $file, " File $file removed" ); } diff --git a/gnu/usr.bin/perl/cpan/Term-UI/t/02_ui.t b/gnu/usr.bin/perl/cpan/Term-UI/t/02_ui.t index cf5d1d49e13..6e0b34ae325 100755 --- a/gnu/usr.bin/perl/cpan/Term-UI/t/02_ui.t +++ b/gnu/usr.bin/perl/cpan/Term-UI/t/02_ui.t @@ -11,11 +11,6 @@ use_ok( 'Term::UI' ); $Term::UI::AUTOREPLY = $Term::UI::AUTOREPLY = 1; $Term::UI::VERBOSE = $Term::UI::VERBOSE = 0; -# SKIP tests if we aren't on a terminal -SKIP: { - -skip 'not on a terminal', 18 unless -t; - ### enable warnings $^W = 1; @@ -76,10 +71,10 @@ my $tmpl = { { my $args = { prompt => 'Uninit warning on empty default', }; - + my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= "@_" }; - + my $res = $term->get_reply( %$args ); ok( !$res, "Empty result on autoreply without default" ); @@ -88,17 +83,17 @@ my $tmpl = { " No warnings from Term::UI" ); } - + # used to print: Use of uninitialized value in string at Params/Check.pm # [#13412] { my $args = { prompt => 'Undef warning on failing allow', allow => sub { 0 }, }; - + my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= "@_" }; - + my $res = $term->get_reply( %$args ); ok( !$res, "Empty result on autoreply without default" ); @@ -108,7 +103,7 @@ my $tmpl = { } -#### test parse_options +#### test parse_options { my $str = q[command --no-foo --baz --bar=0 --quux=bleh ] . q[--option="some'thing" -one-dash -single=blah' foo bar-zot]; @@ -135,17 +130,15 @@ my $tmpl = { [ 'x --update_source' => 'x', { update_source => 1 } ], [ '--update_source' => '', { update_source => 1 } ], ); - + for my $aref ( @map ) { my( $input, $munged, $expect ) = @$aref; - + my($href,$rest) = $term->parse_options( $input ); - + ok( $href, "Parsed '$input'" ); is_deeply( $href, $expect, " Options parsed correctly" ); is( $rest, $munged, " Command parsed correctly" ); } } - -} # End SKIP block diff --git a/gnu/usr.bin/perl/cpan/Test-Harness/Changes b/gnu/usr.bin/perl/cpan/Test-Harness/Changes index 88039e59698..6141f78f36e 100644 --- a/gnu/usr.bin/perl/cpan/Test-Harness/Changes +++ b/gnu/usr.bin/perl/cpan/Test-Harness/Changes @@ -1,140 +1,5 @@ Revision history for Test-Harness -3.26 2013-01-16 - - Renamed env.opts.t to env_opts.t (for VMS) - - Skipped some TAP::Formatter::HTML tests due to this bug: #82738 - -3.26 2012-06-05 - - Rereleased to fix CPAN permission problem. No functional change. - -3.24 2012-06-03 - - RT #74393: corrected typo in M::B integration docs. - - RT #63473: fix typo. - - RT #49732: Attempt to load File::Glob::Windows to get correct - glob semantics on Win32. - - RT #47890: Don't use Win32::GetShortPathName. - - RT #64404: Ignore textness ('-T') of script when reading shebang. - - Handle the case where we don't know the wait status of the - test more gracefully. - - Make the test summary 'ok' line overrideable so that it can be - changed to a plugin to make the output of prove idempotent. - - Apply upstream patch: - - http://perl5.git.perl.org/perl.git/commit \ - /6359c64336d99060952232e7e300bd3c31afead8 - - In testargs.t in Test::Harness, don't run a world-writable file. - - The test writes a file, then changes the mode, then executes it. The file needs - to be +x to be executable (on many platforms). The file will need to be +w to - be deletable on some platforms. But setting the file world writable just before - running it feels like a bad idea, given that the file's name is as predictable - as process IDs, as there's a race condition to break into the account running - perl's tests. - -3.23 2011-02-20 - - Merge in changes from core. Thanks BinGOs. - - Made SourceHandler understand that an executable binary file - is probably an executable. - - Added workaround for Getopt::Long 2.25 handling of - multivalue options. Fixes test failure on stock perl 5.6.2. - -3.22 2010-08-14 - - Allow TAP::Parser to recognize a nested BAIL_OUT directive. - - Add brief HOWTO for creating and running pgTAP tests to - TAP::Parser::SourceHandler::pgTAP. - - Fix trailing plan + embedded YAML + TAP 13 case. Thanks to - Steffen Schwigon. #54518. - - Numerous spelling fixes. Thanks to Ville Skyttä. - - Add new option --tapversion for prove to set the default - assumed TAP version. Thanks to Steffen Schwigon. - - Fixed tests to run successfully under Devel::Cover. Thanks to - Phillipe Bruhat. - - Fixed injection of test args to work with general executables - as well as Perl scripts (#59186). - - Allow multiple --ext=.foo arguments to prove, to allow running - different types of tests in the same prove run. - - App::Prove::extension() is now App::Prove::extensions(), and - returns an arrayref of extensions, rather than a single scalar. - The same change has been made to App::Prove::State::extension(). - - Preserve old semantics for test scripts with a shebang line - by favouring Perl as the intepreter for any file with a - shebang (#59457). - - Add --trap (summary on Ctrl-C) option to prove (#59427). - - Removed TAP::Parser::SourceHandler::pgTAP. Find it in its own - distribution on CPAN. - - Source options to prove can now be specified so as to be passed to - the source as a hash reference, eg: - - prove --source XYZ --xyz-option pset=foo=bar - - Ths "pset" option will be passed as a hash reference with the key - "foo" and the value "bar". - -3.21 2010-01-30 - - Add test to ensure we're not depending on a module we no - longer ship. - - Fix up skip counts for Windows case - tests were failing - on Windows. - -3.20 2010-01-22 - - Remove references / dependency on TAP::Parser::Source::Perl - -3.19 2010-01-20 - - Avoid depending on Module::Build. The resulting circular - dependency made it impossible to install Test::Harness and/or - Module::Build in some cases. - -3.18 2010-01-19 - - Handle the case where the filename of the perl executable - contains space. Thanks to kmx. - - Various documentation fixes. - -3.17_04 2010-01-04 - - Fix failures due to unknown location of Perl in t/source_handler.t. - - Use EUMM style shebang magic to produce an executable 'psql' - for t/source_handler.t. - -3.17_03 2009-11-19 - - Fix failures due to over-strict assertions in t/source.t. - -3.17_02 2009-11-17 - - Merge in Steve's missing changes. Oops. - -3.17_01 2009-11-17 - - Re-engineered source handling API to allow users to configure how - TAP is sourced by the parser. Introduced a new 'sources' param to - TAP::Harness, and new options to prove, eg: - - prove --source XYZ --xyz-option foo=bar - - The new TAP::Parser::SourceHandler API makes it much easier to - write plugins. This breaks backwards compatibility for plugins & - extenstions that rely on the following APIs: - - TAP::Parser::Source - TAP::Parser::SourceFactory - TAP::Parser::IteratorFactory - TAP::Parser, specifically: - new: 'source' & 'tap' params - source_class - perl_source_class - iterator_factory_class - make_source - make_perl_source - make_iterator - - Please see the TAP::Parser docs for more details. - [Steve Purkis & David Wheeler] - - Removed dependency on File::Spec [Schwern] - - Made it possible to pass different args to each test [Lee Johnson] - - Added HARNESS_SUBCLASS option to Test::Harness - - Added TAP::Parser::SourceHandler::File which lets you to stream TAP - from a text file (eg: *.tap). - - Added TAP::Parser::SourceHandler::pgTAP. All the source handlers are - new, but this is the only one to add major new functioality: the - ability to run pgTAP tests (http://pgtap.projects.postgresql.org/). - 3.17 2009-05-05 - Changed the 'failures' so that it is overridden by verbosity rather than the other way around. diff --git a/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Parser/Utils.pm b/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Parser/Utils.pm index 2096b0ec4f1..a3d2dd1ea98 100644 --- a/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Parser/Utils.pm +++ b/gnu/usr.bin/perl/cpan/Test-Harness/lib/TAP/Parser/Utils.pm @@ -13,11 +13,11 @@ TAP::Parser::Utils - Internal TAP::Parser utilities =head1 VERSION -Version 3.26 +Version 3.17 =cut -$VERSION = '3.26'; +$VERSION = '3.17'; =head1 SYNOPSIS diff --git a/gnu/usr.bin/perl/cpan/Test-Harness/t/000-load.t b/gnu/usr.bin/perl/cpan/Test-Harness/t/000-load.t index 24addddc44b..58d41bfeeb4 100755 --- a/gnu/usr.bin/perl/cpan/Test-Harness/t/000-load.t +++ b/gnu/usr.bin/perl/cpan/Test-Harness/t/000-load.t @@ -1,95 +1,61 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl -wT use strict; use lib 't/lib'; -use Test::More; - -use constant LIBS => 'lib/'; -use constant FIRST => 'TAP::Parser'; - -read_manifest( 'MANIFEST', my $manifest = {} ); -read_manifest( 'MANIFEST.CUMMULATIVE', my $manifest_cummulative = {} ); - -my @classes = uniq( - FIRST, - map { file_to_mod($_) } filter_lib( keys %$manifest ) -); - -plan tests => @classes * 2 + 1; - -for my $class (@classes) { - use_ok $class or BAIL_OUT("Could not load $class"); - is $class->VERSION, TAP::Parser->VERSION, - "... and $class should have the correct version"; -} - -my @orphans = diff( - [ filter_lib( keys %$manifest ) ], - [ filter_lib( keys %$manifest_cummulative ) ] -); -my @waifs = intersection( \@orphans, [ keys %INC ] ); -unless ( ok 0 == @waifs, 'no old versions loaded' ) { - diag "\nThe following modules were loaded in error:\n"; - for my $waif ( sort @waifs ) { - diag sprintf " %s (%s)\n", file_to_mod($waif), $INC{$waif}; +use Test::More tests => 78; + +BEGIN { + + # TAP::Parser must come first + my @classes = qw( + TAP::Parser + App::Prove + App::Prove::State + App::Prove::State::Result + App::Prove::State::Result::Test + TAP::Base + TAP::Formatter::Color + TAP::Formatter::Console::ParallelSession + TAP::Formatter::Console::Session + TAP::Formatter::Console + TAP::Harness + TAP::Parser::Aggregator + TAP::Parser::Grammar + TAP::Parser::Iterator + TAP::Parser::Iterator::Array + TAP::Parser::Iterator::Process + TAP::Parser::Iterator::Stream + TAP::Parser::IteratorFactory + TAP::Parser::Multiplexer + TAP::Parser::Result + TAP::Parser::ResultFactory + TAP::Parser::Result::Bailout + TAP::Parser::Result::Comment + TAP::Parser::Result::Plan + TAP::Parser::Result::Pragma + TAP::Parser::Result::Test + TAP::Parser::Result::Unknown + TAP::Parser::Result::Version + TAP::Parser::Result::YAML + TAP::Parser::Result + TAP::Parser::Scheduler + TAP::Parser::Scheduler::Job + TAP::Parser::Scheduler::Spinner + TAP::Parser::Source::Perl + TAP::Parser::Source + TAP::Parser::YAMLish::Reader + TAP::Parser::YAMLish::Writer + TAP::Parser::Utils + Test::Harness + ); + + foreach my $class (@classes) { + use_ok $class or BAIL_OUT("Could not load $class"); + is $class->VERSION, TAP::Parser->VERSION, + "... and $class should have the correct version"; } - diag "\n"; -} - -diag("Testing Test::Harness $Test::Harness::VERSION, Perl $], $^X") - unless $ENV{PERL_CORE}; - -sub intersection { - my ( $la, $lb ) = @_; - my %seen = map { $_ => 1 } @$la; - return grep { $seen{$_} } @$lb; -} - -sub diff { - my ( $la, $lb ) = @_; - my %seen = map { $_ => 1 } @$la; - return grep { !$seen{$_}++ } @$lb; -} -sub uniq { - my %seen = (); - grep { !$seen{$_}++ } @_; + diag("Testing Test::Harness $Test::Harness::VERSION, Perl $], $^X") + unless $ENV{PERL_CORE}; } - -sub lib_matcher { - my @libs = @_; - my $re = join ')|(', map quotemeta, @libs; - return qr{^($re)}; -} - -sub filter_lib { - my $matcher = lib_matcher(LIBS); - return map { s{$matcher}{}; $_ } - grep {m{$matcher.+?\.pm$}} sort @_; -} - -sub mod_to_file { - my $mod = shift; - $mod =~ s{::}{/}g; - return "$mod.pm"; -} - -sub file_to_mod { - my $file = shift; - $file =~ s{/}{::}g; - $file =~ s{\.pm$}{}; - return $file; -} - -sub read_manifest { - my ( $file, $into ) = @_; - open my $fh, '<', $file or die "Can't read $file: $!"; - while (<$fh>) { - chomp; - s/\s*#.*//; - $into->{$_}++ if length $_; - } - return; -} - diff --git a/gnu/usr.bin/perl/cpan/Text-Soundex/Changes b/gnu/usr.bin/perl/cpan/Text-Soundex/Changes index 364962b1920..41c78b15fe1 100644 --- a/gnu/usr.bin/perl/cpan/Text-Soundex/Changes +++ b/gnu/usr.bin/perl/cpan/Text-Soundex/Changes @@ -1,10 +1,5 @@ Revision history for Perl extension Text::Soundex. -3.04 Thu Feb 7 15:53:09 EST 2013 <rjbs@cpan.org> - -The module is going to be removed from the core distribution of perl, and will -now warn (under warnings) if loaded from its installed-to-core location. - 3.02 Sun Feb 02 02:54:00 EST 2003 <mark@mielke.cc> The U8 type was over-used in 3.00 and 3.01. Now, "U8 *" is used only as a diff --git a/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.pm b/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.pm index 83a55af43ec..598b8a8fe94 100644 --- a/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.pm +++ b/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.pm @@ -19,9 +19,7 @@ use XSLoader (); use strict; -use if $] > 5.016, 'deprecate'; - -our $VERSION = '3.04'; +our $VERSION = '3.03_01'; our @EXPORT_OK = qw(soundex soundex_unicode soundex_nara soundex_nara_unicode $soundex_nocode); our @EXPORT = qw(soundex soundex_nara $soundex_nocode); diff --git a/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.xs b/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.xs index d14247132b1..1496338452d 100644 --- a/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.xs +++ b/gnu/usr.bin/perl/cpan/Text-Soundex/Soundex.xs @@ -79,7 +79,7 @@ static void sv_soundex_initialize (void) sv_soundex_table['r'] = '6'; } -static SV *sv_soundex (SV* source) +static SV *sv_soundex (SV *source) { char *source_p; char *source_end; diff --git a/gnu/usr.bin/perl/cpan/Time-HiRes/Changes b/gnu/usr.bin/perl/cpan/Time-HiRes/Changes index d5a283100a2..ffec191c1ed 100644 --- a/gnu/usr.bin/perl/cpan/Time-HiRes/Changes +++ b/gnu/usr.bin/perl/cpan/Time-HiRes/Changes @@ -1,53 +1,5 @@ Revision history for the Perl extension Time::HiRes. -1.9725 [2012-02-01] - - Correct stack discipline in stat(), which was screwing up list - operations in expressions containing calls to it [rt.cpan.org - #72926]. - - Add missing OUTPUT sections to the XS code [rt.cpan.org #70930]. - - Skip itimer tests on GNU/Hurd, which has the API but lacks - the implementation [rt.cpan.org #72754]. - - Fix a doubled word in the documentation [rt.cpan.org #72763]. - -1.9724 [2011-06-09] - - Correct XS parameter list, and therefore prototype, for - unimplemented-on-this-platform version of clock_nanosleep() - [rt.cpan.org #68700]. - - Declare package variables with "our" rather than "use vars". - - Corresponding to "our" usage, check for minimum Perl version - 5.006. - - Declare module dependencies. - -1.9723 [2011-06-07] - - Remove $ENV{PERL_CORE} logic from test suite, which is no - longer desired in the core. - - Convert test suite to use Test::More. - - Factor out watchdog code from test suite. - - In test suite, be consistent about using fully-qualified form - of function names. - - Divide test suite into feature-specific scripts. - - Make ualarm timing test less vulnerable to delay-induced false - failure, from Dave Mitchell. - -1.9722 [2011-05-18] - - Update for changes in build process in the core, patches - from BinGOs [rt.cpan.org #58858] and Craig Berry [rt.cpan.org - #63363]. - - Fix broken linkage on Windows with gcc 3.4 seen with ActivePerl, - report from Christian Walde [rt.cpan.org #61648], fix derived - from Vincent Pit. - - Jump through hoops to avoid compiler warnings. - -1.9721 [2010-03-17] - - Address [rt.cpan.org #54196] alarm and ularm return values are bogus, - additional fix from Gisle Aas - - Address [rt.cpan.org #55665] "Bad plan" on Windows, - report and fix from Jan Dubois - -1.9720 [2010-02-14] - - Address [rt.cpan.org #54196] alarm and ularm return values are bogus, - report and fix from Nicholas Clark - 1.9719 [2009-01-04] - As with QNX, Haiku has the API of interval timers but not the implementation (bleadperl change #34630), hence skip diff --git a/gnu/usr.bin/perl/cpan/Time-Piece/Changes b/gnu/usr.bin/perl/cpan/Time-Piece/Changes index 5342dcbd08f..5eeb54b3506 100644 --- a/gnu/usr.bin/perl/cpan/Time-Piece/Changes +++ b/gnu/usr.bin/perl/cpan/Time-Piece/Changes @@ -1,36 +1,6 @@ -Time::Piece Changes - -1.20 - - Fix for alloca broke Solaris - - Fixed documentation buggette about strptime - - Added ->pretty() method for Time::Seconds objects - - Add %s support to strptime - -1.19 - - Fix for alloca broke FreeBSD -1.18 - - Fix for alloca on IRIX - -1.17 - - Force all to use internal strptime then everyone gets %z even OSX - users. - - Finally figured out the timezone test failures on Win32 and fixed - them. +Time::Piece Changes -1.16 - - Implement %z for the internal implementation of strptime(). - Unfortunately this doesn't get picked up everywhere, so there are no - tests for it (yet - patches welcome). - - Fix for major bug in add_months() using negative months which were - multiples of 12. Also affected add_years() with negative years. - - Fix for object creation bug in get_epochs which called new from object - but that wasn't supported in the new() code. - - Added docs about the weakness of using epoch seconds internally and - suggested alternatives. - - Removed useless "use UNIVERSAL qw(isa)" line. - - Fix for installing over core perl version. - 1.15 - Skip a test on Win32 that there's just no way of passing - Document the above failure diff --git a/gnu/usr.bin/perl/cpan/Time-Piece/Makefile.PL b/gnu/usr.bin/perl/cpan/Time-Piece/Makefile.PL index 9b2a964d5b6..a69cf550c97 100644 --- a/gnu/usr.bin/perl/cpan/Time-Piece/Makefile.PL +++ b/gnu/usr.bin/perl/cpan/Time-Piece/Makefile.PL @@ -7,5 +7,4 @@ WriteMakefile( 'VERSION_FROM' => 'Piece.pm', # finds $VERSION 'AUTHOR' => 'Matt Sergeant', 'ABSTRACT_FROM' => 'Piece.pm', - 'INSTALLDIRS' => ( $] >= 5.009005 ? 'perl' : 'site' ), ); diff --git a/gnu/usr.bin/perl/cpan/Unicode-Collate/Changes b/gnu/usr.bin/perl/cpan/Unicode-Collate/Changes index 9fc2dc26c4c..120368cb490 100644 --- a/gnu/usr.bin/perl/cpan/Unicode-Collate/Changes +++ b/gnu/usr.bin/perl/cpan/Unicode-Collate/Changes @@ -1,313 +1,5 @@ Revision history for Perl module Unicode::Collate. -0.97 Sat Dec 22 14:25:50 2012 - - bug fix: XS of 0.96 (if UCA_Version is 9 to 11) wrongly referred to - DUCET for completely ignorable characters, even though the collator - don't use DUCET. - - separated t/notable.t from t/test.t. - -0.96 Sat Dec 15 19:43:10 2012 - - special noncharancter tailorings ('highestFFFF' and 'minimalFFFE') - * some locales are modified for 'highestFFFF': as, bn, fa, gu, hi, hy, - kn, kok, mr, or, sa, si, si_dict, ta, te, th, ur. - - U::C::Locale now allows 'entry' to add or override mappings. - - bug fix: using DUCET through XS wrongly prevented completely ignorable - characters from tailoring. - - modified tests: default.t, loc_as.t, loc_bn.t, loc_fa.t, loc_gu.t, - loc_hi.t, loc_hy.t, loc_kn.t, loc_kok.t, loc_mr.t, loc_or.t, loc_sa.t, - loc_si.t, loc_sidt.t, loc_ta.t, loc_te.t, loc_test.t, loc_th.t, - loc_ur.t, nonchar.t in t. - -0.95 Sat Dec 8 15:11:09 2012 - - U::C::Locale newly supports locales: bs_Cyrl, ee. - - updated to CLDR 21: uk. - - updated to CLDR 22: th, to. - - added loc_bscy.t, loc_ee.t in t. - - modified tests: loc_th.t, loc_to.t, loc_uk.t in t. - -0.94 Fri Nov 23 18:45:53 2012 - - U::C::Locale newly supports locale: zh__zhuyin. - - added Unicode::Collate::CJK::Zhuyin for zh__zhuyin. - - doc: added CAVEAT to CJK/Stroke.pm - - modified tests: loc_cjk.t, loc_cjkc.t in t. - - added cjk_zy.t, loc_zhzy.t in t. - -0.93 Sun Nov 18 18:13:42 2012 - - DUCET is updated (for Unicode 6.2.0) as Collate/allkeys.txt. - ! Please notice that allkeys.txt will be overwritten if you have had - other allkeys.txt already. - - The default UCA_Version is 26. - - Locale/*.pl (except fr.pl) and CJK/Korean.pm are updated. - - modified tests: loc_es.t, loc_estr.t, version.t in t. - -0.92 Wed Nov 14 20:58:19 2012 - - fix: index() etc. with preprocess/normalization should be always croaked. - - doc: referred to the latest UTS #10 and updated its section numbers. - - supported the identical level (see 'identical' in POD). - - Now UCA_Version 26 (for Unicode 6.2.0) is supported. - * But the default UCA_Version is still 24. - - added ident.t in t. - - modified tests: cjkrange.t, compatui.t, hangtype.t, index.t, - overcjk0.t, overcjk1.t, test.t, view.t in t. - -0.91 Sun Nov 4 17:00:20 2012 - - XSUB: use PERL_NO_GET_CONTEXT (see perlguts) - (see [rt.cpan.org #80313]) - -0.90 Sun Sep 23 10:42:26 2012 - - perl 5.11.0 or later: Install to 'site' instead of 'perl' - (see [rt.cpan.org #79800]) - -0.89 Sat Mar 10 20:19:11 2012 - - avoid "use Test". - -0.88 Mon Mar 5 21:56:13 2012 - - DUCET is updated (for Unicode 6.1.0) as Collate/allkeys.txt. - ! Please notice that allkeys.txt will be overwritten if you have had - other allkeys.txt already. - - U+9FCC is a new CJK unified ideograph. - - The default UCA_Version is 24. - - Locale/*.pl (except fr.pl) and CJK/Korean.pm are updated. - - modified tests: cjkrange.t, compatui.t, hangtype.t, loc_cjkc.t, - loc_es.t, loc_estr.t, overcjk0.t, overcjk1.t, version.t in t. - -0.87 Sat Nov 26 17:01:42 2011 - - Now Locale/*.pl files are searched in @INC. (see [rt.cpan.org #72666]) - - added locale_version method to access the version number of Locale/*.pl. - -0.86 Wed Nov 23 17:16:00 2011 - - tailored compatibility ideographs as well as unified ideographs for - the locales: ja, ko, zh__big5han, zh__gb2312han, zh__pinyin, zh__stroke. - - added loc_cjkc.t in t. - -0.85 Sat Nov 19 20:01:57 2011 - - U::C::Locale newly supports locales: bn, sa. - - updated some locales to CLDR 2.0 : zh__pinyin, zh__stroke. - * supported compatibility decomposable characters and U+FDD0 indexes. - * updated CJK/Pinyin.pm and CJK/Stroke.pm. - - added loc_bn.t, loc_cjk.t, loc_sa.t in t. - -0.84 Sun Nov 6 14:44:51 2011 - - U::C::Locale supports script codes. - - U::C::Locale newly supports locales: fa, sr_Latn, ur. - - added loc_fa.t, loc_srla.t, loc_ur.t in t. - -0.83 Sun Oct 30 20:22:04 2011 - - mklocale: auto-generate equivalents for suppressed contractions. - * be.txt, bg.txt, kk.txt, mk.txt, ru.txt, sr.txt, uk.txt in data - are simplified. - * but no Locale/*.pl will be modified. - -0.82 Sun Oct 30 10:03:48 2011 - - U::C::Locale newly supports locales: si, si__dictionary, - sv__reformed, ta, te, th, wae. - - added loc_si.t, loc_sidt.t, loc_svrf.t, loc_ta.t, loc_te.t, - loc_th.t, loc_wae.t in t. - - updated some locales to CLDR 2.0 : sk, sr, sv, uk. - - updated CJK/Pinyin.pm according to CLDR 2.0. - -0.81 Sun Oct 23 21:32:36 2011 - - U::C::Locale newly supports locales: ml, mr, or, pa. - - added loc_ml.t, loc_mr.t, loc_or.t, loc_pa.t in t. - - updated some locales to CLDR 2.0 : mk, mt, nb, nn, ro, ru. - -0.80 Sun Oct 9 21:00:21 2011 - - U::C::Locale newly supports locales: bs, hi, kn, kok, ln. - - added loc_bs.t, loc_hi.t, loc_kn.t, loc_kok.t, loc_ln.t in t. - - updated some locales to CLDR 2.0 : ha, hr, kk, lt. - -0.79 Sun Oct 2 20:31:01 2011 - - pod: [rt.cpan.org #70241] Fix minor grammar error in manpage - by Harlan Lieberman-Berg. - - 'suppress' no longer affects contractions via 'entry'. - - U::C::Locale newly supports locales: as, fi__phonebook, gu. - - added loc_as.t, loc_fiph.t, loc_gu.t in t. - - updated some locales to CLDR 2.0 : ar, be, bg. - -0.78 Mon Jul 25 21:29:50 2011 - - tried fixing the tarball with world writable files. - ( http://www.perlmonks.org/?node_id=731935 ) - -0.77 Sun Jul 3 21:15:08 2011 - - xs: [perl #93470] [PATCH] consting in Collate.xs by Robin Barker. - -0.76 Sun May 15 10:06:59 2011 - - updated CJK/Pinyin.pm and CJK/Stroke.pm according to CLDR 1.9.1. - (type='pinyin' alt='short' and type='stroke' alt='short' respectively) - -0.75 Sat May 7 21:07:38 2011 - - supported ignore_level2 and rewrite. - - added iglevel2.t and rewrite.t in t. - -0.74 Mon Mar 21 19:07:38 2011 - - removed sw (Swahili) collation according to CLDR 1.9. - (removed files: Collate/Locale/sw.pl and data/sw.txt) - - shifted primary weights of letters > Z for some languages. - (affected locales: da, fi, fo, kl, nb, nn, sv) - -0.73 Sun Mar 6 13:24:22 2011 - - DUCET is updated (for Unicode 6.0.0) as Collate/allkeys.txt. - ! However no maint perl has supported Unicode 6.0.0 yet; - wait for 5.14, or try developing 5.13.7 or later. - ! Please notice that allkeys.txt will be overwritten if you have had - other allkeys.txt already. - - The default UCA_Version is 22. - - Locale/*.pl (except fr.pl and ko.pl) and CJK/Korean.pm are updated. - - test: compare allkeys.txt's version with Base_Unicode_Version - in t/default.t. - -0.72 Sat Jan 22 17:28:32 2011 - - xs: fix mixing char* and U8*. - -0.71 Tue Jan 18 22:29:44 2011 - - t/loc_test.t should not fail without Unicode::Normalize. - -0.70 Sun Jan 16 20:31:07 2011 - - Now U::C::Locale->new will use the compiled DUCET via XS if available. - added some tests in t/loc_test.t. - -0.69 Sat Jan 15 19:41:11 2011 - - clarified about XSUB. revised INSTALL in README. - - xs: flag passed to utf8n_to_uvuni(). - - doc and comments: [perl #81876] Fix typos by Peter J. Acklam. - -0.68 Tue Nov 23 20:17:22 2010 - - doc: clarified about (backwards => [ ]) and (backwards => undef). - - separated t/backwds.t from t/test.t. - - added cjk_b5.t, cjk_gb.t, cjk_ja.t, cjk_ko.t, cjk_py.t, cjk_st.t in t - for CJK/*.pm without Locale.pm. - -0.67 Sun Nov 14 11:38:59 2010 - - supported UCA_Version 22 for Unicode 6.0.0. - * 2B740..2B81D are new CJK unified ideographs. - * noncharacters (e.g. U+FFFF) should be overridable, not be ignored. - ! DUCET is NOT updated, as no maint perl supports Unicode 6.0.0. - Thus the default UCA_Version is still 20. - - added t/nonchar.t. - - improved discontiguous contractions of 3 or more characters. - (e.g. 0FB2 0F71 0F80 and 0FB3 0F71 0F80) - - auxiliary: now 'mklocale' also copes with Korean.pm according to DUCET. - -0.66 Sun Nov 7 10:47:30 2010 - - U::C::Locale newly supports locale: ko. - - added Unicode::Collate::CJK::Korean for ko. - - added t/loc_ko.t. - - 12 compat. ideographs (e.g. U+FA0E) are treated as unified ideographs. - (though DUCET also does it, now Unicode::Collate does it without DUCET.) - - added t/compatui.t. - ! Ideographs Ext.B (U+20000..U+2A6D6) can be overridden with UCA_Version 8. - This is a long-standing behavior from Unicode::Collate 0.11 to 0.63. - A wrong fix at 0.64 should be abandoned. - -0.65 Wed Nov 3 13:10:20 2010 - - U::C::Locale newly supports locale: zh and its some variants. - (zh__big5han, zh__gb2312han, zh__pinyin, zh__stroke) - - added Unicode::Collate::CJK::Big5 for zh__big5han. - - added Unicode::Collate::CJK::GB2312 for zh__gb2312han. - - added Unicode::Collate::CJK::Pinyin for zh__pinyin. - - added Unicode::Collate::CJK::Stroke for zh__stroke. - - added loc_zh.t, loc_zhb5.t, loc_zhgb.t, loc_zhpy.t, loc_zhst.t in t. - -0.64 Sun Oct 31 14:17:29 2010 - - U::C::Locale newly supports locale: ja. - - added Unicode::Collate::CJK::JISX0208 for ja. - - added loc_ja.t, loc_jait.t, loc_japr.t in t. - - a subroutine specified in 'overrideCJK' or 'overrideHangul' is allowed - to return an integer or undef value. - - fix: Ideographs Ext.B (U+20000..U+2A6D6) are assigned in Unicode 3.1, - then 'overrideCJK' should not override them with UCA_Version 8. - !! sorry, this fix is based on a wrong idea. reverted at 0.66. !! - - separated t/overcjk0.t and t/overcjk1.t from t/override.t. - -0.63 Sun Oct 10 22:13:21 2010 - - supported suppress contractions (see 'suppress' in POD). - - internal for 'hangul_terminator' in getSortKey(). - - U::C::Locale newly supports locales: be, bg, kk, mk, ru, sr. - - added loc_be.t, loc_bg.t, loc_cyrl.t, loc_kk.t, loc_mk.t, loc_ru.t, - loc_sr.t in t. - - added tailoring with U+0340 or U+0341 instead of U+0300 or U+0301. - (affected locales: hr, is, pl, se, to, wo) - -0.62 Wed Oct 6 21:35:54 2010 - - U::C::Locale newly supports locales: ar, hu, hy, se, to, uk. - - added loc_ar.t, loc_hu.t, loc_hy.t, loc_se.t, loc_to.t, loc_uk.t in t. - - Vietnamese (vi): added tailoring for U+0340 and U+0341. - -0.61 Sat Oct 2 11:41:29 2010 - - U::C::Locale newly supports locales: hr, ig, sq. - - added loc_hr.t, loc_ig.t, loc_sq.t in t. - - precomposed e-dot-below, o-dot-below, o-tilde are tailored as well. - (affected locales: et, yo) - - Vietnamese (vi): added contractions for non-blocked decompositions - * base + dot-below + mark such as a\x{323}\x{306}, \x{1EA1}\x{306} etc. - * base + tone + horn such as o\x{309}\x{31B}, \x{1ECF}\x{31B} etc. - -0.60 Thu Sep 23 21:37:36 2010 - - bug fix: index() [and its friends including gmatch()] didn't remove - ignorable characters in the substring correctly. - Thanks for the bug report: - http://www.xray.mpe.mpg.de/mailing-lists/perl-unicode/2010-09/msg00014.html - - - U::C::Locale newly supports locales: de__phonebook, nso, om, tn, vi. - - added loc_de.t, loc_deph.t, loc_nso.t, loc_om.t, loc_tn.t, loc_vi.t in t. - - precomposed a-breve, a-circ, e-circ, o-circ are tailored as well. - (affected locales: ro, sk, sv) - -0.59 Sun Sep 5 17:03:52 2010 - - U::C::Locale newly supports locales: az, fil, ha, lt, mt, tr, wo, yo. - - added loc_az.t, loc_fil.t, loc_ha.t, loc_lt.t, loc_mt.t, loc_tr.t, - loc_wo.t, loc_yo.t in t. - - precomposed a-uml, o-uml, and u-uml are tailored as well. - (affected locales: da, et, fi, fo, is, kl, nb, nn, sk, sv) - -0.58 Sun Aug 29 19:56:50 2010 - - U::C::Locale newly supports locales: af, cy, da, fo, haw, is, kl, sw. - - added loc_af.t, loc_cy.t, loc_da.t, loc_fo.t, loc_haw.t, loc_is.t, - loc_kl.t, loc_sw.t in t. - -0.57 Sun Aug 22 22:39:58 2010 - - U::C::Locale newly supports locales: ca, et, fi, lv, sk, sl. - - added loc_ca.t, loc_et.t, loc_fi.t, loc_lv.t, loc_sk.t, loc_sl.t in t. - -0.56 Sun Aug 8 20:24:03 2010 - - Unicode::Collate::Locale newly supports locales: eo, nb, ro, sv. - - added loc_eo.t, loc_es.t, loc_estr.t, loc_nb.t, loc_ro.t, loc_sv.t in t. - ! renamed t/locale_{xy}.t to t/loc_{xy}.t (for safer 8.3 names) - (loc_cs.t, loc_fr.t, loc_nn.t, loc_pl.t, loc_test.t) - -0.55 Sun Aug 1 21:21:23 2010 - - incorporated Unicode::Collate::Locale with some changes. see: - http://www.xray.mpe.mpg.de/mailing-lists/perl-unicode/2004-03/msg00030.html - - supported locales: cs, es, es__traditional, fr, nn, pl. - ! added t/locale*.t that uses DUCET. - (locale_cs.t, locale_fr.t, locale_nn.t, locale_pl.t, locale_test.t) - - data/*.txt and mklocale for preparation of Locale/*.pl from DUCET. - -0.54 Sun Jul 25 21:37:04 2010 - - Now UCA Revision 20 (based on Unicode 5.2.0). - - DUCET is also updated (for Unicode 5.2.0) as Collate/allkeys.txt, - which *is required* to test this module. - ! Please notice that allkeys.txt will be overwritten if you have had - other allkeys.txt already. - - U+9FC4..U+9FCB and U+2A700..U+2B734 are new CJK unified ideographs. - - Many hangul jamo are assigned (affecting hangul_terminator). - - ! Now XSUB will be built by default. (XSUB needs a C compiler.) - To build pure perl, run disableXS before Makefile.PL. - ! DUCET will be compiled when XS is used. Explicit saying - <table => 'allkeys.txt'> (or using another table) will prevent - this module from using the compiled DUCET. - - ! added t/default.t that uses DUCET. - -0.53 Sun Feb 14 20:46:27 2010 - - Now UCA Revision 18 (based on Unicode 5.1.0). - - DUCET is also updated (for Unicode 5.1.0) as Collate/allkeys.txt, - which is not required to test this module. - ! Please notice that allkeys.txt will be overwritten if you have had - other allkeys.txt already. - - U+9FBC..U+9FC3 are new CJK unified ideographs. - 0.52 Thu Oct 13 21:51:09 2005 - The Unicode::Collate->new method does not destroy user's $_ any longer. (thanks to Jon Warbrick for bug report) @@ -315,14 +7,14 @@ Revision history for Perl module Unicode::Collate. 0.51 Sun May 29 20:21:19 2005 - Added the latest DUCET (for Unicode 4.1.0) as Collate/allkeys.txt, which is not required to test this module. - ! Please notice that allkeys.txt will be overwritten if you have had + Please notice that allkeys.txt will be overwritten if you have had other allkeys.txt already. - Added INSTALL section in POD. 0.50 Sun May 8 20:26:39 2005 - Now UCA Revision 14 (based on Unicode 4.1.0). - Some tests are modified. - - Added cjkrange.t, ignor.t, override.t in t. + - Added cjkrange.t, ignor.t, override.t. - Added META.yml. 0.40 Sat Apr 24 06:54:40 2004 @@ -335,9 +27,9 @@ Revision history for Perl module Unicode::Collate. - A matching part from index(), match() etc. will include illegal code points (as well as ignorable characters) following a grapheme. - Contraction with illegal code point will be invalid. - - Added t/view.t. - - Added some tests in t/illegal.t. - - Separated t/altern.t and t/rearrang.t from t/test.t. + - Added view.t. + - Added some tests in illegal.t. + - Some tests are separated from test.t into altern.t and rearrang.t. - modified XSUB internals. 0.31 Sun Nov 16 15:40:15 2003 @@ -346,34 +38,34 @@ Revision history for Perl module Unicode::Collate. but porting is not successful in the case of ((Pure Perl) and (Perl 5.7.3 or before)). If perl 5.6.X is used, XSUB may help it in place of broken CORE::unpack('U*') in older perl. - - added illegal.t and illegalp.t in t. - - added XSUB where some functions are implemented in XSUB. - Pure Perl is also supported. + - added illegal.t and illegalp.t. + - added XSUB (EXPERIMENTAL!) where some functions are implemented + in XSUB. Pure Perl is also supported. 0.30 Mon Oct 13 21:26:37 2003 - - fix: Completely ignorable in table should be able to be overridden + - fix: Completely ignorable in table should be able to be overrided by non-ignorable in entry. - fix: Maximum length for contraction must not be shortened by a shorter contraction following in table and/or entry. - - added t/normal.t. + - added normal.t. - some doc fixes 0.29 Mon Oct 13 12:18:23 2003 - now UCA Version 11 (but no functionality is different from Version 9). - - supported 'hangul_terminator'. + - supported hangul_terminator. - fix: Base_Unicode_Version falsely returns Perl's Unicode version. C4 in UTS #10 requires UTS's Unicode version. - For variable weighting, 'variable' is recommended and 'alternate' is deprecated. - added version() method. - - added hangtype.t, trailwt.t, variable.t, and version.t in t. + - added hangtype.t, trailwt.t, variable.t, and version.t. 0.28 Sat Sep 06 20:16:01 2003 - Fixed another inconsistency under (normalization => undef): Non-contiguous contraction is always neglected. - Fixed: according to S2.1 in UTS #10, a blocked combining character - should not be contracted. One test in t/test.t was wrong, then removed. - - Added t/contract.t. + should not be contracted. One test in test.t was wrong, then removed. + - Added contract.t. - (normalization => "prenormalized") is able to be used. 0.27 Sun Aug 31 22:23:17 2003 @@ -388,13 +80,12 @@ Revision history for Perl module Unicode::Collate. or UAX #15 may be changed/enhanced in future. - When Hangul syllables are decomposed under <normalization => undef>, contraction among jamo (LV, VT, LVT) derived from the same - Hangul syllable is allowed. - - Added t/hangul.t. + Hangul syllable is allowed. Added hangul.t. 0.26 Sun Aug 03 22:23:17 2003 - fix: an expansion in which a CE is level 3 ignorable and others are not was wrongly made level 3 ignorable as a whole entry. - (In DUCET, some precomposed characters in Musical Symbols are so) + (In DUCET, some precomposites in Musical Symbols are so) 0.25 Mon Jun 06 23:20:17 2003 - fix Makefile.PL. @@ -411,8 +102,8 @@ Revision history for Perl module Unicode::Collate. and completely ignorable characters. 0.22 Mon Sep 02 23:15:14 2002 - - New File: t/index.t. - (The new t/test.t excludes tests for index.) + - New File: index.t. + (The new test.t excludes tests for index.) - tweak on index(). POSITION is supported. - add match, gmatch, subst, gsubst methods. - fix: ignorable after variable in 'shift'-variable weight. @@ -483,3 +174,4 @@ Revision history for Perl module Unicode::Collate. 0.01 Sun Jul 29 16:16:15 2001 - original version; created by h2xs 1.21 with options -A -X -n Sort::UCA + diff --git a/gnu/usr.bin/perl/cpan/Unicode-Collate/README b/gnu/usr.bin/perl/cpan/Unicode-Collate/README index fdd837b983e..b2bc7f96661 100644 --- a/gnu/usr.bin/perl/cpan/Unicode-Collate/README +++ b/gnu/usr.bin/perl/cpan/Unicode-Collate/README @@ -1,4 +1,4 @@ -Unicode/Collate version 0.97 +Unicode/Collate version 0.52 =============================== NAME @@ -20,27 +20,36 @@ SYNOPSIS $result = $Collator->eq($a, $b); # returns true/false (similarly ->ne, ->lt, ->le, ->gt, ->ge) -Note: Strings in @not_sorted, $a and $b are interpreted -according to Perl's Unicode support. See perlunicode, -perluniintro, perlunitut, perlunifaq, utf8. -Otherwise you can use "preprocess" or should decode them before. - INSTALL - Perl 5.6.1 or later is required. - Perl 5.8.1 or later is recommended. +Perl 5.6.1 or later is required. +Perl 5.8.1 or later is recommended. + +Though this module can be used without any C<table> file, +to use this module easily, it is recommended to install a table file +in the UCA format, by copying it under the directory +<a place in @INC>/Unicode/Collate. + +You can install such a table file by adding it +to "Collate" directory (where "keys.txt" is placed) in this distribution +before executing Makefile.PL. + +The most preferable one is "The Default Unicode Collation Element Table" +(aka DUCET), available from the Unicode Consortium's website: + + http://www.unicode.org/Public/UCA/ + + http://www.unicode.org/Public/UCA/latest/allkeys.txt (latest version) - Though this distribution contains a subset of an old DUCET, named - "keys.txt", this one is intended only for doing a test of this module - and practically useless for any other purpose. +If DUCET is not installed, it is recommended to copy the file +from http://www.unicode.org/Public/UCA/latest/allkeys.txt +to <a place in @INC>/Unicode/Collate/allkeys.txt +manually. - Installation of Unicode::Collate::Locale requires Collate/Locale.pm, - Collate/Locale/*.pm, Collate/CJK/*.pm and Collate/allkeys.txt. - On building, Unicode::Collate::Locale doesn't require any of data/*.txt, - gendata/*, and mklocale. - Tests for Unicode::Collate::Locale are named t/loc_*.t. +Though this distribution contains a subset of allkeys.txt, named "keys.txt", +this one is intended only for doing a test of this module +and practically useless for any other purpose. -Since 0.54, XSUB that requires a C compiler will be built by default. To install this module type the following: perl Makefile.PL @@ -48,20 +57,21 @@ To install this module type the following: make test make install -Even if a C compiler is not available, pure Perl (i.e. non-XS) edition -is available; type the following: +(!! XSUB for Unicode::Collate is an EXPERIMENTAL support !!) +If you have a C compiler and want to use XSUB edition, +type the following (!! "enableXS" must run before "Makefile.PL" !!): - perl disableXS + perl enableXS perl Makefile.PL make make test make install -If you decide to install XSUB edition after trying to build pure Perl, -type the following: +If you decide to install pure Perl (i.e. non-XS) edition after trying +to build XSUB, type the following: make clean - perl enableXS + perl disableXS perl Makefile.PL make make test @@ -72,49 +82,16 @@ DEPENDENCIES The conformant collation requires Unicode::Normalize (v 0.10 or later) although Unicode::Collate can be used without Unicode::Normalize. -ABOUT DUCET - - Though this module can be used without any C<table> file, - to use this module easily, it is recommended to install a table file - in the UCA format, by copying it under the directory - <a place in @INC>/Unicode/Collate. - - You can install such a table file by adding it to "Collate" directory - (where "keys.txt" is placed) in this distribution before executing - Makefile.PL. - - The most preferable one is "The Default Unicode Collation Element Table" - (aka DUCET), available from the Unicode Consortium's website: - - http://www.unicode.org/Public/UCA/ - - http://www.unicode.org/Public/UCA/latest/allkeys.txt (latest version) - - If DUCET is not installed, it is recommended to copy the file - from http://www.unicode.org/Public/UCA/latest/allkeys.txt - to <a place in @INC>/Unicode/Collate/allkeys.txt manually. - -HOW TO CHANGE DUCET (NOT WARRANTED) - - 0. rewriting UCA_Version and Base_Unicode_Version in Collate.pm - and t/version.t is preferred. - 1. replace Collate/allkeys.txt with a new DUCET. - 2. run mklocale to generate new Locale/*.pl and Korean.pm. - 3. replace Collate/Locale/*.pl with the new Locale/*.pl, - and Collate/CJK/Korean.pm with the new Korean.pm. - 4. make test. - IF FAIL, it may require more changes, not be easy. - AUTHOR, COPYRIGHT AND LICENSE The Unicode::Collate module for perl was written by SADAHIRO Tomoyuki, -<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2012, +<SADAHIRO@cpan.org>. This module is Copyright(C) 2001-2005, SADAHIRO Tomoyuki. Japan. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -The file Unicode/Collate/allkeys.txt was copied verbatim -from http://www.unicode.org/Public/UCA/6.2.0/allkeys.txt -For this file, Copyright (c) 2001-2012 Unicode, Inc. +The file Unicode/Collate/allkeys.txt was copied directly +from http://www.unicode.org/Public/UCA/4.1.0/allkeys.txt +This file is Copyright (c) 1991-2005 Unicode, Inc. All rights reserved. Distributed under the Terms of Use in http://www.unicode.org/copyright.html diff --git a/gnu/usr.bin/perl/cpan/Unicode-Normalize/Changes b/gnu/usr.bin/perl/cpan/Unicode-Normalize/Changes index fabd3c16a3e..e9cb3918a5e 100644 --- a/gnu/usr.bin/perl/cpan/Unicode-Normalize/Changes +++ b/gnu/usr.bin/perl/cpan/Unicode-Normalize/Changes @@ -1,59 +1,12 @@ Revision history for Perl extension Unicode::Normalize. -1.16 Sun Nov 4 17:23:03 2012 - - XSUB: use PERL_NO_GET_CONTEXT (see perlguts) - (see [rt.cpan.org #80312]) - -1.15 Sun Sep 23 10:43:14 2012 - - perl 5.11.0 or later: Install to 'site' instead of 'perl' - (see [rt.cpan.org #79801]) - -1.14 Sat Mar 10 13:34:53 2012 - - avoid "use Test". - -1.13 Mon Jul 25 21:07:49 2011 - - tried fixing the tarball with world writable files. - ( http://www.perlmonks.org/?node_id=731935 ) - -1.12 Mon May 16 23:36:07 2011 - - removed Normalize/CompExcl.pl and coded Composition Exclusions; - how to load CompExcl.pl seems not good, but I'm not sure... - -1.11 Sun May 15 20:31:09 2011 - - As perl 5.14.0 has removed unicore/CompositionExclusions.txt - from the installation, Normalize/CompExcl.pl in this distribution - is used instead. (see [rt.cpan.org #68106]) - -1.10 Sun Jan 16 21:00:34 2011 - - XSUB: reorder() and compose() treat with growing the string. - - XSUB: provision against UTF8_ALLOW_* flags to be undefined in future. - - doc: about perl 5.13.x and Unicode 6.0.0 - - doc and comments: [perl #81876] Fix typos by Peter J. Acklam. - -1.07 Mon Sep 20 20:20:02 2010 - - doc: about perl 5.12.x and Unicode 5.2.0 - - test: prototype of normalize_partial() and cousins in proto.t. - -1.06 Thu Feb 11 16:19:54 2010 - - mkheader/Pure Perl: fixed the internal _getHexArray() for perl 5.11.3 - changes (Bug #53197). - -1.05 Mon Sep 28 21:43:17 2009 - - normalize_partial() and NFX_partial(). { NFX =~ /^NFK?[CD]\z/ } - - added partial1.t for NFX_partial(). - - added partial2.t for normalize_partial(). - -1.04 Wed Sep 23 22:32:57 2009 - - doc: splitOnLastStarter() since 0.24 is now documented. - - test: some new tests are added to split.t. - 1.03 Sun Mar 29 12:56:23 2009 - mkheader: check if no composition needs growing the string. - Makefile.PL: a tweak 1.02 Tue Jun 5 22:46:45 2007 - XSUB: mkheader, _U_stringify() - avoid unpack('C*') on unicode. - - test: short.t removed - pure perl is not appropriate for test of + - test: short.t removed - pure perl is not inapprotiate for test of unicode edge cases. 1.01 Tue Jun 13 22:01:53 2006 @@ -90,7 +43,7 @@ Revision history for Perl extension Unicode::Normalize. - XSUB: even if string contains a malformed, "short" Unicode character, decompose() and reorder() will be safe. Garbage will be no longer added. - added null.t and short.t. - - now truly added illegal.t (in 0.27, forgot to change MANIFEST). + - now truely added illegal.t (in 0.27, forgot to change MANIFEST). 0.27 Sun Nov 16 13:16:21 2003 - Illegal code points (surrogate and noncharacter) will be allowed @@ -116,8 +69,7 @@ Revision history for Perl extension Unicode::Normalize. script files, named "enableXS" and "disableXS". (no longer <perl Makefile.PL xs> and <perl Makefile.PL noxs>.) * simplified Makefile.PL. - - added fcdc.t for FCD() and FCC(). - - added split.t for splitOnLastStarter(): an undocumented function. + - added fcdc.t and split.t. 0.23 Sat Jun 28 20:38:10 2003 - bug fix: \0-terminate in compose() in XS. diff --git a/gnu/usr.bin/perl/cpan/Unicode-Normalize/README b/gnu/usr.bin/perl/cpan/Unicode-Normalize/README index 1fcde2698e5..8a5390cc789 100644 --- a/gnu/usr.bin/perl/cpan/Unicode-Normalize/README +++ b/gnu/usr.bin/perl/cpan/Unicode-Normalize/README @@ -1,4 +1,4 @@ -Unicode/Normalize version 1.16 +Unicode/Normalize version 1.03 =================================== Unicode::Normalize - Unicode Normalization Forms @@ -62,6 +62,7 @@ which are included in recent perl core distributions. - unicore/CombiningClass.pl (or unicode/CombiningClass.pl) - unicore/Decomposition.pl (or unicode/Decomposition.pl) +- unicore/CompositionExclusions.txt (or unicode/CompExcl.txt) NOTES @@ -82,7 +83,7 @@ COPYRIGHT AND LICENSE SADAHIRO Tomoyuki <SADAHIRO@cpan.org> -Copyright(C) 2001-2012, SADAHIRO Tomoyuki. Japan. All rights reserved. +Copyright(C) 2001-2007, SADAHIRO Tomoyuki. Japan. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/cpan/Win32/Changes b/gnu/usr.bin/perl/cpan/Win32/Changes index f39250dcadb..b707793290b 100644 --- a/gnu/usr.bin/perl/cpan/Win32/Changes +++ b/gnu/usr.bin/perl/cpan/Win32/Changes @@ -1,195 +1,137 @@ -Revision history for the Perl extension Win32. - -0.47 [2013-02-21] - - Make sure %PROCESSOR_ARCHITECTURE% is defined before calling - Win32::GetArchName() in t/Names.t. It may be undefined when - the test is running under Cygwin crond. - - In t/Names.t don't assume that LoginName or NodeName is at - least 2 characters long; it may just be 1. - -0.46 [2013-02-19] - - add Win2012/Win8 detection (thanks to Michiel Beijen) [rt#82572] - [perl#116352] - -0.45 [2012-08-07] - - add Win32::GetACP(), Win32::GetConsoleCP(), - Win32::GetConsoleOutputCP(), Win32::GetOEMCP(), Win32::SetConsoleCP() - and Win32::SetConsoleOutputCP(). [rt#78820] (Steve Hay) - - adjust t/Unicode.t for Cygwin 1.7, where readdir() returns - the utf8 encoded filename without setting the SvUTF8 flag [rt#66751] - [rt#74332] - -0.44 [2011-01-12] - - fix memory leak introduced in 0.43 - -0.43 [2011-01-12] - - fix a few potential buffer overrun bugs reported by Alex Davies. - [perl#78710] - -0.42 [2011-01-06] - - remove brittle test for Win32::GetLongPathName($ENV{SYSTEMROOT}) - which will fail if the case of the environment value doesn't - exactly match the case of the directory name on the filesystem. - -0.41 [2010-12-10] - - Fix Win32::GetChipName() to return the native processor type when - running 32-bit Perl on 64-bit Windows (WOW64). This will also - affect the values returned by Win32::GetOSDisplayName() and - Win32::GetOSName(). [rt#63797] - - Fix Win32::GetOSDisplayName() to return the correct values for - all products even when a service pack has been installed. (This - was only an issue for some "special" editions). - - The display name for "Windows 7 Business Edition" is actually - "Windows 7 Professional". - - Fix t/GetOSName.t tests to avoid using the values returned by - GetSystemMetrics() when the test template didn't specify any - value at all. - -0.40 [2010-12-08] - - Add Win32::GetSystemMetrics function. - - Add Win32::GetProductInfo() function. - - Add Win32::GetOSDisplayName() function. - - Detect "Windows Server 2008 R2" as "Win2008" in Win32::GetOSName() - (used to return "Win7" before). [rt#57172] - - Detect "Windows Home Server" as "WinHomeSvr" in Win32::GetOSName() - (used to return "Win2003" before). - - Add "R2", "Media Center", "Tablet PC", "Starter Edition" etc. - tags to the description returned by Win32::GetOSName() in - list context. - - Rewrite the t/GetOSName.t tests - -0.39 [2009-01-19] - - Add support for Windows 2008 Server and Windows 7 in - Win32::GetOSName() and in the documentation for - Win32::GetOSVersion(). - - Make Win32::GetOSName() implementation testable. - - Document that the OSName for Win32s is actually "WinWin32s". - -0.38 [2008-06-27] - - Fix Cygwin releated problems in t/GetCurrentThreadId.t - (Jerry D. Hedden). - -0.37 [2008-06-26] - - Add Win32::GetCurrentProcessId() function - -0.36 [2008-04-17] - - Add typecasts for Win64 compilation - -0.35 [2008-03-31] - Integrate changes from bleadperl: - - Silence Borland compiler warning (Steve Hay) - - Fix memory leak in Win32::GetOSVersion (Vincent Pit) - - Test Win32::GetCurrentThreadId on cygwin (Reini Urban, Steve Hay) - -0.34 [2007-11-21] - - Document "WinVista" return value for Win32::GetOSName() - (Steve Hay). - -0.33 [2007-11-12] - - Update version to 0.33 for Perl 5.10 release - - Add $^O test in Makefile.PL for CPAN Testers - - Use Win32::GetLastError() instead of $^E in t/Names.t for - cygwin compatibility (Jerry D. Hedden). - -0.32 [2007-09-20] - - Additional #define's for older versions of VC++ (Dmitry Karasik). - - Win32::DomainName() doesn't return anything when the Workstation - service isn't running. Set $^E and adapt t/Names.t accordingly - (Steve Hay & Jerry D. Hedden). - - Fix t/Names.t to allow Win32::GetOSName() to return an empty - description as the 2nd return value (e.g. Vista without SP). - - Fix t/GetFileVersion.t for Perl 5.10 - -0.31 [2007-09-10] - - Apply Cygwin fixes from bleadperl (from Jerry D. Hedden). - - Make sure Win32::GetLongPathName() always returns drive - letters in uppercase (Jerry D. Hedden). - - Use uppercase environment variable names in t/Unicode.t - because the MSWin32 doesn't care, and Cygwin only works - with the uppercased version. - - new t/Names.t test (from Sébastien Aperghis-Tramoni) - -0.30 [2007-06-25] - - Fixed t/Unicode.t test for Cygwin (with help from Jerry D. Hedden). - - Fixed and documented Win32::GetShortPathName() to return undef - when the pathname doesn't exist (thanks to Steve Hay). - - Added t/GetShortPathName.t - -0.29 [2007-05-17] - - Fixed to compile with Borland BCC (thanks to Steve Hay). - -0.28_01 [2007-05-16] - - Increase version number as 0.28 was already used by an ActivePerl - release (for essentially 0.27 plus the Win32::IsAdminUser() change). - - - Add MODULE and PROTOTYPES directives to silence warnings from - newer versions of xsubpp. - - - Use the Cygwin codepath in Win32::GetFullPathName() when - PERL_IMPLICIT_SYS is not defined, because the other code - relies on the virtualization code in win32/vdir.h. - -0.27_02 [2007-05-15] - - We need Windows 2000 or later for the Unicode support because - WC_NO_BEST_FIT_CHARS is not supported on Windows NT. - - - Fix Win32::GetFullPathName() on Windows NT to return an - empty file part if the original argument ends with a slash. - -0.27_01 [2007-04-18] - - Update Win32::IsAdminUser() to use the IsUserAnAdmin() function - in shell32.dll when available. On Windows Vista this will only - return true if the process is running with elevated privileges - and not just when the owner of the process is a member of the - "Administrators" group. - - - Win32::ExpandEnvironmentStrings() may return a Unicode string - (a string containing characters outside the system codepage) - - - new Win32::GetANSIPathName() function returns a pathname in - a form containing only characters from the system codepage - - - Win32::GetCwd() will return an ANSI version of the directory - name if the long name contains characters outside the system - codepage. - - - Win32::GetFolderPath() will return an ANSI pathname. Call - Win32::GetLongPathName() to get the canonical Unicode - representation. - - - Win32::GetFullPathName() will return an ANSI pathname. Call - Win32::GetLongPathName() to get the canonical Unicode - representation. - - - Win32::GetLongPathName() may return a Unicode path name. - Call Win32::GetANSIPathName() to get a representation using - only characters from the system codepage. - - - Win32::LoginName() may return a Unicode string. - - - new Win32::OutputDebugString() function sends a string to - the debugger. - - - new Win32::GetCurrentThreadId() function returns the thread - id (to complement the process id in $$). - - - new Win32::CreateDirectory() creates a new directory. The - name of the directory may contain Unicode characters outside - the system codepage. - - - new Win32::CreateFile() creates a new file. The name of the - file may contain Unicode characters outside the system codepage. - - -0.27 [2007-03-07] - - Extracted from the libwin32 distribution to simplify maintenance - because Win32 is a dual-life core module since 5.8.4. - - - Win32.pm and Win32.xs updated to version in bleadperl. - This includes all the Win32::* function from win32/win32.c - in core Perl, except for Win32::SetChildShowWindows(). - - - Install into 'perl' directory instead of 'site' for Perl 5.8.4 - and later. - - - Add some simple tests. +Revision history for the Perl extension Win32.
+
+0.39 [2009-01-19]
+ - Add support for Windows 2008 Server and Windows 7 in
+ Win32::GetOSName() and in the documentation for
+ Win32::GetOSVersion().
+ - Make Win32::GetOSName() implementation testable.
+ - Document that the OSName for Win32s is actually "WinWin32s".
+
+0.38 [2008-06-27]
+ - Fix Cygwin releated problems in t/GetCurrentThreadId.t
+ (Jerry D. Hedden).
+
+0.37 [2008-06-26]
+ - Add Win32::GetCurrentProcessId() function
+
+0.36 [2008-04-17]
+ - Add typecasts for Win64 compilation
+
+0.35 [2008-03-31]
+ Integrate changes from bleadperl:
+ - Silence Borland compiler warning (Steve Hay)
+ - Fix memory leak in Win32::GetOSVersion (Vincent Pit)
+ - Test Win32::GetCurrentThreadId on cygwin (Reini Urban, Steve Hay)
+
+0.34 [2007-11-21]
+ - Document "WinVista" return value for Win32::GetOSName()
+ (Steve Hay).
+
+0.33 [2007-11-12]
+ - Update version to 0.33 for Perl 5.10 release
+ - Add $^O test in Makefile.PL for CPAN Testers
+ - Use Win32::GetLastError() instead of $^E in t/Names.t for
+ cygwin compatibility (Jerry D. Hedden).
+
+0.32 [2007-09-20]
+ - Additional #define's for older versions of VC++ (Dmitry Karasik).
+ - Win32::DomainName() doesn't return anything when the Workstation
+ service isn't running. Set $^E and adapt t/Names.t accordingly
+ (Steve Hay & Jerry D. Hedden).
+ - Fix t/Names.t to allow Win32::GetOSName() to return an empty
+ description as the 2nd return value (e.g. Vista without SP).
+ - Fix t/GetFileVersion.t for Perl 5.10
+
+0.31 [2007-09-10]
+ - Apply Cygwin fixes from bleadperl (from Jerry D. Hedden).
+ - Make sure Win32::GetLongPathName() always returns drive
+ letters in uppercase (Jerry D. Hedden).
+ - Use uppercase environment variable names in t/Unicode.t
+ because the MSWin32 doesn't care, and Cygwin only works
+ with the uppercased version.
+ - new t/Names.t test (from Sébastien Aperghis-Tramoni)
+
+0.30 [2007-06-25]
+ - Fixed t/Unicode.t test for Cygwin (with help from Jerry D. Hedden).
+ - Fixed and documented Win32::GetShortPathName() to return undef
+ when the pathname doesn't exist (thanks to Steve Hay).
+ - Added t/GetShortPathName.t
+
+0.29 [2007-05-17]
+ - Fixed to compile with Borland BCC (thanks to Steve Hay).
+
+0.28_01 [2007-05-16]
+ - Increase version number as 0.28 was already used by an ActivePerl
+ release (for essentially 0.27 plus the Win32::IsAdminUser() change).
+
+ - Add MODULE and PROTOTYPES directives to silence warnings from
+ newer versions of xsubpp.
+
+ - Use the Cygwin codepath in Win32::GetFullPathName() when
+ PERL_IMPLICIT_SYS is not defined, because the other code
+ relies on the virtualization code in win32/vdir.h.
+
+0.27_02 [2007-05-15]
+ - We need Windows 2000 or later for the Unicode support because
+ WC_NO_BEST_FIT_CHARS is not supported on Windows NT.
+
+ - Fix Win32::GetFullPathName() on Windows NT to return an
+ empty file part if the original argument ends with a slash.
+
+0.27_01 [2007-04-18]
+ - Update Win32::IsAdminUser() to use the IsUserAnAdmin() function
+ in shell32.dll when available. On Windows Vista this will only
+ return true if the process is running with elevated privileges
+ and not just when the owner of the process is a member of the
+ "Administrators" group.
+
+ - Win32::ExpandEnvironmentStrings() may return a Unicode string
+ (a string containing characters outside the system codepage)
+
+ - new Win32::GetANSIPathName() function returns a pathname in
+ a form containing only characters from the system codepage
+
+ - Win32::GetCwd() will return an ANSI version of the directory
+ name if the long name contains characters outside the system
+ codepage.
+
+ - Win32::GetFolderPath() will return an ANSI pathname. Call
+ Win32::GetLongPathName() to get the canonical Unicode
+ representation.
+
+ - Win32::GetFullPathName() will return an ANSI pathname. Call
+ Win32::GetLongPathName() to get the canonical Unicode
+ representation.
+
+ - Win32::GetLongPathName() may return a Unicode path name.
+ Call Win32::GetANSIPathName() to get a representation using
+ only characters from the system codepage.
+
+ - Win32::LoginName() may return a Unicode string.
+
+ - new Win32::OutputDebugString() function sends a string to
+ the debugger.
+
+ - new Win32::GetCurrentThreadId() function returns the thread
+ id (to complement the process id in $$).
+
+ - new Win32::CreateDirectory() creates a new directory. The
+ name of the directory may contain Unicode characters outside
+ the system codepage.
+
+ - new Win32::CreateFile() creates a new file. The name of the
+ file may contain Unicode characters outside the system codepage.
+
+
+0.27 [2007-03-07]
+ - Extracted from the libwin32 distribution to simplify maintenance
+ because Win32 is a dual-life core module since 5.8.4.
+
+ - Win32.pm and Win32.xs updated to version in bleadperl.
+ This includes all the Win32::* function from win32/win32.c
+ in core Perl, except for Win32::SetChildShowWindows().
+
+ - Install into 'perl' directory instead of 'site' for Perl 5.8.4
+ and later.
+
+ - Add some simple tests.
diff --git a/gnu/usr.bin/perl/cpan/Win32API-File/Changes b/gnu/usr.bin/perl/cpan/Win32API-File/Changes index bb149daf17e..9a691017a87 100644 --- a/gnu/usr.bin/perl/cpan/Win32API-File/Changes +++ b/gnu/usr.bin/perl/cpan/Win32API-File/Changes @@ -1,18 +1,5 @@ Revision history for Perl extension Win32API::File. -0.1201 by Alexandr Ciornii 2013-01-28 - - Fix tests on Cygwin (RURBAN) - - Constants for GetStdHandle and SetStdHandle - -0.1200 by Alexandr Ciornii 2011-07-01 - - Spelling fixes by Peter John Acklam - - Upgraded Makefile.PL - - Don't bother checking $[ - -0.1101_01 by Alexandr Ciornii 2011-02-26 - - More metadata in META.yml - - [Set|Get]StdHandle functions added (Chris 'BinGOs' Williams) - 0.1101 by Alexandr Ciornii 2008-11-17 - require Win32.pm (not core on Cygwin 5.8.8) - file.t uses Win32.pm only if necessary diff --git a/gnu/usr.bin/perl/cpan/Win32API-File/README b/gnu/usr.bin/perl/cpan/Win32API-File/README index 056bfb28d52..93d287a2d5d 100644 --- a/gnu/usr.bin/perl/cpan/Win32API-File/README +++ b/gnu/usr.bin/perl/cpan/Win32API-File/README @@ -1,4 +1,4 @@ -Win32API::File v0.1200 -- Low-level access to Win32 API calls for files. +Win32API::File v0.08 -- Low-level access to Win32 API calls for files. New since v0.07: @@ -130,7 +130,7 @@ technical questions that are not full bug reports to http://perlmonks.org/index.pl?node=Seekers%20of%20Perl%20Wisdom -Tye McQueen, tye@metronet.com, http://perlmonks.org/?node=tye. +Tye McQueen, tye@metronet.com, http://www.metronet.com/~tye/. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/dist/B-Deparse/Deparse.pm b/gnu/usr.bin/perl/dist/B-Deparse/Deparse.pm index d62fe3bc5fe..fc0125d62f5 100644 --- a/gnu/usr.bin/perl/dist/B-Deparse/Deparse.pm +++ b/gnu/usr.bin/perl/dist/B-Deparse/Deparse.pm @@ -11,45 +11,38 @@ package B::Deparse; use Carp; use B qw(class main_root main_start main_cv svref_2object opnumber perlstring OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST - OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD + OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD OPpPAD_STATE OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY - OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER - OPpSORT_REVERSE + OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER + OPpSORT_REVERSE OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED + OPpREVERSE_INPLACE SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG CVf_METHOD CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE - PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); -$VERSION = '1.20'; + PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED), + ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'), + ($] < 5.011 ? 'CVf_LOCKED' : ()); +$VERSION = 0.97; use strict; use vars qw/$AUTOLOAD/; use warnings (); -require feature; BEGIN { - # List version-specific constants here. - # Easiest way to keep this code portable between version looks to - # be to fake up a dummy constant that will never actually be true. - foreach (qw(OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED OPpCONST_NOVER - OPpPAD_STATE PMf_SKIPWHITE RXf_SKIPWHITE - RXf_PMf_CHARSET RXf_PMf_KEEPCOPY - CVf_LOCKED OPpREVERSE_INPLACE OPpSUBSTR_REPL_FIRST - PMf_NONDESTRUCT OPpCONST_ARYBASE OPpEVAL_BYTES)) { - eval { import B $_ }; - no strict 'refs'; - *{$_} = sub () {0} unless *{$_}{CODE}; - } + # Easiest way to keep this code portable between 5.12.x and 5.10.x looks to + # be to fake up a dummy CVf_LOCKED that will never actually be true. + *CVf_LOCKED = sub () {0} unless defined &CVf_LOCKED; } # Changes between 0.50 and 0.51: # - fixed nulled leave with live enter in sort { } # - fixed reference constants (\"str") # - handle empty programs gracefully -# - handle infinite loops (for (;;) {}, while (1) {}) -# - differentiate between 'for my $x ...' and 'my $x; for $x ...' +# - handle infinte loops (for (;;) {}, while (1) {}) +# - differentiate between `for my $x ...' and `my $x; for $x ...' # - various minor cleanups # - moved globals into an object -# - added '-u', like B::C +# - added `-u', like B::C # - package declarations using cop_stash # - subs, formats and code sorted by cop_seq # Changes between 0.51 and 0.52: @@ -57,10 +50,10 @@ BEGIN { # - added documentation # Changes between 0.52 and 0.53: # - many changes adding precedence contexts and associativity -# - added '-p' and '-s' output style options +# - added `-p' and `-s' output style options # - various other minor fixes # Changes between 0.53 and 0.54: -# - added support for new 'for (1..100)' optimization, +# - added support for new `for (1..100)' optimization, # thanks to Gisle Aas # Changes between 0.54 and 0.55: # - added support for new qr// construct @@ -69,16 +62,16 @@ BEGIN { # - tested on base/*.t, cmd/*.t, comp/*.t, io/*.t # - fixed $# on non-lexicals broken in last big rewrite # - added temporary fix for change in opcode of OP_STRINGIFY -# - fixed problem in 0.54's for() patch in 'for (@ary)' +# - fixed problem in 0.54's for() patch in `for (@ary)' # - fixed precedence in conditional of ?: -# - tweaked list paren elimination in 'my($x) = @_' +# - tweaked list paren elimination in `my($x) = @_' # - made continue-block detection trickier wrt. null ops # - fixed various prototype problems in pp_entersub # - added support for sub prototypes that never get GVs # - added unquoting for special filehandle first arg in truncate -# - print doubled rv2gv (a bug) as '*{*GV}' instead of illegal '**GV' +# - print doubled rv2gv (a bug) as `*{*GV}' instead of illegal `**GV' # - added semicolons at the ends of blocks -# - added -l '#line' declaration option -- fixes cmd/subval.t 27,28 +# - added -l `#line' declaration option -- fixes cmd/subval.t 27,28 # Changes between 0.56 and 0.561: # - fixed multiply-declared my var in pp_truncate (thanks to Sarathy) # - used new B.pm symbolic constants (done by Nick Ing-Simmons) @@ -91,7 +84,7 @@ BEGIN { # Changes after 0.57: # - added parens in \&foo (patch by Albert Dvornik) # Changes between 0.57 and 0.58: -# - fixed '0' statements that weren't being printed +# - fixed `0' statements that weren't being printed # - added methods for use from other programs # (based on patches from James Duncan and Hugo van der Sanden) # - added -si and -sT to control indenting (also based on a patch from Hugo) @@ -103,12 +96,12 @@ BEGIN { # Changes between 0.58 and 0.59 # - added support for Chip's OP_METHOD_NAMED # - added support for Ilya's OPpTARGET_MY optimization -# - elided arrows before '()' subscripts when possible +# - elided arrows before `()' subscripts when possible # Changes between 0.59 and 0.60 -# - support for method attributes was added +# - support for method attribues was added # - some warnings fixed # - separate recognition of constant subs -# - rewrote continue block handling, now recognizing for loops +# - rewrote continue block handling, now recoginizing for loops # - added more control of expanding control structures # Changes between 0.60 and 0.61 (mostly by Robin Houston) # - many bug-fixes @@ -153,7 +146,7 @@ BEGIN { # - configurable syntax highlighting: ANSI color, HTML, TeX, etc. # - more style options: brace style, hex vs. octal, quotes, ... # - print big ints as hex/octal instead of decimal (heuristic?) -# - handle 'my $x if 0'? +# - handle `my $x if 0'? # - version using op_next instead of op_first/sibling? # - avoid string copies (pass arrays, one big join?) # - here-docs? @@ -166,7 +159,7 @@ BEGIN { # 'use warnings; BEGIN {${^WARNING_BITS} eq "U"x12;} use warnings::register' # op/getpid 2 - can't assign to shared my() declaration (threads only) # 'my $x : shared = 5' -# op/override 7 - parens on overridden require change v-string interpretation +# op/override 7 - parens on overriden require change v-string interpretation # 'BEGIN{*CORE::GLOBAL::require=sub {}} require v5.6' # c.f. 'BEGIN { *f = sub {0} }; f 2' # op/pat 774 - losing Unicode-ness of Latin1-only strings @@ -219,8 +212,7 @@ BEGIN { # CV for current sub (or main program) being deparsed # # curcvlex: -# Cached hash of lexical variables for curcv: keys are -# names prefixed with "m" or "o" (representing my/our), and +# Cached hash of lexical variables for curcv: keys are names, # each value is an array of pairs, indicating the cop_seq of scopes # in which a var of that name is valid. # @@ -243,8 +235,7 @@ BEGIN { # # subs_declared # keys are names of subs for which we've printed declarations. -# That means we can omit parentheses from the arguments. It also means we -# need to put CORE:: on core functions of the same name. +# That means we can omit parentheses from the arguments. # # subs_deparsed # Keeps track of fully qualified names of all deparsed subs. @@ -252,7 +243,7 @@ BEGIN { # parens: -p # linenums: -l # unquote: -q -# cuddle: ' ' or '\n', depending on -sC +# cuddle: ` ' or `\n', depending on -sC # indent_size: -si # use_tabs: -sT # ex_const: -sv @@ -266,7 +257,7 @@ BEGIN { # they're inside an expression or at statement level, etc. (see # chart below). When ops with children call deparse on them, they pass # along their precedence. Fractional values are used to implement -# associativity ('($x + $y) + $z' => '$x + $y + $y') and related +# associativity (`($x + $y) + $z' => `$x + $y + $y') and related # parentheses hacks. The major disadvantage of this scheme is that # it doesn't know about right sides and left sides, so say if you # assign a listop to a variable, it can't tell it's allowed to leave @@ -301,125 +292,15 @@ BEGIN { # 1 statement modifiers # 0.5 statements, but still print scopes as do { ... } # 0 statement level -# -1 format body # Nonprinting characters with special meaning: # \cS - steal parens (see maybe_parens_unop) # \n - newline and indent # \t - increase indent -# \b - decrease indent ('outdent') +# \b - decrease indent (`outdent') # \f - flush left (no indent) # \cK - kill following semicolon, if any - - - -# _pessimise_walk(): recursively walk the optree of a sub, -# possibly undoing optimisations along the way. - -sub _pessimise_walk { - my ($self, $startop) = @_; - - return unless $$startop; - my ($op, $prevop); - for ($op = $startop; $$op; $prevop = $op, $op = $op->sibling) { - my $ppname = $op->name; - - # pessimisations start here - - if ($ppname eq "padrange") { - # remove PADRANGE: - # the original optimisation either (1) changed this: - # pushmark -> (various pad and list and null ops) -> the_rest - # or (2), for the = @_ case, changed this: - # pushmark -> gv[_] -> rv2av -> (pad stuff) -> the_rest - # into this: - # padrange ----------------------------------------> the_rest - # so we just need to convert the padrange back into a - # pushmark, and in case (1), set its op_next to op_sibling, - # which is the head of the original chain of optimised-away - # pad ops, or for (2), set it to sibling->first, which is - # the original gv[_]. - - $B::overlay->{$$op} = { - name => 'pushmark', - private => ($op->private & OPpLVAL_INTRO), - next => ($op->flags & OPf_SPECIAL) - ? $op->sibling->first - : $op->sibling, - }; - } - - # pessimisations end here - - if (class($op) eq 'PMOP' - && ref($op->pmreplroot) - && ${$op->pmreplroot} - && $op->pmreplroot->isa( 'B::OP' )) - { - $self-> _pessimise_walk($op->pmreplroot); - } - - if ($op->flags & OPf_KIDS) { - $self-> _pessimise_walk($op->first); - } - - } -} - - -# _pessimise_walk_exe(): recursively walk the op_next chain of a sub, -# possibly undoing optimisations along the way. - -sub _pessimise_walk_exe { - my ($self, $startop, $visited) = @_; - - return unless $$startop; - return if $visited->{$$startop}; - my ($op, $prevop); - for ($op = $startop; $$op; $prevop = $op, $op = $op->next) { - last if $visited->{$$op}; - $visited->{$$op} = 1; - my $ppname = $op->name; - if ($ppname =~ - /^((and|d?or)(assign)?|(map|grep)while|range|cond_expr|once)$/ - # entertry is also a logop, but its op_other invariably points - # into the same chain as the main execution path, so we skip it - ) { - $self->_pessimise_walk_exe($op->other, $visited); - } - elsif ($ppname eq "subst") { - $self->_pessimise_walk_exe($op->pmreplstart, $visited); - } - elsif ($ppname =~ /^(enter(loop|iter))$/) { - # redoop and nextop will already be covered by the main block - # of the loop - $self->_pessimise_walk_exe($op->lastop, $visited); - } - - # pessimisations start here - } -} - -# Go through an optree and and "remove" some optimisations by using an -# overlay to selectively modify or un-null some ops. Deparsing in the -# absence of those optimisations is then easier. -# -# Note that older optimisations are not removed, as Deparse was already -# written to recognise them before the pessimise/overlay system was added. - -sub pessimise { - my ($self, $root, $start) = @_; - - # walk tree in root-to-branch order - $self->_pessimise_walk($root); - - my %visited; - # walk tree in execution order - $self->_pessimise_walk_exe($start, \%visited); -} - - sub null { my $op = shift; return class($op) eq "NULL"; @@ -486,8 +367,6 @@ sub begin_is_use { my ($self, $cv) = @_; my $root = $cv->ROOT; local @$self{qw'curcv curcvlex'} = ($cv); - local $B::overlay = {}; - $self->pessimise($root, $cv->START); #require B::Debug; #B::walkoptree($cv->ROOT, "debug"); my $lineseq = $root->first; @@ -584,7 +463,7 @@ sub begin_is_use { } sub stash_subs { - my ($self, $pack, $seen) = @_; + my ($self, $pack) = @_; my (@ret, $stash); if (!defined $pack) { $pack = ''; @@ -593,12 +472,8 @@ sub stash_subs { else { $pack =~ s/(::)?$/::/; no strict 'refs'; - $stash = \%{"main::$pack"}; + $stash = \%$pack; } - return - if ($seen ||= {})->{ - $INC{"overload.pm"} ? overload::StrVal($stash) : $stash - }++; my %stash = svref_2object($stash)->ARRAY; while (my ($key, $val) = each %stash) { my $class = class($val); @@ -637,7 +512,9 @@ sub stash_subs { $self->todo($cv, 1); } if (class($val->HV) ne "SPECIAL" && $key =~ /::$/) { - $self->stash_subs($pack . $key, $seen); + $self->stash_subs($pack . $key) + unless $pack eq '' && $key eq 'main::'; + # avoid infinite recursion } } } @@ -791,12 +668,8 @@ sub compile { print $self->print_protos; @{$self->{'subs_todo'}} = sort {$a->[0] <=> $b->[0]} @{$self->{'subs_todo'}}; - my $root = main_root; - local $B::overlay = {}; - unless (null $root) { - $self->pessimise($root, main_start); - print $self->indent($self->deparse_root($root)), "\n"; - } + print $self->indent($self->deparse_root(main_root)), "\n" + unless null main_root; my @text; while (scalar(@{$self->{'subs_todo'}})) { push @text, $self->next_todo; @@ -825,11 +698,6 @@ sub coderef2text { return $self->indent($self->deparse_sub(svref_2object($sub))); } -my %strict_bits = do { - local $^H; - map +($_ => strict::bits($_)), qw/refs subs vars/ -}; - sub ambient_pragmas { my $self = shift; my ($arybase, $hint_bits, $warning_bits, $hinthash) = (0, 0); @@ -842,7 +710,7 @@ sub ambient_pragmas { require strict; if ($val eq 'none') { - $hint_bits &= $strict_bits{$_} for qw/refs subs vars/; + $hint_bits &= ~strict::bits(qw/refs subs vars/); next(); } @@ -856,15 +724,11 @@ sub ambient_pragmas { else { @names = split' ', $val; } - $hint_bits |= $strict_bits{$_} for @names; + $hint_bits |= strict::bits(@names); } elsif ($name eq '$[') { - if (OPpCONST_ARYBASE) { - $arybase = $val; - } else { - croak "\$[ can't be non-zero on this perl" unless $val == 0; - } + $arybase = $val; } elsif ($name eq 'integer' @@ -1004,17 +868,14 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); local(@$self{qw'curstash warnings hints hinthash'}) = @$self{qw'curstash warnings hints hinthash'}; my $body; - my $root = $cv->ROOT; - local $B::overlay = {}; - if (not null $root) { - $self->pessimise($root, $cv->START); - my $lineseq = $root->first; + if (not null $cv->ROOT) { + my $lineseq = $cv->ROOT->first; if ($lineseq->name eq "lineseq") { my @ops; for(my$o=$lineseq->first; $$o; $o=$o->sibling) { push @ops, $o; } - $body = $self->lineseq(undef, 0, @ops).";"; + $body = $self->lineseq(undef, @ops).";"; my $scope_en = $self->find_scope_en($lineseq); if (defined $scope_en) { my $subs = join"", $self->seq_subs($scope_en); @@ -1022,7 +883,7 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); } } else { - $body = $self->deparse($root->first, 0); + $body = $self->deparse($cv->ROOT->first, 0); } } else { @@ -1047,8 +908,6 @@ sub deparse_format { local(@$self{qw'curstash warnings hints hinthash'}) = @$self{qw'curstash warnings hints hinthash'}; my $op = $form->ROOT; - local $B::overlay = {}; - $self->pessimise($op, $form->START); my $kid; return "\f." if $op->first->name eq 'stub' || $op->first->name eq 'nextstate'; @@ -1060,8 +919,7 @@ sub deparse_format { push @text, "\f".$self->const_sv($kid)->PV; $kid = $kid->sibling; for (; not null $kid; $kid = $kid->sibling) { - push @exprs, $self->deparse($kid, -1); - $exprs[-1] =~ s/;\z//; + push @exprs, $self->deparse($kid, 0); } push @text, "\f".join(", ", @exprs)."\n" if @exprs; $op = $op->sibling; @@ -1082,7 +940,7 @@ sub is_state { return $name eq "nextstate" || $name eq "dbstate" || $name eq "setstate"; } -sub is_miniwhile { # check for one-line loop ('foo() while $y--') +sub is_miniwhile { # check for one-line loop (`foo() while $y--') my $op = shift; return (!null($op) and null($op->sibling) and $op->name eq "null" and class($op) eq "UNOP" @@ -1100,19 +958,14 @@ sub is_for_loop { my $op = shift; # This OP might be almost anything, though it won't be a # nextstate. (It's the initialization, so in the canonical case it - # will be an sassign.) The sibling is (old style) a lineseq whose - # first child is a nextstate and whose second is a leaveloop, or - # (new style) an unstack whose sibling is a leaveloop. + # will be an sassign.) The sibling is a lineseq whose first child + # is a nextstate and whose second is a leaveloop. my $lseq = $op->sibling; - return 0 unless !is_state($op) and !null($lseq); - if ($lseq->name eq "lineseq") { + if (!is_state $op and !null($lseq) and $lseq->name eq "lineseq") { if ($lseq->first && !null($lseq->first) && is_state($lseq->first) && (my $sib = $lseq->first->sibling)) { return (!null($sib) && $sib->name eq "leaveloop"); } - } elsif ($lseq->name eq "unstack" && ($lseq->flags & OPf_SPECIAL)) { - my $sib = $lseq->sibling; - return $sib && !null($sib) && $sib->name eq "leaveloop"; } return 0; } @@ -1142,7 +995,7 @@ sub maybe_parens { } } -# same as above, but get around the 'if it looks like a function' rule +# same as above, but get around the `if it looks like a function' rule sub maybe_parens_unop { my $self = shift; my($name, $kid, $cx) = @_; @@ -1151,19 +1004,18 @@ sub maybe_parens_unop { if ($name eq "umask" && $kid =~ /^\d+$/) { $kid = sprintf("%#o", $kid); } - return $self->keyword($name) . "($kid)"; + return "$name($kid)"; } else { $kid = $self->deparse($kid, 16); if ($name eq "umask" && $kid =~ /^\d+$/) { $kid = sprintf("%#o", $kid); } - $name = $self->keyword($name); if (substr($kid, 0, 1) eq "\cS") { # use kid's parens return $name . substr($kid, 1); } elsif (substr($kid, 0, 1) eq "(") { # avoid looks-like-a-function trap with extra parens - # ('+' can lead to ambiguities) + # (`+' can lead to ambiguities) return "$name(" . $kid . ")"; } else { return "$name $kid"; @@ -1189,11 +1041,9 @@ sub maybe_local { and not $self->{'avoid_local'}{$$op}) { my $our_local = ($op->private & OPpLVAL_INTRO) ? "local" : "our"; if( $our_local eq 'our' ) { - if ( $text !~ /^\W(\w+::)*\w+\z/ - and !utf8::decode($text) || $text !~ /^\W(\w+::)*\w+\z/ - ) { - die "Unexpected our($text)\n"; - } + # XXX This assertion fails code with non-ASCII identifiers, + # like ./ext/Encode/t/jperl.t + die "Unexpected our($text)\n" unless $text =~ /^\W(\w+::)*\w+\z/; $text =~ s/(\w+::)+//; } if (want_scalar($op)) { @@ -1228,9 +1078,7 @@ sub maybe_my { my $self = shift; my($op, $cx, $text) = @_; if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) { - my $my = $op->private & OPpPAD_STATE - ? $self->keyword("state") - : "my"; + my $my = $op->private & OPpPAD_STATE ? "state" : "my"; if (want_scalar($op)) { return "$my $text"; } else { @@ -1261,7 +1109,7 @@ sub DESTROY {} # Do not AUTOLOAD # any subroutine declarations to the deparsed ops, otherwise we # append appropriate declarations. sub lineseq { - my($self, $root, $cx, @ops) = @_; + my($self, $root, @ops) = @_; my($expr, @exprs); my $out_cop = $self->{'curcop'}; @@ -1282,13 +1130,12 @@ sub lineseq { $self->walk_lineseq($root, \@ops, sub { push @exprs, $_[0]} ); - my $sep = $cx ? '; ' : ";\n"; - my $body = join($sep, grep {length} @exprs); + my $body = join(";\n", grep {length} @exprs); my $subs = ""; if (defined $root && defined $limit_seq && !$self->{'in_format'}) { $subs = join "\n", $self->seq_subs($limit_seq); } - return join($sep, grep {length} $body, $subs); + return join(";\n", grep {length} $body, $subs); } sub scopeop { @@ -1323,10 +1170,9 @@ sub scopeop { push @kids, $kid; } if ($cx > 0) { # inside an expression, (a do {} while for lineseq) - my $body = $self->lineseq($op, 0, @kids); - return is_lexical_subs(@kids) ? $body : "do {\n\t$body\n\b}"; + return "do {\n\t" . $self->lineseq($op, @kids) . "\n\b}"; } else { - my $lineseq = $self->lineseq($op, $cx, @kids); + my $lineseq = $self->lineseq($op, @kids); return (length ($lineseq) ? "$lineseq;" : ""); } } @@ -1367,8 +1213,7 @@ sub walk_lineseq { } } if (is_for_loop($kids[$i])) { - $callback->($expr . $self->for_loop($kids[$i], 0), - $i += $kids[$i]->sibling->name eq "unstack" ? 2 : 1); + $callback->($expr . $self->for_loop($kids[$i], 0), $i++); next; } $expr .= $self->deparse($kids[$i], (@kids != 1)/2); @@ -1386,35 +1231,32 @@ BEGIN { map($globalnames{$_}++, "SIG", "STDIN", "STDOUT", "STDERR", "INC", sub gv_name { my $self = shift; my $gv = shift; - my $raw = shift; Carp::confess() unless ref($gv) eq "B::GV"; my $stash = $gv->STASH->NAME; - my $name = $raw ? $gv->NAME : $gv->SAFENAME; + my $name = $gv->SAFENAME; if ($stash eq 'main' && $name =~ /^::/) { $stash = '::'; } - elsif (($stash eq 'main' - && ($globalnames{$name} || $name =~ /^[^A-Za-z_:]/)) + elsif (($stash eq 'main' && $globalnames{$name}) or ($stash eq $self->{'curstash'} && !$globalnames{$name} && ($stash eq 'main' || $name !~ /::/)) - ) + or $name =~ /^[^A-Za-z_:]/) { $stash = ""; } else { $stash = $stash . "::"; } - if (!$raw and $name =~ /^(\^..|{)/) { + if ($name =~ /^(\^..|{)/) { $name = "{$name}"; # ${^WARNING_BITS}, etc and ${ } return $stash . $name; } # Return the name to use for a stash variable. -# If a lexical with the same name is in scope, or -# if strictures are enabled, it may need to be +# If a lexical with the same name is in scope, it may need to be # fully-qualified. sub stash_variable { - my ($self, $prefix, $name, $cx) = @_; + my ($self, $prefix, $name) = @_; return "$prefix$name" if $name =~ /::/; @@ -1423,55 +1265,13 @@ sub stash_variable { return "$prefix$name"; } - if ($name =~ /^[^\w+-]$/) { - if (defined $cx && $cx == 26) { - if ($prefix eq '@') { - return "$prefix\{$name}"; - } - elsif ($name eq '#') { return '${#}' } # "${#}a" vs "$#a" - } - if ($prefix eq '$#') { - return "\$#{$name}"; - } - } - - return $prefix . $self->maybe_qualify($prefix, $name); -} - -# Return just the name, without the prefix. It may be returned as a quoted -# string. The second return value is a boolean indicating that. -sub stash_variable_name { - my($self, $prefix, $gv) = @_; - my $name = $self->gv_name($gv, 1); - $name = $self->maybe_qualify($prefix,$name); - if ($name =~ /^(?:\S|(?!\d)[\ca-\cz]?(?:\w|::)*|\d+)\z/) { - $name =~ s/^([\ca-\cz])/'^'.($1|'@')/e; - $name =~ /^(\^..|{)/ and $name = "{$name}"; - return $name, 0; # not quoted - } - else { - single_delim("q", "'", $name), 1; - } -} - -sub maybe_qualify { - my ($self,$prefix,$name) = @_; my $v = ($prefix eq '$#' ? '@' : $prefix) . $name; - return $name if !$prefix || $name =~ /::/; - return $self->{'curstash'}.'::'. $name - if - $name =~ /^(?!\d)\w/ # alphabetic - && $v !~ /^\$[ab]\z/ # not $a or $b - && !$globalnames{$name} # not a global name - && $self->{hints} & $strict_bits{vars} # strict vars - && !$self->lex_in_scope($v,1) # no "our" - or $self->lex_in_scope($v); # conflicts with "my" variable - return $name; + return $prefix .$self->{'curstash'}.'::'. $name if $self->lex_in_scope($v); + return "$prefix$name"; } sub lex_in_scope { - my ($self, $name, $our) = @_; - substr $name, 0, 0, = $our ? 'o' : 'm'; # our/my + my ($self, $name) = @_; $self->populate_curcvlex() if !defined $self->{'curcvlex'}; return 0 if !defined($self->{'curcop'}); @@ -1495,6 +1295,7 @@ sub populate_curcvlex { for (my $i=0; $i<@ns; ++$i) { next if class($ns[$i]) eq "SPECIAL"; + next if $ns[$i]->FLAGS & SVpad_OUR; # Skip "our" vars if (class($ns[$i]) eq "PV") { # Probably that pesky lexical @_ next; @@ -1505,9 +1306,7 @@ sub populate_curcvlex { ? (0, 999999) : ($ns[$i]->COP_SEQ_RANGE_LOW, $ns[$i]->COP_SEQ_RANGE_HIGH); - push @{$self->{'curcvlex'}{ - ($ns[$i]->FLAGS & SVpad_OUR ? 'o' : 'm') . $name - }}, [$seq_st, $seq_en]; + push @{$self->{'curcvlex'}{$name}}, [$seq_st, $seq_en]; } } } @@ -1573,14 +1372,6 @@ sub seq_subs { return @text; } -sub _features_from_bundle { - my ($hints, $hh) = @_; - foreach (@{$feature::feature_bundle{@feature::hint_bundles[$hints >> $feature::hint_shift]}}) { - $hh->{$feature::feature{$_}} = 1; - } - return $hh; -} - # Notice how subs and formats are inserted between statements here; # also $[ assignments and pragmas. sub pp_nextstate { @@ -1595,7 +1386,7 @@ sub pp_nextstate { $self->{'curstash'} = $stash; } - if (OPpCONST_ARYBASE && $self->{'arybase'} != $op->arybase) { + if ($self->{'arybase'} != $op->arybase) { push @text, '$[ = '. $op->arybase .";\n"; $self->{'arybase'} = $op->arybase; } @@ -1621,48 +1412,17 @@ sub pp_nextstate { $self->{'warnings'} = $warning_bits; } - my $hints = $] < 5.008009 ? $op->private : $op->hints; - my $old_hints = $self->{'hints'}; - if ($self->{'hints'} != $hints) { - push @text, declare_hints($self->{'hints'}, $hints); - $self->{'hints'} = $hints; - } - - my $newhh; - if ($] > 5.009) { - $newhh = $op->hints_hash->HASH; - } - - if ($] >= 5.015006) { - # feature bundle hints - my $from = $old_hints & $feature::hint_mask; - my $to = $ hints & $feature::hint_mask; - if ($from != $to) { - if ($to == $feature::hint_mask) { - if ($self->{'hinthash'}) { - delete $self->{'hinthash'}{$_} - for grep /^feature_/, keys %{$self->{'hinthash'}}; - } - else { $self->{'hinthash'} = {} } - $self->{'hinthash'} - = _features_from_bundle($from, $self->{'hinthash'}); - } - else { - my $bundle = - $feature::hint_bundles[$to >> $feature::hint_shift]; - $bundle =~ s/(\d[13579])\z/$1+1/e; # 5.11 => 5.12 - push @text, "no feature;\n", - "use feature ':$bundle';\n"; - } - } + if ($self->{'hints'} != $op->hints) { + push @text, declare_hints($self->{'hints'}, $op->hints); + $self->{'hints'} = $op->hints; } - if ($] > 5.009) { - push @text, declare_hinthash( - $self->{'hinthash'}, $newhh, - $self->{indent_size}, $self->{hints}, - ); - $self->{'hinthash'} = $newhh; + # hack to check that the hint hash hasn't changed + if ($] > 5.009 && + "@{[sort %{$self->{'hinthash'} || {}}]}" + ne "@{[sort %{$op->hints_hash->HASH || {}}]}") { + push @text, declare_hinthash($self->{'hinthash'}, $op->hints_hash->HASH, $self->{indent_size}); + $self->{'hinthash'} = $op->hints_hash->HASH; } # This should go after of any branches that add statements, to @@ -1709,77 +1469,32 @@ my %ignored_hints = ( 'open<' => 1, 'open>' => 1, ':' => 1, - 'strict/refs' => 1, - 'strict/subs' => 1, - 'strict/vars' => 1, ); -my %rev_feature; - sub declare_hinthash { - my ($from, $to, $indent, $hints) = @_; - my $doing_features = - ($hints & $feature::hint_mask) == $feature::hint_mask; + my ($from, $to, $indent) = @_; my @decls; - my @features; - my @unfeatures; # bugs? - for my $key (sort keys %$to) { + for my $key (keys %$to) { next if $ignored_hints{$key}; - my $is_feature = $key =~ /^feature_/ && $^V ge 5.15.6; - next if $is_feature and not $doing_features; - if (!exists $from->{$key} or $from->{$key} ne $to->{$key}) { - push(@features, $key), next if $is_feature; - push @decls, - qq(\$^H{) . single_delim("q", "'", $key) . qq(} = ) - . ( - defined $to->{$key} - ? single_delim("q", "'", $to->{$key}) - : 'undef' - ) - . qq(;); + if (!defined $from->{$key} or $from->{$key} ne $to->{$key}) { + push @decls, qq(\$^H{'$key'} = q($to->{$key});); } } - for my $key (sort keys %$from) { + for my $key (keys %$from) { next if $ignored_hints{$key}; - my $is_feature = $key =~ /^feature_/ && $^V ge 5.15.6; - next if $is_feature and not $doing_features; if (!exists $to->{$key}) { - push(@unfeatures, $key), next if $is_feature; push @decls, qq(delete \$^H{'$key'};); } } - my @ret; - if (@features || @unfeatures) { - if (!%rev_feature) { %rev_feature = reverse %feature::feature } - } - if (@features) { - push @ret, "use feature " - . join(", ", map "'$rev_feature{$_}'", @features) . ";\n"; - } - if (@unfeatures) { - push @ret, "no feature " - . join(", ", map "'$rev_feature{$_}'", @unfeatures) - . ";\n"; - } - @decls and - push @ret, - join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n"; - return @ret; + @decls or return ''; + return join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n"; } sub hint_pragmas { my ($bits) = @_; - my (@pragmas, @strict); + my @pragmas; push @pragmas, "integer" if $bits & 0x1; - for (sort keys %strict_bits) { - push @strict, "'$_'" if $bits & $strict_bits{$_}; - } - if (@strict == keys %strict_bits) { - push @pragmas, "strict"; - } - elsif (@strict) { - push @pragmas, "strict " . join ', ', @strict; - } + push @pragmas, "strict 'refs'" if $bits & 0x2; push @pragmas, "bytes" if $bits & 0x8; return @pragmas; } @@ -1789,63 +1504,10 @@ sub pp_setstate { pp_nextstate(@_) } sub pp_unstack { return "" } # see also leaveloop -my %feature_keywords = ( - # keyword => 'feature', - state => 'state', - say => 'say', - given => 'switch', - when => 'switch', - default => 'switch', - break => 'switch', - evalbytes=>'evalbytes', - __SUB__ => '__SUB__', - fc => 'fc', -); - -# keywords that are strong and also have a prototype -# -my %strong_proto_keywords = map { $_ => 1 } qw( - glob - pos - prototype - scalar - study - undef -); - -sub keyword { - my $self = shift; - my $name = shift; - return $name if $name =~ /^CORE::/; # just in case - if (exists $feature_keywords{$name}) { - my $hh; - my $hints = $self->{hints} & $feature::hint_mask; - if ($hints && $hints != $feature::hint_mask) { - $hh = _features_from_bundle($hints); - } - elsif ($hints) { $hh = $self->{'hinthash'} } - return "CORE::$name" - if !$hh - || !$hh->{"feature_$feature_keywords{$name}"} - } - if ($strong_proto_keywords{$name} - || ($name !~ /^(?:chom?p|do|exec|glob|s(?:elect|ystem))\z/ - && !defined eval{prototype "CORE::$name"}) - ) { return $name } - if ( - exists $self->{subs_declared}{$name} - or - exists &{"$self->{curstash}::$name"} - ) { - return "CORE::$name" - } - return $name; -} - sub baseop { my $self = shift; my($op, $cx, $name) = @_; - return $self->keyword($name); + return $name; } sub pp_stub { @@ -1890,13 +1552,7 @@ sub pfixop { my($op, $cx, $name, $prec, $flags) = (@_, 0); my $kid = $op->first; $kid = $self->deparse($kid, $prec); - return $self->maybe_parens(($flags & POSTFIX) - ? "$kid$name" - # avoid confusion with filetests - : $name eq '-' - && $kid =~ /^[a-zA-Z](?!\w)/ - ? "$name($kid)" - : "$name$kid", + return $self->maybe_parens(($flags & POSTFIX) ? "$kid$name" : "$name$kid", $cx, $prec); } @@ -1927,7 +1583,7 @@ sub pp_not { my $self = shift; my($op, $cx) = @_; if ($cx <= 4) { - $self->listop($op, $cx, "not", $op->first); + $self->pfixop($op, $cx, "not ", 4); } else { $self->pfixop($op, $cx, "!", 21); } @@ -1935,7 +1591,7 @@ sub pp_not { sub unop { my $self = shift; - my($op, $cx, $name, $nollafr) = @_; + my($op, $cx, $name) = @_; my $kid; if ($op->flags & OPf_KIDS) { $kid = $op->first; @@ -1951,18 +1607,9 @@ sub unop { $kid = $kid->first; } - if ($nollafr) { - ($kid = $self->deparse($kid, 16)) =~ s/^\cS//; - return $self->maybe_parens( - $self->keyword($name) . " $kid", $cx, 16 - ); - } return $self->maybe_parens_unop($name, $kid, $cx); } else { - return $self->maybe_parens( - $self->keyword($name) . ($op->flags & OPf_SPECIAL ? "()" : ""), - $cx, 16, - ); + return $name . ($op->flags & OPf_SPECIAL ? "()" : ""); } } @@ -1995,7 +1642,6 @@ sub pp_chr { maybe_targmy(@_, \&unop, "chr") } sub pp_each { unop(@_, "each") } sub pp_values { unop(@_, "values") } sub pp_keys { unop(@_, "keys") } -{ no strict 'refs'; *{"pp_r$_"} = *{"pp_$_"} for qw< keys each values >; } sub pp_boolkeys { # no name because its an optimisation op that has no keyword unop(@_,""); @@ -2037,17 +1683,8 @@ sub pp_gmtime { unop(@_, "gmtime") } sub pp_alarm { unop(@_, "alarm") } sub pp_sleep { maybe_targmy(@_, \&unop, "sleep") } -sub pp_dofile { - my $code = unop(@_, "do", 1); # llafr does not apply - if ($code =~ s/^((?:CORE::)?do) \{/$1({/) { $code .= ')' } - $code; -} -sub pp_entereval { - unop( - @_, - $_[1]->private & OPpEVAL_BYTES ? $_[0]->keyword('evalbytes') : "eval" - ) -} +sub pp_dofile { unop(@_, "do") } +sub pp_entereval { unop(@_, "eval") } sub pp_ghbyname { unop(@_, "gethostbyname") } sub pp_gnbyname { unop(@_, "getnetbyname") } @@ -2064,7 +1701,11 @@ sub pp_ggrgid { unop(@_, "getgrgid") } sub pp_lock { unop(@_, "lock") } sub pp_continue { unop(@_, "continue"); } -sub pp_break { unop(@_, "break"); } +sub pp_break { + my ($self, $op) = @_; + return "" if $op->flags & OPf_SPECIAL; + unop(@_, "break"); +} sub givwhen { my $self = shift; @@ -2073,7 +1714,7 @@ sub givwhen { my $enterop = $op->first; my ($head, $block); if ($enterop->flags & OPf_SPECIAL) { - $head = $self->keyword("default"); + $head = "default"; $block = $self->deparse($enterop->first, 0); } else { @@ -2088,8 +1729,8 @@ sub givwhen { "\b}\cK"; } -sub pp_leavegiven { givwhen(@_, $_[0]->keyword("given")); } -sub pp_leavewhen { givwhen(@_, $_[0]->keyword("when")); } +sub pp_leavegiven { givwhen(@_, "given"); } +sub pp_leavewhen { givwhen(@_, "when"); } sub pp_exists { my $self = shift; @@ -2146,16 +1787,9 @@ sub pp_require { my $name = $self->const_sv($op->first)->PV; $name =~ s[/][::]g; $name =~ s/\.pm//g; - return $self->maybe_parens("$opname $name", $cx, 16); + return "$opname $name"; } else { - $self->unop( - $op, $cx, - $op->first->name eq 'const' - && $op->first->private & OPpCONST_NOVER - ? "no" - : $opname, - 1, # llafr does not apply - ); + $self->unop($op, $cx, $opname); } } @@ -2280,38 +1914,33 @@ sub pp_lcfirst { dq_unop(@_, "lcfirst") } sub pp_uc { dq_unop(@_, "uc") } sub pp_lc { dq_unop(@_, "lc") } sub pp_quotemeta { maybe_targmy(@_, \&dq_unop, "quotemeta") } -sub pp_fc { dq_unop(@_, "fc") } sub loopex { my $self = shift; my ($op, $cx, $name) = @_; if (class($op) eq "PVOP") { - $name .= " " . $op->pv; + return "$name " . $op->pv; } elsif (class($op) eq "OP") { - # no-op + return $name; } elsif (class($op) eq "UNOP") { - (my $kid = $self->deparse($op->first, 7)) =~ s/^\cS//; - $name .= " $kid"; + # Note -- loop exits are actually exempt from the + # looks-like-a-func rule, but a few extra parens won't hurt + return $self->maybe_parens_unop($name, $op->first, $cx); } - return $self->maybe_parens($name, $cx, 7); } sub pp_last { loopex(@_, "last") } sub pp_next { loopex(@_, "next") } sub pp_redo { loopex(@_, "redo") } sub pp_goto { loopex(@_, "goto") } -sub pp_dump { loopex(@_, "CORE::dump") } +sub pp_dump { loopex(@_, "dump") } sub ftst { my $self = shift; my($op, $cx, $name) = @_; if (class($op) eq "UNOP") { - # Genuine '-X' filetests are exempt from the LLAFR, but not - # l?stat() - if ($name =~ /^-/) { - (my $kid = $self->deparse($op->first, 16)) =~ s/^\cS//; - return $self->maybe_parens("$name $kid", $cx, 16); - } + # Genuine `-X' filetests are exempt from the LLAFR, but not + # l?stat(); for the sake of clarity, give'em all parens return $self->maybe_parens_unop($name, $op->first, $cx); } elsif (class($op) =~ /^(SV|PAD)OP$/) { return $self->maybe_parens_func($name, $self->pp_gv($op, 1), $cx, 16); @@ -2360,7 +1989,7 @@ sub assoc_class { my $op = shift; my $name = $op->name; if ($name eq "concat" and $op->first->name eq "concat") { - # avoid spurious '=' -- see comment in pp_concat + # avoid spurious `=' -- see comment in pp_concat return "concat"; } if ($name eq "null" and class($op) eq "UNOP" @@ -2377,7 +2006,7 @@ sub assoc_class { return $name . ($op->flags & OPf_STACKED ? "=" : ""); } -# Left associative operators, like '+', for which +# Left associative operators, like `+', for which # $a + $b + $c is equivalent to ($a + $b) + $c BEGIN { @@ -2408,7 +2037,7 @@ sub deparse_binop_left { } } -# Right associative operators, like '=', for which +# Right associative operators, like `=', for which # $a = $b = $c is equivalent to $a = ($b = $c) BEGIN { @@ -2515,9 +2144,9 @@ sub pp_smartmatch { } } -# '.' is special because concats-of-concats are optimized to save copying +# `.' is special because concats-of-concats are optimized to save copying # by making all but the first concat stacked. The effect is as if the -# programmer had written '($a . $b) .= $c', except legal. +# programmer had written `($a . $b) .= $c', except legal. sub pp_concat { maybe_targmy(@_, \&real_concat) } sub real_concat { my $self = shift; @@ -2535,7 +2164,7 @@ sub real_concat { return $self->maybe_parens("$left .$eq $right", $cx, $prec); } -# 'x' is weird when the left arg is a list +# `x' is weird when the left arg is a list sub pp_repeat { my $self = shift; my($op, $cx) = @_; @@ -2631,45 +2260,20 @@ sub pp_andassign { logassignop(@_, "&&=") } sub pp_orassign { logassignop(@_, "||=") } sub pp_dorassign { logassignop(@_, "//=") } -sub rv2gv_or_string { - my($self,$op) = @_; - if ($op->name eq "gv") { # could be open("open") or open("###") - my($name,$quoted) = - $self->stash_variable_name("", $self->gv_or_padgv($op)); - $quoted ? $name : "*$name"; - } - else { - $self->deparse($op, 6); - } -} - sub listop { my $self = shift; - my($op, $cx, $name, $kid, $nollafr) = @_; + my($op, $cx, $name) = @_; my(@exprs); my $parens = ($cx >= 5) || $self->{'parens'}; - $kid ||= $op->first->sibling; - # If there are no arguments, add final parentheses (or parenthesize the - # whole thing if the llafr does not apply) to account for cases like - # (return)+1 or setpgrp()+1. When the llafr does not apply, we use a - # precedence of 6 (< comma), as "return, 1" does not need parentheses. - if (null $kid) { - return $nollafr - ? $self->maybe_parens($self->keyword($name), $cx, 7) - : $self->keyword($name) . '()' x (7 < $cx); - } + my $kid = $op->first->sibling; + return $name if null $kid; my $first; $name = "socketpair" if $name eq "sockpair"; - my $fullname = $self->keyword($name); my $proto = prototype("CORE::$name"); - if ( - ( (defined $proto && $proto =~ /^;?\*/) - || $name eq 'select' # select(F) doesn't have a proto - ) - && $kid->name eq "rv2gv" - && !($kid->private & OPpLVAL_INTRO) - ) { - $first = $self->rv2gv_or_string($kid->first); + if (defined $proto + && $proto =~ /^;?\*/ + && $kid->name eq "rv2gv") { + $first = $self->deparse($kid->first, 6); } else { $first = $self->deparse($kid, 6); @@ -2677,52 +2281,29 @@ sub listop { if ($name eq "chmod" && $first =~ /^\d+$/) { $first = sprintf("%#o", $first); } - $first = "+$first" - if not $parens and not $nollafr and substr($first, 0, 1) eq "("; + $first = "+$first" if not $parens and substr($first, 0, 1) eq "("; push @exprs, $first; $kid = $kid->sibling; - if (defined $proto && $proto =~ /^\*\*/ && $kid->name eq "rv2gv" - && !($kid->private & OPpLVAL_INTRO)) { - push @exprs, $first = $self->rv2gv_or_string($kid->first); + if (defined $proto && $proto =~ /^\*\*/ && $kid->name eq "rv2gv") { + push @exprs, $self->deparse($kid->first, 6); $kid = $kid->sibling; } for (; !null($kid); $kid = $kid->sibling) { push @exprs, $self->deparse($kid, 6); } if ($name eq "reverse" && ($op->private & OPpREVERSE_INPLACE)) { - return "$exprs[0] = $fullname" - . ($parens ? "($exprs[0])" : " $exprs[0]"); - } - if ($name =~ /^(system|exec)$/ - && ($op->flags & OPf_STACKED) - && @exprs > 1) - { - # handle the "system prog a1,a2,.." form - my $prog = shift @exprs; - $exprs[0] = "$prog $exprs[0]"; + return "$exprs[0] = $name" . ($parens ? "($exprs[0])" : " $exprs[0]"); } - - if ($parens && $nollafr) { - return "($fullname " . join(", ", @exprs) . ")"; - } elsif ($parens) { - return "$fullname(" . join(", ", @exprs) . ")"; + if ($parens) { + return "$name(" . join(", ", @exprs) . ")"; } else { - return "$fullname " . join(", ", @exprs); + return "$name " . join(", ", @exprs); } } sub pp_bless { listop(@_, "bless") } sub pp_atan2 { maybe_targmy(@_, \&listop, "atan2") } -sub pp_substr { - my ($self,$op,$cx) = @_; - if ($op->private & OPpSUBSTR_REPL_FIRST) { - return - listop($self, $op, 7, "substr", $op->first->sibling->sibling) - . " = " - . $self->deparse($op->first->sibling, 7); - } - maybe_local(@_, listop(@_, "substr")) -} +sub pp_substr { maybe_local(@_, listop(@_, "substr")) } sub pp_vec { maybe_local(@_, listop(@_, "vec")) } sub pp_index { maybe_targmy(@_, \&listop, "index") } sub pp_rindex { maybe_targmy(@_, \&listop, "rindex") } @@ -2738,7 +2319,9 @@ sub pp_unshift { maybe_targmy(@_, \&listop, "unshift") } sub pp_reverse { listop(@_, "reverse") } sub pp_warn { listop(@_, "warn") } sub pp_die { listop(@_, "die") } -sub pp_return { listop(@_, "return", undef, 1) } # llafr does not apply +# Actually, return is exempt from the LLAFR (see examples in this very +# module!), but for consistency's sake, ignore that fact +sub pp_return { listop(@_, "return") } sub pp_open { listop(@_, "open") } sub pp_pipe_op { listop(@_, "pipe") } sub pp_tie { listop(@_, "tie") } @@ -2805,12 +2388,9 @@ sub pp_glob { my $self = shift; my($op, $cx) = @_; my $text = $self->dq($op->first->sibling); # skip pushmark - my $keyword = - $op->flags & OPf_SPECIAL ? 'glob' : $self->keyword('glob'); if ($text =~ /^\$?(\w|::|\`)+$/ # could look like a readline - or $keyword =~ /^CORE::/ - or $text =~ /[<>]/) { - return "$keyword(" . single_delim('qq', '"', $text) . ')'; + or $text =~ /[<>]/) { + return 'glob(' . single_delim('qq', '"', $text) . ')'; } else { return '<' . $text . '>'; } @@ -2835,11 +2415,10 @@ sub pp_truncate { $fh = "+$fh" if not $parens and substr($fh, 0, 1) eq "("; } my $len = $self->deparse($kid->sibling, 6); - my $name = $self->keyword('truncate'); if ($parens) { - return "$name($fh, $len)"; + return "truncate($fh, $len)"; } else { - return "$name $fh, $len"; + return "truncate $fh, $len"; } } @@ -2847,7 +2426,7 @@ sub indirop { my $self = shift; my($op, $cx, $name) = @_; my($expr, @exprs); - my $firstkid = my $kid = $op->first->sibling; + my $kid = $op->first->sibling; my $indir = ""; if ($op->flags & OPf_STACKED) { $indir = $kid; @@ -2871,20 +2450,19 @@ sub indirop { $indir = '{$b cmp $a} '; } for (; !null($kid); $kid = $kid->sibling) { - $expr = $self->deparse($kid, !$indir && $kid == $firstkid && $name eq "sort" && $firstkid->name eq "entersub" ? 16 : 6); + $expr = $self->deparse($kid, 6); push @exprs, $expr; } - my $name2; + my $name2 = $name; if ($name eq "sort" && $op->private & OPpSORT_REVERSE) { - $name2 = $self->keyword('reverse') . ' ' . $self->keyword('sort'); + $name2 = 'reverse sort'; } - else { $name2 = $self->keyword($name) } if ($name eq "sort" && ($op->private & OPpSORT_INPLACE)) { return "$exprs[0] = $name2 $indir $exprs[0]"; } my $args = $indir . join(", ", @exprs); - if ($indir ne "" && $name eq "sort") { + if ($indir ne "" and $name eq "sort") { # We don't want to say "sort(f 1, 2, 3)", since perl -w will # give bareword warnings in that case. Therefore if context # requires, we'll put parens around the outside "(sort f 1, 2, @@ -2896,14 +2474,6 @@ sub indirop { } else { return "$name2 $args"; } - } elsif ( - !$indir && $name eq "sort" - && !null($op->first->sibling) - && $op->first->sibling->name eq 'entersub' - ) { - # We cannot say sort foo(bar), as foo will be interpreted as a - # comparison routine. We have to say sort(...) in that case. - return "$name2($args)"; } else { return $self->maybe_parens_func($name2, $args, $cx, 5); } @@ -2925,8 +2495,7 @@ sub mapop { if (is_scope $code) { $code = "{" . $self->deparse($code, 0) . "} "; } else { - $code = $self->deparse($code, 24); - $code .= ", " if !null($kid->sibling); + $code = $self->deparse($code, 24) . ", "; } $kid = $kid->sibling; for (; !null($kid); $kid = $kid->sibling) { @@ -2946,7 +2515,6 @@ sub pp_list { my($op, $cx) = @_; my($expr, @exprs); my $kid = $op->first->sibling; # skip pushmark - return '' if class($kid) eq 'NULL'; my $lop; my $local = "either"; # could be local(...), my(...), state(...) or our(...) for ($lop = $kid; !null($lop); $lop = $lop->sibling) { @@ -3107,8 +2675,7 @@ sub loop_common { $ary = $self->deparse($ary, 1); } if (null $var) { - if (($enter->flags & OPf_SPECIAL) && ($] < 5.009)) { - # thread special var, under 5005threads + if ($enter->flags & OPf_SPECIAL) { # thread special var $var = $self->pp_threadsv($enter, 1); } else { # regular my() variable $var = $self->pp_padsv($enter, 1); @@ -3124,7 +2691,7 @@ sub loop_common { $var = "\$" . $self->deparse($var, 1); } $body = $kid->first->first->sibling; # skip OP_AND and OP_ITER - if (!is_state $body->first and $body->first->name !~ /^(?:stub|leave|scope)$/) { + if (!is_state $body->first and $body->first->name ne "stub") { confess unless $var eq '$_'; $body = $body->first; return $self->deparse($body, 2) . " foreach ($ary)"; @@ -3161,7 +2728,7 @@ sub loop_common { for (; $$state != $$cont; $state = $state->sibling) { push @states, $state; } - $body = $self->lineseq(undef, 0, @states); + $body = $self->lineseq(undef, @states); if (defined $cond and not is_scope $cont and $self->{'expand'} < 3) { $head = "for ($init; $cond; " . $self->deparse($cont, 1) .") "; $cont = "\cK"; @@ -3188,9 +2755,7 @@ sub for_loop { my $self = shift; my($op, $cx) = @_; my $init = $self->deparse($op, 1); - my $s = $op->sibling; - my $ll = $s->name eq "unstack" ? $s->sibling : $s->first->sibling; - return $self->loop_common($ll, $cx, $init); + return $self->loop_common($op->sibling->first->sibling, $cx, $init); } sub pp_leavetry { @@ -3198,9 +2763,10 @@ sub pp_leavetry { return "eval {\n\t" . $self->pp_leave(@_) . "\n\b}"; } -BEGIN { for (qw[ const stringify rv2sv list glob ]) { - eval "sub OP_\U$_ () { " . opnumber($_) . "}" -}} +BEGIN { eval "sub OP_CONST () {" . opnumber("const") . "}" } +BEGIN { eval "sub OP_STRINGIFY () {" . opnumber("stringify") . "}" } +BEGIN { eval "sub OP_RV2SV () {" . opnumber("rv2sv") . "}" } +BEGIN { eval "sub OP_LIST () {" . opnumber("list") . "}" } sub pp_null { my $self = shift; @@ -3218,14 +2784,6 @@ sub pp_null { return $self->pp_scope($op->first, $cx); } elsif ($op->targ == OP_STRINGIFY) { return $self->dquote($op, $cx); - } elsif ($op->targ == OP_GLOB) { - return $self->pp_glob( - $op->first # entersub - ->first # ex-list - ->first # pushmark - ->sibling, # glob - $cx - ); } elsif (!null($op->first->sibling) and $op->first->sibling->name eq "readline" and $op->first->sibling->flags & OPf_STACKED) { @@ -3274,7 +2832,15 @@ sub pp_padsv { sub pp_padav { pp_padsv(@_) } sub pp_padhv { pp_padsv(@_) } -my @threadsv_names = B::threadsv_names; +my @threadsv_names; + +BEGIN { + @threadsv_names = ("_", "1", "2", "3", "4", "5", "6", "7", "8", "9", + "&", "`", "'", "+", "/", ".", ",", "\\", '"', ";", + "^", "-", "%", "=", "|", "~", ":", "^A", "^E", + "!", "@"); +} + sub pp_threadsv { my $self = shift; my($op, $cx) = @_; @@ -3296,7 +2862,7 @@ sub pp_gvsv { my($op, $cx) = @_; my $gv = $self->gv_or_padgv($op); return $self->maybe_local($op, $cx, $self->stash_variable("\$", - $self->gv_name($gv), $cx)); + $self->gv_name($gv))); } sub pp_gv { @@ -3306,23 +2872,22 @@ sub pp_gv { return $self->gv_name($gv); } -sub pp_aelemfast_lex { - my $self = shift; - my($op, $cx) = @_; - my $name = $self->padname($op->targ); - $name =~ s/^@/\$/; - return $name . "[" . ($op->private + $self->{'arybase'}) . "]"; -} - sub pp_aelemfast { my $self = shift; my($op, $cx) = @_; - # optimised PADAV, pre 5.15 - return $self->pp_aelemfast_lex(@_) if ($op->flags & OPf_SPECIAL); + my $name; + if ($op->flags & OPf_SPECIAL) { # optimised PADAV + $name = $self->padname($op->targ); + $name =~ s/^@/\$/; + } + else { + my $gv = $self->gv_or_padgv($op); + $name = $self->gv_name($gv); + $name = $self->{'curstash'}."::$name" + if $name !~ /::/ && $self->lex_in_scope('@'.$name); + $name = '$' . $name; + } - my $gv = $self->gv_or_padgv($op); - my($name,$quoted) = $self->stash_variable_name('@',$gv); - $name = $quoted ? "$name->" : '$' . $name; return $name . "[" . ($op->private + $self->{'arybase'}) . "]"; } @@ -3336,7 +2901,7 @@ sub rv2x { } my $kid = $op->first; if ($kid->name eq "gv") { - return $self->stash_variable($type, $self->deparse($kid, 0), $cx); + return $self->stash_variable($type, $self->deparse($kid, 0)); } elsif (is_scalar $kid) { my $str = $self->deparse($kid, 0); if ($str =~ /^\$([^\w\d])\z/) { @@ -3427,7 +2992,7 @@ sub is_subscriptable { $kid = $kid->sibling until null $kid->sibling; return 0 if is_scope($kid); $kid = $kid->first; - return 0 if $kid->name eq "gv" || $kid->name eq "padcv"; + return 0 if $kid->name eq "gv"; return 0 if is_scalar($kid); return is_subscriptable($kid); } else { @@ -3445,15 +3010,13 @@ sub elem_or_slice_array_name } elsif (is_scope($array)) { # ${expr}[0] return "{" . $self->deparse($array, 0) . "}"; } elsif ($array->name eq "gv") { - ($array, my $quoted) = - $self->stash_variable_name( - $left eq '[' ? '@' : '%', $self->gv_or_padgv($array) - ); - if (!$allow_arrow && $quoted) { - # This cannot happen. - die "Invalid variable name $array for slice"; + $array = $self->gv_name($self->gv_or_padgv($array)); + if ($array !~ /::/) { + my $prefix = ($left eq '[' ? '@' : '%'); + $array = $self->{curstash}.'::'.$array + if $self->lex_in_scope($prefix . $array); } - return $quoted ? "$array->" : $array; + return $array; } elsif (!$allow_arrow || is_scalar $array) { # $x[0], $$x[0], ... return $self->deparse($array, 24); } else { @@ -3511,8 +3074,7 @@ sub elem { } if (my $array_name=$self->elem_or_slice_array_name ($array, $left, $padname, 1)) { - return ($array_name =~ /->\z/ ? $array_name : "\$" . $array_name) - . $left . $idx . $right; + return "\$" . $array_name . $left . $idx . $right; } else { # $x[20][3]{hi} or expr->[20] my $arrow = is_subscriptable($array) ? "" : "->"; @@ -3600,7 +3162,7 @@ sub _method { # doesn't get flattened by the append_elem that adds the method, # making a (object, arg1, arg2, ...) list where the object # usually is. This can be distinguished from - # '($obj, $arg1, $arg2)->meth()' (which is legal if $arg2 is an + # `($obj, $arg1, $arg2)->meth()' (which is legal if $arg2 is an # object) because in the later the list is in scalar context # as the left side of -> always is, while in the former # the list is in list context as method arguments always are. @@ -3615,7 +3177,7 @@ sub _method { } else { $obj = $kid; $kid = $kid->sibling; - for (; !null ($kid->sibling) && $kid->name!~/^method(?:_named)?\z/; + for (; !null ($kid->sibling) && $kid->name ne "method_named"; $kid = $kid->sibling) { push @exprs, $kid } @@ -3634,8 +3196,7 @@ sub _method { } return { method => $meth, variable_method => ref($meth), - object => $obj, args => \@exprs }, - $cx; + object => $obj, args => \@exprs }; } # compat function only @@ -3646,22 +3207,12 @@ sub method { } sub e_method { - my ($self, $info, $cx) = @_; + my ($self, $info) = @_; my $obj = $self->deparse($info->{object}, 24); my $meth = $info->{method}; $meth = $self->deparse($meth, 1) if $info->{variable_method}; my $args = join(", ", map { $self->deparse($_, 6) } @{$info->{args}} ); - if ($info->{object}->name eq 'scope' && want_list $info->{object}) { - # method { $object } - # This must be deparsed this way to preserve list context - # of $object. - my $need_paren = $cx >= 6; - return '(' x $need_paren - . $meth . substr($obj,2) # chop off the "do" - . " $args" - . ')' x $need_paren; - } my $kid = $obj . "->" . $meth; if (length $args) { return $kid . "(" . $args . ")"; # parens mandatory @@ -3744,7 +3295,7 @@ sub check_proto { } } } - return "&" if $proto and !$doneok; # too few args and no ';' + return "&" if $proto and !$doneok; # too few args and no `;' return "&" if @args; # too many args return ("", join ", ", @reals); } @@ -3791,7 +3342,7 @@ sub pp_entersub { $kid = $self->deparse($kid, 24); } else { $prefix = ""; - my $arrow = is_subscriptable($kid->first) || $kid->first->name eq "padcv" ? "" : "->"; + my $arrow = is_subscriptable($kid->first) ? "" : "->"; $kid = $self->deparse($kid, 24) . $arrow; } @@ -3824,14 +3375,21 @@ sub pp_entersub { $args = join(", ", map($self->deparse($_, 6), @exprs)); } if ($prefix or $amper) { - if ($kid eq '&') { $kid = "{$kid}" } # &{&} cannot be written as && if ($op->flags & OPf_STACKED) { return $prefix . $amper . $kid . "(" . $args . ")"; } else { return $prefix . $amper. $kid; } } else { - # It's a syntax error to call CORE::GLOBAL::foo with a prefix, + # glob() invocations can be translated into calls of + # CORE::GLOBAL::glob with a second parameter, a number. + # Reverse this. + if ($kid eq "CORE::GLOBAL::glob") { + $kid = "glob"; + $args =~ s/\s*,[^,]+$//; + } + + # It's a syntax error to call CORE::GLOBAL::foo without a prefix, # so it must have been translated from a keyword call. Translate # it back. $kid =~ s/^CORE::GLOBAL:://; @@ -4167,16 +3725,6 @@ sub const { } return "{" . join(", ", @elts) . "}"; } elsif (class($ref) eq "CV") { - BEGIN { - if ($] > 5.0150051) { - require overloading; - unimport overloading; - } - } - if ($] > 5.0150051 && $self->{curcv} && - $self->{curcv}->object_2svref == $ref->object_2svref) { - return $self->keyword("__SUB__"); - } return "sub " . $self->deparse_sub($ref); } if ($ref->FLAGS & SVs_SMG) { @@ -4230,7 +3778,7 @@ sub pp_const { if ($op->private & OPpCONST_ARYBASE) { return '$['; } -# if ($op->private & OPpCONST_BARE) { # trouble with '=>' autoquoting +# if ($op->private & OPpCONST_BARE) { # trouble with `=>' autoquoting # return $self->const_sv($op)->PV; # } my $sv = $self->const_sv($op); @@ -4265,8 +3813,6 @@ sub dq { return '\l' . $self->dq($op->first->sibling); } elsif ($type eq "quotemeta") { return '\Q' . $self->dq($op->first->sibling) . '\E'; - } elsif ($type eq "fc") { - return '\F' . $self->dq($op->first->sibling) . '\E'; } elsif ($type eq "join") { return $self->deparse($op->last, 26); # was join($", @ary) } else { @@ -4280,10 +3826,7 @@ sub pp_backtick { # skip pushmark if it exists (readpipe() vs ``) my $child = $op->first->sibling->isa('B::NULL') ? $op->first : $op->first->sibling; - if ($self->pure_string($child)) { - return single_delim("qx", '`', $self->dq($child, 1)); - } - unop($self, @_, "readpipe"); + return single_delim("qx", '`', $self->dq($child)); } sub dquote { @@ -4309,7 +3852,7 @@ sub double_delim { if (($succeed, $to) = balanced_delim($to) and $succeed) { return "$from$to"; } else { - for $delim ('/', '"', '#') { # note no "'" -- s''' is special + for $delim ('/', '"', '#') { # note no `'' -- s''' is special return "$from$delim$to$delim" if index($to, $delim) == -1; } $to =~ s[/][\\/]g; @@ -4532,26 +4075,19 @@ sub pp_trans { my $self = shift; my($op, $cx) = @_; my($from, $to); - my $class = class($op); - my $priv_flags = $op->private; - if ($class eq "PVOP") { - ($from, $to) = tr_decode_byte($op->pv, $priv_flags); - } elsif ($class eq "PADOP") { - ($from, $to) - = tr_decode_utf8($self->padval($op->padix)->RV, $priv_flags); + if (class($op) eq "PVOP") { + ($from, $to) = tr_decode_byte($op->pv, $op->private); } else { # class($op) eq "SVOP" - ($from, $to) = tr_decode_utf8($op->sv->RV, $priv_flags); + ($from, $to) = tr_decode_utf8($op->sv->RV, $op->private); } my $flags = ""; - $flags .= "c" if $priv_flags & OPpTRANS_COMPLEMENT; - $flags .= "d" if $priv_flags & OPpTRANS_DELETE; + $flags .= "c" if $op->private & OPpTRANS_COMPLEMENT; + $flags .= "d" if $op->private & OPpTRANS_DELETE; $to = "" if $from eq $to and $flags eq ""; - $flags .= "s" if $priv_flags & OPpTRANS_SQUASH; + $flags .= "s" if $op->private & OPpTRANS_SQUASH; return "tr" . double_delim($from, $to) . $flags; } -sub pp_transr { &pp_trans . 'r' } - sub re_dq_disambiguate { my ($first, $last) = @_; # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]" @@ -4588,14 +4124,10 @@ sub re_dq { return '\l' . $self->re_dq($op->first->sibling, $extended); } elsif ($type eq "quotemeta") { return '\Q' . $self->re_dq($op->first->sibling, $extended) . '\E'; - } elsif ($type eq "fc") { - return '\F' . $self->re_dq($op->first->sibling, $extended) . '\E'; } elsif ($type eq "join") { return $self->deparse($op->last, 26); # was join($", @ary) } else { - my $ret = $self->deparse($op, 26); - $ret =~ s/^\$([(|)])\z/\${$1}/; # $( $| $) need braces - return $ret; + return $self->deparse($op, 26); } } @@ -4604,10 +4136,10 @@ sub pure_string { return 0 if null $op; my $type = $op->name; - if ($type eq 'const' || $type eq 'av2arylen') { + if ($type eq 'const') { return 1; } - elsif ($type =~ /^(?:[ul]c(first)?|fc)$/ || $type eq 'quotemeta') { + elsif ($type =~ /^[ul]c(first)?$/ || $type eq 'quotemeta') { return $self->pure_string($op->first->sibling); } elsif ($type eq 'join') { @@ -4629,12 +4161,9 @@ sub pure_string { return 1; } elsif ($type eq "null" and $op->can('first') and not null $op->first and - ($op->first->name eq "null" and $op->first->can('first') + $op->first->name eq "null" and $op->first->can('first') and not null $op->first->first and - $op->first->first->name eq "aelemfast" - or - $op->first->name =~ /^aelemfast(?:_lex)?\z/ - )) { + $op->first->first->name eq "aelemfast") { return 1; } else { @@ -4673,38 +4202,6 @@ sub pp_regcomp { return (($self->regcomp($op, $cx, 0))[0]); } -sub re_flags { - my ($self, $op) = @_; - my $flags = ''; - my $pmflags = $op->pmflags; - $flags .= "g" if $pmflags & PMf_GLOBAL; - $flags .= "i" if $pmflags & PMf_FOLD; - $flags .= "m" if $pmflags & PMf_MULTILINE; - $flags .= "o" if $pmflags & PMf_KEEP; - $flags .= "s" if $pmflags & PMf_SINGLELINE; - $flags .= "x" if $pmflags & PMf_EXTENDED; - $flags .= "p" if $pmflags & RXf_PMf_KEEPCOPY; - if (my $charset = $pmflags & RXf_PMf_CHARSET) { - # Hardcoding this is fragile, but B does not yet export the - # constants we need. - $flags .= qw(d l u a aa)[$charset >> 5] - } - # The /d flag is indicated by 0; only show it if necessary. - elsif ($self->{hinthash} and - $self->{hinthash}{reflags_charset} - || $self->{hinthash}{feature_unicode} - or $self->{hints} & $feature::hint_mask - && ($self->{hints} & $feature::hint_mask) - != $feature::hint_mask - && do { - $self->{hints} & $feature::hint_uni8bit; - } - ) { - $flags .= 'd'; - } - $flags; -} - # osmic acid -- see osmium tetroxide my %matchwords; @@ -4723,9 +4220,7 @@ sub matchop { $kid = $kid->sibling; } my $quote = 1; - my $pmflags = $op->pmflags; - my $extended = ($pmflags & PMf_EXTENDED); - my $rhs_bound_to_defsv; + my $extended = ($op->pmflags & PMf_EXTENDED); if (null $kid) { my $unbacked = re_unback($op->precomp); if ($extended) { @@ -4737,21 +4232,17 @@ sub matchop { carp("found ".$kid->name." where regcomp expected"); } else { ($re, $quote) = $self->regcomp($kid, 21, $extended); - my $matchop = $kid->first; - if ($matchop->name eq 'regcrest') { - $matchop = $matchop->first; - } - if ($matchop->name =~ /^(?:match|transr?|subst)\z/ - && $matchop->flags & OPf_SPECIAL) { - $rhs_bound_to_defsv = 1; - } } my $flags = ""; - $flags .= "c" if $pmflags & PMf_CONTINUE; - $flags .= $self->re_flags($op); - $flags = join '', sort split //, $flags; + $flags .= "c" if $op->pmflags & PMf_CONTINUE; + $flags .= "g" if $op->pmflags & PMf_GLOBAL; + $flags .= "i" if $op->pmflags & PMf_FOLD; + $flags .= "m" if $op->pmflags & PMf_MULTILINE; + $flags .= "o" if $op->pmflags & PMf_KEEP; + $flags .= "s" if $op->pmflags & PMf_SINGLELINE; + $flags .= "x" if $op->pmflags & PMf_EXTENDED; $flags = $matchwords{$flags} if $matchwords{$flags}; - if ($pmflags & PMf_ONCE) { # only one kind of delimiter works here + if ($op->pmflags & PMf_ONCE) { # only one kind of delimiter works here $re =~ s/\?/\\?/g; $re = "?$re?"; } elsif ($quote) { @@ -4759,13 +4250,7 @@ sub matchop { } $re = $re . $flags if $quote; if ($binop) { - return - $self->maybe_parens( - $rhs_bound_to_defsv - ? "$var =~ (\$_ =~ $re)" - : "$var =~ $re", - $cx, 20 - ); + return $self->maybe_parens("$var =~ $re", $cx, 20); } else { return $re; } @@ -4775,8 +4260,6 @@ sub pp_match { matchop(@_, "m", "/") } sub pp_pushre { matchop(@_, "m", "/") } sub pp_qr { matchop(@_, "qr", "") } -sub pp_runcv { unop(@_, "__SUB__"); } - sub pp_split { my $self = shift; my($op, $cx) = @_; @@ -4796,7 +4279,7 @@ sub pp_split { } elsif (!ref($replroot) and $replroot > 0) { $gv = $self->padval($replroot); } - $ary = $self->stash_variable('@', $self->gv_name($gv), $cx) if $gv; + $ary = $self->stash_variable('@', $self->gv_name($gv)) if $gv; for (; !null($kid); $kid = $kid->sibling) { push @exprs, $self->deparse($kid, 6); @@ -4804,16 +4287,10 @@ sub pp_split { # handle special case of split(), and split(' ') that compiles to /\s+/ # Under 5.10, the reflags may be undef if the split regexp isn't a constant - # Under 5.17.5-5.17.9, the special flag is on split itself. $kid = $op->first; - if ( $op->flags & OPf_SPECIAL - or ( - $kid->flags & OPf_SPECIAL - and ( $] < 5.009 ? $kid->pmflags & PMf_SKIPWHITE() - : ($kid->reflags || 0) & RXf_SKIPWHITE() - ) - ) - ) { + if ( $kid->flags & OPf_SPECIAL + and ( $] < 5.009 ? $kid->pmflags & PMf_SKIPWHITE() + : ($kid->reflags || 0) & RXf_SKIPWHITE() ) ) { $exprs[0] = "' '"; } @@ -4833,9 +4310,7 @@ my %substwords; map($substwords{join "", sort split //, $_} = $_, 'ego', 'egoism', 'em', 'es', 'ex', 'exes', 'gee', 'go', 'goes', 'ie', 'ism', 'iso', 'me', 'meese', 'meso', 'mig', 'mix', 'os', 'ox', 'oxime', 'see', 'seem', - 'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi', 'rogue', - 'sir', 'rise', 'smore', 'more', 'seer', 'rome', 'gore', 'grim', 'grime', - 'or', 'rose', 'rosie'); + 'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi'); sub pp_subst { my $self = shift; @@ -4848,23 +4323,22 @@ sub pp_subst { $kid = $kid->sibling; } my $flags = ""; - my $pmflags = $op->pmflags; if (null($op->pmreplroot)) { - $repl = $kid; + $repl = $self->dq($kid); $kid = $kid->sibling; } else { $repl = $op->pmreplroot->first; # skip substcont - } - while ($repl->name eq "entereval") { + while ($repl->name eq "entereval") { $repl = $repl->first; $flags .= "e"; - } - if ($pmflags & PMf_EVAL) { + } + if ($op->pmflags & PMf_EVAL) { $repl = $self->deparse($repl->first, 0); - } else { + } else { $repl = $self->dq($repl); + } } - my $extended = ($pmflags & PMf_EXTENDED); + my $extended = ($op->pmflags & PMf_EXTENDED); if (null $kid) { my $unbacked = re_unback($op->precomp); if ($extended) { @@ -4876,10 +4350,13 @@ sub pp_subst { } else { ($re) = $self->regcomp($kid, 1, $extended); } - $flags .= "r" if $pmflags & PMf_NONDESTRUCT; - $flags .= "e" if $pmflags & PMf_EVAL; - $flags .= $self->re_flags($op); - $flags = join '', sort split //, $flags; + $flags .= "e" if $op->pmflags & PMf_EVAL; + $flags .= "g" if $op->pmflags & PMf_GLOBAL; + $flags .= "i" if $op->pmflags & PMf_FOLD; + $flags .= "m" if $op->pmflags & PMf_MULTILINE; + $flags .= "o" if $op->pmflags & PMf_KEEP; + $flags .= "s" if $op->pmflags & PMf_SINGLELINE; + $flags .= "x" if $extended; $flags = $substwords{$flags} if $substwords{$flags}; if ($binop) { return $self->maybe_parens("$var =~ s" @@ -4890,36 +4367,6 @@ sub pp_subst { } } -sub is_lexical_subs { - my (@ops) = shift; - for my $op (@ops) { - return 0 if $op->name !~ /\A(?:introcv|clonecv)\z/; - } - return 1; -} - -sub pp_introcv { - my $self = shift; - my($op, $cx) = @_; - # For now, deparsing doesn't worry about the distinction between introcv - # and clonecv, so pretend this op doesn't exist: - return ''; -} - -sub pp_clonecv { - my $self = shift; - my($op, $cx) = @_; - my $sv = $self->padname_sv($op->targ); - my $name = substr $sv->PVX, 1; # skip &/$/@/%, like $self->padany - return "my sub $name"; -} - -sub pp_padcv { - my $self = shift; - my($op, $cx) = @_; - return $self->padany($op); -} - 1; __END__ @@ -4936,18 +4383,18 @@ B<perl> B<-MO=Deparse>[B<,-d>][B<,-f>I<FILE>][B<,-p>][B<,-q>][B<,-l>] B::Deparse is a backend module for the Perl compiler that generates perl source code, based on the internal compiled structure that perl -itself creates after parsing a program. The output of B::Deparse won't +itself creates after parsing a program. The output of B::Deparse won't be exactly the same as the original source, since perl doesn't keep track of comments or whitespace, and there isn't a one-to-one correspondence between perl's syntactical constructions and their -compiled form, but it will often be close. When you use the B<-p> +compiled form, but it will often be close. When you use the B<-p> option, the output also includes parentheses even when they are not required by precedence, which can make it easy to see if perl is parsing your expressions the way you intended. While B::Deparse goes to some lengths to try to figure out what your original program was doing, some parts of the language can still trip -it up; it still fails even on some parts of Perl's own test suite. If +it up; it still fails even on some parts of Perl's own test suite. If you encounter a failure other than the most common ones described in the BUGS section below, you can help contribute to B::Deparse's ongoing development by submitting a bug report with a small @@ -4964,7 +4411,7 @@ the '-MO=Deparse', separated by a comma but not any white space. Output data values (when they appear as constants) using Data::Dumper. Without this option, B::Deparse will use some simple routines of its -own for the same purpose. Currently, Data::Dumper is better for some +own for the same purpose. Currently, Data::Dumper is better for some kinds of data (such as complex structures with sharing and self-reference) while the built-in routines are better for others (such as odd floating-point values). @@ -4972,9 +4419,8 @@ self-reference) while the built-in routines are better for others =item B<-f>I<FILE> Normally, B::Deparse deparses the main code of a program, and all the subs -defined in the same file. To include subs defined in -other files, pass the B<-f> option with the filename. -You can pass the B<-f> option several times, to +defined in the same file. To include subs defined in other files, pass the +B<-f> option with the filename. You can pass the B<-f> option several times, to include more than one secondary file. (Most of the time you don't want to use it at all.) You can also use this option to include subs which are defined in the scope of a B<#line> directive with two parameters. @@ -4986,11 +4432,11 @@ locations of the original code. =item B<-p> -Print extra parentheses. Without this option, B::Deparse includes +Print extra parentheses. Without this option, B::Deparse includes parentheses in its output only when they are needed, based on the -structure of your program. With B<-p>, it uses parentheses (almost) -whenever they would be legal. This can be useful if you are used to -LISP, or if you want to see how perl parses your input. If you say +structure of your program. With B<-p>, it uses parentheses (almost) +whenever they would be legal. This can be useful if you are used to +LISP, or if you want to see how perl parses your input. If you say if ($var & 0x7f == 65) {print "Gimme an A!"} print ($which ? $a : $b), "\n"; @@ -5009,8 +4455,8 @@ perl optimized away a constant value). =item B<-P> -Disable prototype checking. With this option, all function calls are -deparsed as if no prototype was defined for them. In other words, +Disable prototype checking. With this option, all function calls are +deparsed as if no prototype was defined for them. In other words, perl -MO=Deparse,-P -e 'sub foo (\@) { 1 } foo @x' @@ -5026,7 +4472,7 @@ making clear how the parameters are actually passed to C<foo>. =item B<-q> Expand double-quoted strings into the corresponding combinations of -concatenation, uc, ucfirst, lc, lcfirst, quotemeta, and join. For +concatenation, uc, ucfirst, lc, lcfirst, quotemeta, and join. For instance, print print "Hello, $world, @ladies, \u$gentlemen\E, \u\L$me!"; @@ -5038,21 +4484,21 @@ as Note that the expanded form represents the way perl handles such constructions internally -- this option actually turns off the reverse -translation that B::Deparse usually does. On the other hand, note that +translation that B::Deparse usually does. On the other hand, note that C<$x = "$y"> is not the same as C<$x = $y>: the former makes the value of $y into a string before doing the assignment. =item B<-s>I<LETTERS> -Tweak the style of B::Deparse's output. The letters should follow -directly after the 's', with no space or punctuation. The following +Tweak the style of B::Deparse's output. The letters should follow +directly after the 's', with no space or punctuation. The following options are available: =over 4 =item B<C> -Cuddle C<elsif>, C<else>, and C<continue> blocks. For example, print +Cuddle C<elsif>, C<else>, and C<continue> blocks. For example, print if (...) { ... @@ -5073,11 +4519,11 @@ The default is not to cuddle. =item B<i>I<NUMBER> -Indent lines by multiples of I<NUMBER> columns. The default is 4 columns. +Indent lines by multiples of I<NUMBER> columns. The default is 4 columns. =item B<T> -Use tabs for each 8 columns of indent. The default is to use only spaces. +Use tabs for each 8 columns of indent. The default is to use only spaces. For instance, if the style options are B<-si4T>, a line that's indented 3 times will be preceded by one tab and four spaces; if the options were B<-si8T>, the same line would be preceded by three tabs. @@ -5086,14 +4532,14 @@ B<-si8T>, the same line would be preceded by three tabs. Print I<STRING> for the value of a constant that can't be determined because it was optimized away (mnemonic: this happens when a constant -is used in B<v>oid context). The end of the string is marked by a period. +is used in B<v>oid context). The end of the string is marked by a period. The string should be a valid perl expression, generally a constant. Note that unless it's a number, it probably needs to be quoted, and on -a command line quotes need to be protected from the shell. Some +a command line quotes need to be protected from the shell. Some conventional values include 0, 1, 42, '', 'foo', and 'Useless use of constant omitted' (which may need to be B<-sv"'Useless use of constant omitted'."> -or something similar depending on your shell). The default is '???'. +or something similar depending on your shell). The default is '???'. If you're using B::Deparse on a module or other file that's require'd, you shouldn't use a value that evaluates to false, since the customary true constant at the end of a module will be in void context when the @@ -5104,8 +4550,8 @@ file is compiled as a main program. =item B<-x>I<LEVEL> Expand conventional syntax constructions into equivalent ones that expose -their internal operation. I<LEVEL> should be a digit, with higher values -meaning more expansion. As with B<-q>, this actually involves turning off +their internal operation. I<LEVEL> should be a digit, with higher values +meaning more expansion. As with B<-q>, this actually involves turning off special cases in B::Deparse's normal operations. If I<LEVEL> is at least 3, C<for> loops will be translated into equivalent @@ -5186,7 +4632,7 @@ programs. $deparse = B::Deparse->new(OPTIONS) Create an object to store the state of a deparsing operation and any -options. The options are the same as those that can be given on the +options. The options are the same as those that can be given on the command line (see L</OPTIONS>); options that are separated by commas after B<-MO=Deparse> should be given as separate strings. @@ -5195,7 +4641,7 @@ after B<-MO=Deparse> should be given as separate strings. $deparse->ambient_pragmas(strict => 'all', '$[' => $[); The compilation of a subroutine can be affected by a few compiler -directives, B<pragmas>. These are: +directives, B<pragmas>. These are: =over 4 @@ -5232,15 +4678,15 @@ use re; Ordinarily, if you use B::Deparse on a subroutine which has been compiled in the presence of one or more of these pragmas, the output will include statements to turn on the appropriate -directives. So if you then compile the code returned by coderef2text, +directives. So if you then compile the code returned by coderef2text, it will behave the same way as the subroutine which you deparsed. However, you may know that you intend to use the results in a -particular context, where some pragmas are already in scope. In +particular context, where some pragmas are already in scope. In this case, you use the B<ambient_pragmas> method to describe the assumptions you wish to make. -Not all of the options currently have any useful effect. See +Not all of the options currently have any useful effect. See L</BUGS> for more details. The parameters it accepts are: @@ -5250,7 +4696,7 @@ The parameters it accepts are: =item strict Takes a string, possibly containing several values separated -by whitespace. The special values "all" and "none" mean what you'd +by whitespace. The special values "all" and "none" mean what you'd expect. $deparse->ambient_pragmas(strict => 'subs refs'); @@ -5258,7 +4704,6 @@ expect. =item $[ Takes a number, the value of the array base $[. -Cannot be non-zero on Perl 5.15.3 or later. =item bytes @@ -5272,7 +4717,7 @@ be in the ambient scope, otherwise not. =item re Takes a string, possibly containing a whitespace-separated list of -values. The values "all" and "none" are special. It's also permissible +values. The values "all" and "none" are special. It's also permissible to pass an array reference here. $deparser->ambient_pragmas(re => 'eval'); @@ -5281,14 +4726,14 @@ to pass an array reference here. =item warnings Takes a string, possibly containing a whitespace-separated list of -values. The values "all" and "none" are special, again. It's also +values. The values "all" and "none" are special, again. It's also permissible to pass an array reference here. $deparser->ambient_pragmas(warnings => [qw[void io]]); If one of the values is the string "FATAL", then all the warnings in that list will be considered fatal, just as with the B<warnings> -pragma itself. Should you need to specify that some warnings are +pragma itself. Should you need to specify that some warnings are fatal, and others are merely enabled, you can pass the B<warnings> parameter twice: @@ -5333,10 +4778,10 @@ stored in the special hash %^H. Return source code for the body of a subroutine (a block, optionally preceded by a prototype in parens), given a reference to the -sub. Because a subroutine can have no names, or more than one name, +sub. Because a subroutine can have no names, or more than one name, this method doesn't return a complete subroutine definition -- if you want to eval the result, you should prepend "sub subname ", or "sub " -for an anonymous function constructor. Unless the sub was defined in +for an anonymous function constructor. Unless the sub was defined in the main:: package, the code will include a package declaration. =head1 BUGS @@ -5346,8 +4791,7 @@ the main:: package, the code will include a package declaration. =item * The only pragmas to be completely supported are: C<use warnings>, -C<use strict>, C<use bytes>, C<use integer> -and C<use feature>. (C<$[>, which +C<use strict 'refs'>, C<use bytes>, and C<use integer>. (C<$[>, which behaves like a pragma, is also supported.) Excepting those listed above, we're currently unable to guarantee that @@ -5362,7 +4806,7 @@ than in the input file. In fact, the above is a specific instance of a more general problem: we can't guarantee to produce BEGIN blocks or C<use> declarations in -exactly the right place. So if you use a module which affects compilation +exactly the right place. So if you use a module which affects compilation (such as by over-riding keywords, overloading constants or whatever) then the output code might not work as intended. @@ -5371,6 +4815,14 @@ from the Perl core to fix. =item * +If a keyword is over-ridden, and your program explicitly calls +the built-in version by using CORE::keyword, the output of B::Deparse +will not reflect this. If you run the resulting code, it will call +the over-ridden version rather than the built-in one. (Maybe there +should be an option to B<always> print keyword calls as C<CORE::name>.) + +=item * + Some constants don't print correctly either with or without B<-d>. For instance, neither B::Deparse nor Data::Dumper know how to print dual-valued scalars correctly, as in: @@ -5388,8 +4840,7 @@ produced is already ordinary Perl which shouldn't be filtered again. =item * -Optimised away statements are rendered as -'???'. This includes statements that +Optimised away statements are rendered as '???'. This includes statements that have a compile-time side-effect, such as the obscure my $x if 0; @@ -5403,31 +4854,14 @@ which is not, consequently, deparsed correctly. =item * Lexical (my) variables declared in scopes external to a subroutine -appear in code2ref output text as package variables. This is a tricky -problem, as perl has no native facility for referring to a lexical variable +appear in code2ref output text as package variables. This is a tricky +problem, as perl has no native facility for refering to a lexical variable defined within a different scope, although L<PadWalker> is a good start. =item * There are probably many more bugs on non-ASCII platforms (EBCDIC). -=item * - -Lexical C<my> subroutines are not deparsed properly at the moment. They are -emitted as pure declarations, without their body; and the declaration may -appear in the wrong place (before any lexicals the body closes over, or -before the C<use feature> declaration that permits use of this feature). - -We expect to resolve this before the lexical-subroutine feature is no longer -considered experimental. - -=item * - -Lexical C<state> subroutines are not deparsed at all at the moment. - -We expect to resolve this before the lexical-subroutine feature is no longer -considered experimental. - =back =head1 AUTHOR diff --git a/gnu/usr.bin/perl/dist/B-Deparse/t/deparse.t b/gnu/usr.bin/perl/dist/B-Deparse/t/deparse.t index 7d4f9fe4f57..e3c62baeebb 100755 --- a/gnu/usr.bin/perl/dist/B-Deparse/t/deparse.t +++ b/gnu/usr.bin/perl/dist/B-Deparse/t/deparse.t @@ -11,41 +11,56 @@ BEGIN { use warnings; use strict; -use Test::More; - -my $tests = 18; # not counting those in the __DATA__ section +BEGIN { + # BEGIN block is acutally a subroutine :-) + return unless $] > 5.009; + require feature; + feature->import(':5.10'); +} +use Test::More tests => 85; +use Config (); use B::Deparse; my $deparse = B::Deparse->new(); -isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object'); +ok($deparse); + +# Tell B::Deparse about our ambient pragmas +{ my ($hint_bits, $warning_bits, $hinthash); + BEGIN { ($hint_bits, $warning_bits, $hinthash) = ($^H, ${^WARNING_BITS}, \%^H); } + $deparse->ambient_pragmas ( + hint_bits => $hint_bits, + warning_bits => $warning_bits, + '$[' => 0 + $[, + '%^H' => $hinthash, + ); +} $/ = "\n####\n"; while (<DATA>) { chomp; - $tests ++; # This code is pinched from the t/lib/common.pl for TODO. # It's not clear how to avoid duplication - my %meta = (context => ''); - foreach my $what (qw(skip todo context)) { - s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1; + # Now tweaked a bit to do skip or todo + my %reason; + foreach my $what (qw(skip todo)) { + s/^#\s*\U$what\E\s*(.*)\n//m and $reason{$what} = $1; # If the SKIP reason starts ? then it's taken as a code snippet to # evaluate. This provides the flexibility to have conditional SKIPs - if ($meta{$what} && $meta{$what} =~ s/^\?//) { - my $temp = eval $meta{$what}; + if ($reason{$what} && $reason{$what} =~ s/^\?//) { + my $temp = eval $reason{$what}; if ($@) { - die "# In \U$what\E code reason:\n# $meta{$what}\n$@"; + die "# In \U$what\E code reason:\n# $reason{$what}\n$@"; } - $meta{$what} = $temp; + $reason{$what} = $temp; } } s/^\s*#\s*(.*)$//mg; - my $desc = $1; - die "Missing name in test $_" unless defined $desc; + my ($num, $testname) = $1 =~ m/(\d+)\s*(.*)/; - if ($meta{skip}) { + if ($reason{skip}) { # Like this to avoid needing a label SKIP: - Test::More->builder->skip($meta{skip}); + Test::More->builder->skip($reason{skip}); next; } @@ -57,21 +72,11 @@ while (<DATA>) { ($input, $expected) = ($_, $_); } - my $coderef = eval "$meta{context};\n" . <<'EOC' . "sub {$input}"; -# Tell B::Deparse about our ambient pragmas -my ($hint_bits, $warning_bits, $hinthash); -BEGIN { - ($hint_bits, $warning_bits, $hinthash) = ($^H, ${^WARNING_BITS}, \%^H); -} -$deparse->ambient_pragmas ( - hint_bits => $hint_bits, - warning_bits => $warning_bits, - '%^H' => $hinthash, -); -EOC + my $coderef = eval "sub {$input}"; if ($@) { - is($@, "", "compilation of $desc"); + diag("$num deparsed: $@"); + ok(0, $testname); } else { my $deparsed = $deparse->coderef2text( $coderef ); @@ -80,31 +85,28 @@ EOC $regex =~ s/\s+/\\s+/g; $regex = '^\{\s*' . $regex . '\s*\}$'; - local $::TODO = $meta{todo}; - like($deparsed, qr/$regex/, $desc); + local $::TODO = $reason{todo}; + like($deparsed, qr/$regex/, $testname); } } use constant 'c', 'stuff'; -is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff', - 'the subroutine generated by use constant deparses'); +is((eval "sub ".$deparse->coderef2text(\&c))->(), 'stuff'); my $a = 0; -is($deparse->coderef2text(sub{(-1) ** $a }), "{\n (-1) ** \$a;\n}", - 'anon sub capturing an external lexical'); +is("{\n (-1) ** \$a;\n}", $deparse->coderef2text(sub{(-1) ** $a })); use constant cr => ['hello']; my $string = "sub " . $deparse->coderef2text(\&cr); my $val = (eval $string)->() or diag $string; -is(ref($val), 'ARRAY', 'constant array references deparse'); -is($val->[0], 'hello', 'and return the correct value'); +is(ref($val), 'ARRAY'); +is($val->[0], 'hello'); my $path = join " ", map { qq["-I$_"] } @INC; $a = `$^X $path "-MO=Deparse" -anlwi.bak -e 1 2>&1`; $a =~ s/-e syntax OK\n//g; $a =~ s/.*possible typo.*\n//; # Remove warning line -$a =~ s/.*-i used with no filenames.*\n//; # Remove warning line $a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037 $a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc' $b = <<'EOF'; @@ -117,8 +119,7 @@ LINE: while (defined($_ = <ARGV>)) { '???'; } EOF -is($a, $b, - 'command line flags deparse as BEGIN blocks setting control variables'); +is($a, $b); $a = `$^X $path "-MO=Deparse" -e "use constant PI => 4" 2>&1`; $a =~ s/-e syntax OK\n//g; @@ -151,8 +152,7 @@ use POSIX qw/O_CREAT/; sub test { my $val = shift; my $res = B::Deparse::Wrapper::getcode($val); - like($res, qr/use warnings/, - '[perl #35857] [PATCH] B::Deparse doesnt handle warnings register properly'); + like( $res, qr/use warnings/); } my ($q,$p); my $x=sub { ++$q,++$p }; @@ -166,118 +166,28 @@ eval <<EOFCODE and test($x); 1 EOFCODE -# Exotic sub declarations -$a = `$^X $path "-MO=Deparse" -e "sub ::::{}sub ::::::{}" 2>&1`; -$a =~ s/-e syntax OK\n//g; -is($a, <<'EOCODG', "sub :::: and sub ::::::"); -sub :::: { - -} -sub :::::: { - -} -EOCODG - -# [perl #33752] -{ - my $code = <<"EOCODE"; -{ - our \$\x{1e1f}\x{14d}\x{14d}; -} -EOCODE - my $deparsed - = $deparse->coderef2text(eval "sub { our \$\x{1e1f}\x{14d}\x{14d} }" ); - s/$ \n//x for $deparsed, $code; - is $deparsed, $code, 'our $funny_Unicode_chars'; -} - -# [perl #62500] -$a = - `$^X $path "-MO=Deparse" -e "BEGIN{*CORE::GLOBAL::require=sub{1}}" 2>&1`; -$a =~ s/-e syntax OK\n//g; -is($a, <<'EOCODF', "CORE::GLOBAL::require override causing panick"); -sub BEGIN { - *CORE::GLOBAL::require = sub { - 1; - } - ; -} -EOCODF - -# [perl #91384] -$a = - `$^X $path "-MO=Deparse" -e "BEGIN{*Acme::Acme:: = *Acme::}" 2>&1`; -like($a, qr/-e syntax OK/, - "Deparse does not hang when traversing stash circularities"); - -# [perl #93990] -@] = (); -is($deparse->coderef2text(sub{ print "@{]}" }), -q<{ - print "@{]}"; -}>, 'curly around to interpolate "@{]}"'); -is($deparse->coderef2text(sub{ print "@{-}" }), -q<{ - print "@-"; -}>, 'no need to curly around to interpolate "@-"'); - -# Strict hints in %^H are mercilessly suppressed -$a = - `$^X $path "-MO=Deparse" -e "use strict; print;" 2>&1`; -unlike($a, qr/BEGIN/, - "Deparse does not emit strict hh hints"); - -# ambient_pragmas should not mess with strict settings. -SKIP: { - skip "requires 5.11", 1 unless $] >= 5.011; - eval q` - BEGIN { - # Clear out all hints - %^H = (); - $^H = 0; - new B::Deparse -> ambient_pragmas(strict => 'all'); - } - use 5.011; # should enable strict - ok !eval '$do_noT_create_a_variable_with_this_name = 1', - 'ambient_pragmas do not mess with compiling scope'; - `; -} - -# multiple statements on format lines -$a = `$^X $path "-MO=Deparse" -e "format =" -e "\@" -e "x();z()" -e. 2>&1`; -$a =~ s/-e syntax OK\n//g; -is($a, <<'EOCODH', 'multiple statements on format lines'); -format STDOUT = -@ -x(); z() -. -EOCODH - - -done_testing($tests); - __DATA__ -# A constant +# 2 1; #### -# Constants in a block +# 3 { no warnings; '???'; 2; } #### -# Lexical and simple arithmetic +# 4 my $test; ++$test and $test /= 2; >>>> my $test; $test /= 2 if ++$test; #### -# list x +# 5 -((1, 2) x 2); #### -# lvalue sub +# 6 { my $test = sub : lvalue { my $x; @@ -285,7 +195,7 @@ $test /= 2 if ++$test; ; } #### -# method +# 7 { my $test = sub : method { my $x; @@ -293,7 +203,11 @@ $test /= 2 if ++$test; ; } #### -# block with continue +# 8 +# Was sub : locked method { ... } +# This number could be re-used. +#### +# 9 { 234; } @@ -301,276 +215,166 @@ continue { 123; } #### -# lexical and package scalars +# 10 my $x; print $main::x; #### -# lexical and package arrays +# 11 my @x; print $main::x[1]; #### -# lexical and package hashes +# 12 my %x; $x{warn()}; #### -# <> +# 13 my $foo; $_ .= <ARGV> . <$foo>; #### -# \x{} -my $foo = "Ab\x{100}\200\x{200}\237Cd\000Ef\x{1000}\cA\x{2000}\cZ"; +# 14 +my $foo = "Ab\x{100}\200\x{200}\377Cd\000Ef\x{1000}\cA\x{2000}\cZ"; #### -# s///e +# 15 s/x/'y';/e; -s/x/$a;/e; -s/x/complex_expression();/e; #### -# block +# 16 - various lypes of loop { my $x; } #### -# while 1 +# 17 while (1) { my $k; } #### -# trailing for +# 18 my ($x,@a); $x=1 for @a; >>>> my($x, @a); $x = 1 foreach (@a); #### -# 2 arguments in a 3 argument for +# 19 for (my $i = 0; $i < 2;) { my $z = 1; } #### -# 3 argument for +# 20 for (my $i = 0; $i < 2; ++$i) { my $z = 1; } #### -# 3 argument for again +# 21 for (my $i = 0; $i < 2; ++$i) { my $z = 1; } #### -# while/continue +# 22 my $i; while ($i) { my $z = 1; } continue { $i = 99; } #### -# foreach with my +# 23 foreach my $i (1, 2) { my $z = 1; } #### -# foreach +# 24 my $i; foreach $i (1, 2) { my $z = 1; } #### -# foreach, 2 mys +# 25 my $i; foreach my $i (1, 2) { my $z = 1; } #### -# foreach +# 26 foreach my $i (1, 2) { my $z = 1; } #### -# foreach with our +# 27 foreach our $i (1, 2) { my $z = 1; } #### -# foreach with my and our +# 28 my $i; foreach our $i (1, 2) { my $z = 1; } #### -# reverse sort +# 29 my @x; print reverse sort(@x); #### -# sort with cmp +# 30 my @x; print((sort {$b cmp $a} @x)); #### -# reverse sort with block +# 31 my @x; print((reverse sort {$b <=> $a} @x)); #### -# foreach reverse +# 32 our @a; print $_ foreach (reverse @a); #### -# foreach reverse (not inplace) +# 33 our @a; print $_ foreach (reverse 1, 2..5); #### -# bug #38684 +# 34 (bug #38684) our @ary; @ary = split(' ', 'foo', 0); #### -# bug #40055 +# 35 (bug #40055) do { () }; #### -# bug #40055 +# 36 (ibid.) do { my $x = 1; $x }; #### -# <20061012113037.GJ25805@c4.convolution.nl> +# 37 <20061012113037.GJ25805@c4.convolution.nl> my $f = sub { +{[]}; } ; #### -# bug #43010 +# 38 (bug #43010) '!@$%'->(); #### -# bug #43010 +# 39 (ibid.) ::(); #### -# bug #43010 +# 40 (ibid.) '::::'->(); #### -# bug #43010 +# 41 (ibid.) &::::; #### -# [perl #77172] -package rt77172; -sub foo {} foo & & & foo; ->>>> -package rt77172; -foo(&{&} & foo()); -#### -# variables as method names +# 42 my $bar; 'Foo'->$bar('orz'); -'Foo'->$bar('orz') = 'a stranger stranger than before'; #### -# constants as method names +# 43 'Foo'->bar('orz'); #### -# constants as method names without () +# 44 'Foo'->bar; #### -# [perl #47359] "indirect" method call notation -our @bar; -foo{@bar}+1,->foo; -(foo{@bar}+1),foo(); -foo{@bar}1 xor foo(); ->>>> -our @bar; -(foo { @bar } 1)->foo; -(foo { @bar } 1), foo(); -foo { @bar } 1 xor foo(); -#### # SKIP ?$] < 5.010 && "say not implemented on this Perl version" -# CONTEXT use feature ':5.10'; -# say +# 45 say say 'foo'; #### -# SKIP ?$] < 5.010 && "say not implemented on this Perl version" -# CONTEXT use 5.10.0; -# say in the context of use 5.10.0 -say 'foo'; -#### -# SKIP ?$] < 5.010 && "say not implemented on this Perl version" -# say with use 5.10.0 -use 5.10.0; -say 'foo'; ->>>> -no feature; -use feature ':5.10'; -say 'foo'; -#### -# SKIP ?$] < 5.010 && "say not implemented on this Perl version" -# say with use feature ':5.10'; -use feature ':5.10'; -say 'foo'; ->>>> -use feature 'say', 'state', 'switch'; -say 'foo'; -#### -# SKIP ?$] < 5.010 && "say not implemented on this Perl version" -# CONTEXT use feature ':5.10'; -# say with use 5.10.0 in the context of use feature -use 5.10.0; -say 'foo'; ->>>> -no feature; -use feature ':5.10'; -say 'foo'; -#### -# SKIP ?$] < 5.010 && "say not implemented on this Perl version" -# CONTEXT use 5.10.0; -# say with use feature ':5.10' in the context of use 5.10.0 -use feature ':5.10'; -say 'foo'; ->>>> -say 'foo'; -#### -# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" -# CONTEXT use feature ':5.15'; -# __SUB__ -__SUB__; -#### -# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" -# CONTEXT use 5.15.0; -# __SUB__ in the context of use 5.15.0 -__SUB__; -#### -# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" -# __SUB__ with use 5.15.0 -use 5.15.0; -__SUB__; ->>>> -no feature; -use feature ':5.16'; -__SUB__; -#### -# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" -# __SUB__ with use feature ':5.15'; -use feature ':5.15'; -__SUB__; ->>>> -use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval'; -__SUB__; -#### -# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" -# CONTEXT use feature ':5.15'; -# __SUB__ with use 5.15.0 in the context of use feature -use 5.15.0; -__SUB__; ->>>> -no feature; -use feature ':5.16'; -__SUB__; -#### -# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" -# CONTEXT use 5.15.0; -# __SUB__ with use feature ':5.15' in the context of use 5.15.0 -use feature ':5.15'; -__SUB__; ->>>> -__SUB__; -#### # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" -# CONTEXT use feature ':5.10'; -# state vars +# 46 state vars state $x = 42; #### # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" -# CONTEXT use feature ':5.10'; -# state var assignment +# 47 state var assignment { my $y = (state $x = 42); } #### # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" -# CONTEXT use feature ':5.10'; -# state vars in anonymous subroutines +# 48 state vars in anoymous subroutines $a = sub { state $x; return $x++; @@ -578,54 +382,53 @@ $a = sub { ; #### # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version' -# each @array; +# 49 each @array; each @ARGV; each @$a; #### # SKIP ?$] < 5.011 && 'each @array not implemented on this Perl version' -# keys @array; values @array +# 50 keys @array; values @array keys @$a if keys @ARGV; values @ARGV if values @$a; #### -# Anonymous arrays and hashes, and references to them +# 51 Anonymous arrays and hashes, and references to them my $a = {}; my $b = \{}; my $c = []; my $d = \[]; #### # SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version" -# CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch'; -# implicit smartmatch in given/when +# 52 implicit smartmatch in given/when given ('foo') { when ('bar') { continue; } when ($_ ~~ 'quux') { continue; } default { 0; } } #### -# conditions in elsifs (regression in change #33710 which fixed bug #37302) +# 53 conditions in elsifs (regression in change #33710 which fixed bug #37302) if ($a) { x(); } elsif ($b) { x(); } elsif ($a and $b) { x(); } elsif ($a or $b) { x(); } else { x(); } #### -# interpolation in regexps +# 54 interpolation in regexps my($y, $t); /x${y}z$t/; #### # TODO new undocumented cpan-bug #33708 -# cpan-bug #33708 +# 55 (cpan-bug #33708) %{$_ || {}} #### # TODO hash constants not yet fixed -# cpan-bug #33708 +# 56 (cpan-bug #33708) use constant H => { "#" => 1 }; H->{"#"} #### # TODO optimized away 0 not yet fixed -# cpan-bug #33708 +# 57 (cpan-bug #33708) foreach my $i (@_) { 0 } #### -# tests with not, not optimized +# 58 tests with not, not optimized my $c; x() unless $a; x() if not $a and $b; @@ -645,7 +448,7 @@ x() if not $a or $b or not $c; x() unless $a or not $b or $c; x() unless not $a or $b or not $c; #### -# tests with not, optimized +# 59 tests with not, optimized my $c; x() if not $a; x() unless not $a; @@ -680,7 +483,7 @@ x() unless $a and $b and $c; x() if $a and $b and $c; x() unless not $a && $b && $c; #### -# tests that should be constant folded +# 60 tests that should be constant folded x() if 1; x() if GLIPP; x() if !GLIPP; @@ -733,7 +536,7 @@ do { #### # TODO constant deparsing has been backed out for 5.12 # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads" -# tests that shouldn't be constant folded +# 61 tests that shouldn't be constant folded # It might be fundamentally impossible to make this work on ithreads, in which # case the TODO should become a SKIP x() if $a; @@ -747,24 +550,24 @@ if (do { foo(); GLIPP }) { x(); } if (do { ++$a; GLIPP }) { x(); } #### # TODO constant deparsing has been backed out for 5.12 -# tests for deparsing constants +# 62 tests for deparsing constants warn PI; #### # TODO constant deparsing has been backed out for 5.12 -# tests for deparsing imported constants +# 63 tests for deparsing imported constants warn O_TRUNC; #### # TODO constant deparsing has been backed out for 5.12 -# tests for deparsing re-exported constants +# 64 tests for deparsing re-exported constants warn O_CREAT; #### # TODO constant deparsing has been backed out for 5.12 -# tests for deparsing imported constants that got deleted from the original namespace +# 65 tests for deparsing imported constants that got deleted from the original namespace warn O_APPEND; #### # TODO constant deparsing has been backed out for 5.12 # XXXTODO ? $Config::Config{useithreads} && "doesn't work with threads" -# tests for deparsing constants which got turned into full typeglobs +# 66 tests for deparsing constants which got turned into full typeglobs # It might be fundamentally impossible to make this work on ithreads, in which # case the TODO should become a SKIP warn O_EXCL; @@ -772,28 +575,19 @@ eval '@Fcntl::O_EXCL = qw/affe tiger/;'; warn O_EXCL; #### # TODO constant deparsing has been backed out for 5.12 -# tests for deparsing of blessed constant with overloaded numification +# 67 tests for deparsing of blessed constant with overloaded numification warn OVERLOADED_NUMIFICATION; #### -# strict +# TODO Only strict 'refs' currently supported +# 68 strict no strict; -print $x; -use strict 'vars'; -print $main::x; -use strict 'subs'; -print $main::x; -use strict 'refs'; -print $main::x; -no strict 'vars'; $x; #### # TODO Subsets of warnings could be encoded textually, rather than as bitflips. -# subsets of warnings no warnings 'deprecated'; my $x; #### # TODO Better test for CPAN #33708 - the deparsed code has different behaviour -# CPAN #33708 use strict; no warnings; @@ -805,585 +599,37 @@ foreach (0..3) { } } #### -# no attribute list my $pi = 4; #### -# SKIP ?$] > 5.013006 && ":= is now a syntax error" -# := treated as an empty attribute list no warnings; my $pi := 4; >>>> no warnings; my $pi = 4; #### -# : = empty attribute list my $pi : = 4; >>>> my $pi = 4; #### -# in place sort our @a; my @b; @a = sort @a; @b = sort @b; (); #### -# in place reverse our @a; my @b; @a = reverse @a; @b = reverse @b; (); #### -# #71870 Use of uninitialized value in bitwise and B::Deparse my($r, $s, @a); @a = split(/foo/, $s, 0); $r = qr/foo/; @a = split(/$r/, $s, 0); (); #### -# package declaration before label { package Foo; label: print 123; } -#### -# shift optimisation -shift; ->>>> -shift(); -#### -# shift optimisation -shift @_; -#### -# shift optimisation -pop; ->>>> -pop(); -#### -# shift optimisation -pop @_; -#### -#[perl #20444] -"foo" =~ (1 ? /foo/ : /bar/); -"foo" =~ (1 ? y/foo// : /bar/); -"foo" =~ (1 ? y/foo//r : /bar/); -"foo" =~ (1 ? s/foo// : /bar/); ->>>> -'foo' =~ ($_ =~ /foo/); -'foo' =~ ($_ =~ tr/fo//); -'foo' =~ ($_ =~ tr/fo//r); -'foo' =~ ($_ =~ s/foo//); -#### -# The fix for [perl #20444] broke this. -'foo' =~ do { () }; -#### -# [perl #81424] match against aelemfast_lex -my @s; -print /$s[1]/; -#### -# /$#a/ -print /$#main::a/; -#### -# [perl #91318] /regexp/applaud -print /a/a, s/b/c/a; -print /a/aa, s/b/c/aa; -print /a/p, s/b/c/p; -print /a/l, s/b/c/l; -print /a/u, s/b/c/u; -{ - use feature "unicode_strings"; - print /a/d, s/b/c/d; -} -{ - use re "/u"; - print /a/d, s/b/c/d; -} -{ - use 5.012; - print /a/d, s/b/c/d; -} ->>>> -print /a/a, s/b/c/a; -print /a/aa, s/b/c/aa; -print /a/p, s/b/c/p; -print /a/l, s/b/c/l; -print /a/u, s/b/c/u; -{ - use feature 'unicode_strings'; - print /a/d, s/b/c/d; -} -{ - BEGIN { $^H{'reflags'} = '0'; - $^H{'reflags_charset'} = '2'; } - print /a/d, s/b/c/d; -} -{ - no feature; - use feature ':5.12'; - print /a/d, s/b/c/d; -} -#### -# Test @threadsv_names under 5005threads -foreach $' (1, 2) { - sleep $'; -} -#### -# y///r -tr/a/b/r; -#### -# y/uni/code/ -tr/\x{345}/\x{370}/; -#### -# [perl #90898] -<a,>; -#### -# [perl #91008] -each $@; -keys $~; -values $!; -#### -# readpipe with complex expression -readpipe $a + $b; -#### -# aelemfast -$b::a[0] = 1; -#### -# aelemfast for a lexical -my @a; -$a[0] = 1; -#### -# feature features without feature -# CONTEXT no warnings 'experimental::smartmatch'; -CORE::state $x; -CORE::say $x; -CORE::given ($x) { - CORE::when (3) { - continue; - } - CORE::default { - CORE::break; - } -} -CORE::evalbytes ''; -() = CORE::__SUB__; -() = CORE::fc $x; -#### -# feature features when feature has been disabled by use VERSION -# CONTEXT no warnings 'experimental::smartmatch'; -use feature (sprintf(":%vd", $^V)); -use 1; -CORE::state $x; -CORE::say $x; -CORE::given ($x) { - CORE::when (3) { - continue; - } - CORE::default { - CORE::break; - } -} -CORE::evalbytes ''; -() = CORE::__SUB__; ->>>> -CORE::state $x; -CORE::say $x; -CORE::given ($x) { - CORE::when (3) { - continue; - } - CORE::default { - CORE::break; - } -} -CORE::evalbytes ''; -() = CORE::__SUB__; -#### -# (the above test with CONTEXT, and the output is equivalent but different) -# CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch'; -# feature features when feature has been disabled by use VERSION -use feature (sprintf(":%vd", $^V)); -use 1; -CORE::state $x; -CORE::say $x; -CORE::given ($x) { - CORE::when (3) { - continue; - } - CORE::default { - CORE::break; - } -} -CORE::evalbytes ''; -() = CORE::__SUB__; ->>>> -no feature; -use feature ':default'; -CORE::state $x; -CORE::say $x; -CORE::given ($x) { - CORE::when (3) { - continue; - } - CORE::default { - CORE::break; - } -} -CORE::evalbytes ''; -() = CORE::__SUB__; -#### -# Feature hints -use feature 'current_sub', 'evalbytes'; -print; -use 1; -print; -use 5.014; -print; -no feature 'unicode_strings'; -print; ->>>> -use feature 'current_sub', 'evalbytes'; -print $_; -no feature; -use feature ':default'; -print $_; -no feature; -use feature ':5.12'; -print $_; -no feature 'unicode_strings'; -print $_; -#### -# $#- $#+ $#{%} etc. -my @x; -@x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}, $#{*}); -@x = ($#{(}, $#{)}, $#{[}, $#{{}, $#{]}, $#{}}, $#{'}, $#{"}, $#{,}); -@x = ($#{<}, $#{.}, $#{>}, $#{/}, $#{?}, $#{=}, $#+, $#{\}, $#{|}, $#-); -@x = ($#{;}, $#{:}); -#### -# ${#} interpolated -# It's a known TODO that warnings are deparsed as bits, not textually. -no warnings; -() = "${#}a"; -#### -# [perl #86060] $( $| $) in regexps need braces -/${(}/; -/${|}/; -/${)}/; -/${(}${|}${)}/; -#### -# ()[...] -my(@a) = ()[()]; -#### -# sort(foo(bar)) -# sort(foo(bar)) is interpreted as sort &foo(bar) -# sort foo(bar) is interpreted as sort foo bar -# parentheses are not optional in this case -print sort(foo('bar')); ->>>> -print sort(foo('bar')); -#### -# substr assignment -substr(my $a, 0, 0) = (foo(), bar()); -$a++; -#### -# This following line works around an unfixed bug that we are not trying to -# test for here: -# CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised -# hint hash -BEGIN { $^H{'foo'} = undef; } -{ - BEGIN { $^H{'bar'} = undef; } - { - BEGIN { $^H{'baz'} = undef; } - { - print $_; - } - print $_; - } - print $_; -} -BEGIN { $^H{q[']} = '('; } -print $_; -#### -# This following line works around an unfixed bug that we are not trying to -# test for here: -# CONTEXT BEGIN { $^H{a} = "b"; delete $^H{a} } # make %^H localised -# hint hash changes that serialise the same way with sort %hh -BEGIN { $^H{'a'} = 'b'; } -{ - BEGIN { $^H{'b'} = 'a'; delete $^H{'a'}; } - print $_; -} -print $_; -#### -# [perl #47361] do({}) and do +{} (variants of do-file) -do({}); -do +{}; -sub foo::do {} -package foo; -CORE::do({}); -CORE::do +{}; ->>>> -do({}); -do({}); -package foo; -CORE::do({}); -CORE::do({}); -#### -# [perl #77096] functions that do not follow the llafr -() = (return 1) + time; -() = (return ($1 + $2) * $3) + time; -() = (return ($a xor $b)) + time; -() = (do 'file') + time; -() = (do ($1 + $2) * $3) + time; -() = (do ($1 xor $2)) + time; -() = (goto 1) + 3; -() = (require 'foo') + 3; -() = (require foo) + 3; -() = (CORE::dump 1) + 3; -() = (last 1) + 3; -() = (next 1) + 3; -() = (redo 1) + 3; -() = (-R $_) + 3; -() = (-W $_) + 3; -() = (-X $_) + 3; -() = (-r $_) + 3; -() = (-w $_) + 3; -() = (-x $_) + 3; -#### -# [perl #97476] not() *does* follow the llafr -$_ = ($a xor not +($1 || 2) ** 2); -#### -# Precedence conundrums with argument-less function calls -() = (eof) + 1; -() = (return) + 1; -() = (return, 1); -() = warn; -() = warn() + 1; -() = setpgrp() + 1; -#### -# loopexes have assignment prec -() = (CORE::dump a) | 'b'; -() = (goto a) | 'b'; -() = (last a) | 'b'; -() = (next a) | 'b'; -() = (redo a) | 'b'; -#### -# [perl #63558] open local(*FH) -open local *FH; -pipe local *FH, local *FH; -#### -# [perl #91416] open "string" -open 'open'; -open '####'; -open '^A'; -open "\ca"; ->>>> -open *open; -open '####'; -open '^A'; -open *^A; -#### -# "string"->[] ->{} -no strict 'vars'; -() = 'open'->[0]; #aelemfast -() = '####'->[0]; -() = '^A'->[0]; -() = "\ca"->[0]; -() = 'a::]b'->[0]; -() = 'open'->[$_]; #aelem -() = '####'->[$_]; -() = '^A'->[$_]; -() = "\ca"->[$_]; -() = 'a::]b'->[$_]; -() = 'open'->{0}; #helem -() = '####'->{0}; -() = '^A'->{0}; -() = "\ca"->{0}; -() = 'a::]b'->{0}; ->>>> -no strict 'vars'; -() = $open[0]; -() = '####'->[0]; -() = '^A'->[0]; -() = $^A[0]; -() = 'a::]b'->[0]; -() = $open[$_]; -() = '####'->[$_]; -() = '^A'->[$_]; -() = $^A[$_]; -() = 'a::]b'->[$_]; -() = $open{'0'}; -() = '####'->{'0'}; -() = '^A'->{'0'}; -() = $^A{'0'}; -() = 'a::]b'->{'0'}; -#### -# [perl #74740] -(f()) vs -f() -$_ = -(f()); -#### -# require <binop> -require 'a' . $1; -#### -#[perl #30504] foreach-my postfix/prefix difference -$_ = 'foo' foreach my ($foo1, $bar1, $baz1); -foreach (my ($foo2, $bar2, $baz2)) { $_ = 'foo' } -foreach my $i (my ($foo3, $bar3, $baz3)) { $i = 'foo' } ->>>> -$_ = 'foo' foreach (my($foo1, $bar1, $baz1)); -foreach $_ (my($foo2, $bar2, $baz2)) { - $_ = 'foo'; -} -foreach my $i (my($foo3, $bar3, $baz3)) { - $i = 'foo'; -} -#### -#[perl #108224] foreach with continue block -foreach (1 .. 3) { print } continue { print "\n" } -foreach (1 .. 3) { } continue { } -foreach my $i (1 .. 3) { print $i } continue { print "\n" } -foreach my $i (1 .. 3) { } continue { } ->>>> -foreach $_ (1 .. 3) { - print $_; -} -continue { - print "\n"; -} -foreach $_ (1 .. 3) { - (); -} -continue { - (); -} -foreach my $i (1 .. 3) { - print $i; -} -continue { - print "\n"; -} -foreach my $i (1 .. 3) { - (); -} -continue { - (); -} -#### -# file handles -no strict; -my $mfh; -open F; -open *F; -open $fh; -open $mfh; -open 'a+b'; -select *F; -select F; -select $f; -select $mfh; -select 'a+b'; -#### -# 'my' works with padrange op -my($z, @z); -my $m1; -$m1 = 1; -$z = $m1; -my $m2 = 2; -my($m3, $m4); -($m3, $m4) = (1, 2); -@z = ($m3, $m4); -my($m5, $m6) = (1, 2); -my($m7, undef, $m8) = (1, 2, 3); -@z = ($m7, undef, $m8); -($m7, undef, $m8) = (1, 2, 3); -#### -# 'our/local' works with padrange op -no strict; -our($z, @z); -our $o1; -local $o11; -$o1 = 1; -local $o1 = 1; -$z = $o1; -$z = local $o1; -our $o2 = 2; -our($o3, $o4); -($o3, $o4) = (1, 2); -local($o3, $o4) = (1, 2); -@z = ($o3, $o4); -@z = local($o3, $o4); -our($o5, $o6) = (1, 2); -our($o7, undef, $o8) = (1, 2, 3); -@z = ($o7, undef, $o8); -@z = local($o7, undef, $o8); -($o7, undef, $o8) = (1, 2, 3); -local($o7, undef, $o8) = (1, 2, 3); -#### -# 'state' works with padrange op -no strict; -use feature 'state'; -state($z, @z); -state $s1; -$s1 = 1; -$z = $s1; -state $s2 = 2; -state($s3, $s4); -($s3, $s4) = (1, 2); -@z = ($s3, $s4); -# assignment of state lists isn't implemented yet -#state($s5, $s6) = (1, 2); -#state($s7, undef, $s8) = (1, 2, 3); -#@z = ($s7, undef, $s8); -($s7, undef, $s8) = (1, 2, 3); -#### -# anon lists with padrange -my($a, $b); -my $c = [$a, $b]; -my $d = {$a, $b}; -#### -# slices with padrange -my($a, $b); -my(@x, %y); -@x = @x[$a, $b]; -@x = @y{$a, $b}; -#### -# binops with padrange -my($a, $b, $c); -$c = $a cmp $b; -$c = $a + $b; -$a += $b; -$c = $a - $b; -$a -= $b; -$c = my $a1 cmp $b; -$c = my $a2 + $b; -$a += my $b1; -$c = my $a3 - $b; -$a -= my $b2; -#### -# 'x' with padrange -my($a, $b, $c, $d, @e); -$c = $a x $b; -$a x= $b; -@e = ($a) x $d; -@e = ($a, $b) x $d; -@e = ($a, $b, $c) x $d; -@e = ($a, 1) x $d; -#### -# @_ with padrange -my($a, $b, $c) = @_; -#### -# SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" -# TODO unimplemented in B::Deparse; RT #116553 -# lexical subroutine -use feature 'lexical_subs'; -no warnings "experimental::lexical_subs"; -my sub f {} -print f(); -#### -# SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" -# TODO unimplemented in B::Deparse; RT #116553 -# lexical "state" subroutine -use feature 'state', 'lexical_subs'; -no warnings 'experimental::lexical_subs'; -state sub f {} -print f(); |