This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix MM doc's use of "SUPER::"
authorJim Avera <avera@hal.com>
Tue, 1 Apr 1997 22:35:26 +0000 (14:35 -0800)
committerChip Salzenberg <chip@atlantic.net>
Tue, 1 Apr 1997 00:01:35 +0000 (12:01 +1200)
Chip Salzenberg <chip@atlantic.net> wrote:
] According to Jim Avera:
] > Was there any resolution of the problem using SUPER:: with MakeMaker?
]
] Yes.  Don't say "sub MY::foo {}"; say "package MY; sub foo {}".
] The current package is important for proper operation of SUPER::.

Thanks for your help.  I appreciate it.
Here is a patch to fix the documentation (in 5.003_95).

p5p-msgid: 9704012235.AA07841@membrane.hal.com

19 files changed:
doio.c
ext/POSIX/POSIX.pm
installperl
lib/Benchmark.pm
lib/CPAN.pm
lib/CPAN/FirstTime.pm
lib/ExtUtils/Embed.pm
lib/ExtUtils/MakeMaker.pm
lib/ExtUtils/Manifest.pm
lib/File/Basename.pm
lib/constant.pm
perl.c
pod/pod2man.PL
pp_ctl.c
pp_sys.c
scope.h
sv.h
t/lib/basename.t
toke.c

diff --git a/doio.c b/doio.c
index a52df3e..271de28 100644 (file)
--- a/doio.c
+++ b/doio.c
 # endif
 #endif
 
-/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
-#ifndef Sock_size_t
-#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED)
-#    define Sock_size_t Size_t
-#  else
-#    define Sock_size_t int
-#  endif
-#endif
-
 bool
 do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
 GV *gv;
@@ -297,10 +288,9 @@ PerlIO *supplied_fp;
            !statbuf.st_mode
 #endif
        ) {
-           Sock_size_t buflen = sizeof tokenbuf;
-           if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf,
-                           &buflen) >= 0
-                 || errno != ENOTSOCK)
+           int buflen = sizeof tokenbuf;
+           if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
+               || errno != ENOTSOCK)
                IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
index 2885c0d..6656443 100644 (file)
@@ -11,7 +11,7 @@ require Exporter;
 require DynaLoader;
 @ISA = qw(Exporter DynaLoader);
 
-$VERSION = "1.02" ;
+$VERSION = "1.01" ;
 
 %EXPORT_TAGS = (
 
@@ -386,7 +386,7 @@ sub kill {
 
 sub raise {
     usage "raise(sig)" if @_ != 1;
-    kill $_[0], $$;    # Is this good enough?
+    kill $$, $_[0];    # Is this good enough?
 }
 
 sub offsetof {
index a654b26..53468a9 100755 (executable)
@@ -243,7 +243,6 @@ if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
                       "${installarchlib}/pod/perldiag.pod");
     if (compare($from, $to) || $nonono) {
        mkpath("${installarchlib}/pod", 1, 0777);
-       unlink($to);
        link($from, $to);
     }
 }
index fa5c9e8..a3c8544 100644 (file)
@@ -176,10 +176,6 @@ for Exporter.
 
 =head1 CAVEATS
 
-Comparing eval'd strings with code references will give you
-inaccurate results: a code reference will show a slower
-execution time than the equivalent eval'd string.
-
 The real time timing is done using time(2) and
 the granularity is therefore only one second.
 
@@ -262,7 +258,7 @@ sub timestr {
     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
     $f = $defaultfmt unless defined $f;
     # format a time in the required style, other formats may be added here
-    $style ||= $defaultstyle;
+    $style = $defaultstyle unless defined $style;
     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
     my $s = "@t $style"; # default for unknown style
     $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
index a163faf..08246f7 100644 (file)
@@ -1,11 +1,11 @@
 package CPAN;
 use vars qw{$META $Signal $Cwd $End $Suppress_readline};
 
-$VERSION = '1.24';
+$VERSION = '1.21';
 
-# $Id: CPAN.pm,v 1.139 1997/03/31 22:43:23 k Exp $
+# $Id: CPAN.pm,v 1.127 1997/02/11 06:23:10 k Exp $
 
-# my $version = substr q$Revision: 1.139 $, 10; # only used during development
+# my $version = substr q$Revision: 1.127 $, 10; # only used during development
 
 use Carp ();
 use Config ();
@@ -22,9 +22,7 @@ use Safe ();
 use Text::ParseWords ();
 use Text::Wrap;
 
-my $getcwd;
-$getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
-$Cwd = Cwd->$getcwd();
+$Cwd = Cwd::cwd();
 
 END { $End++; &cleanup; }
 
@@ -129,7 +127,7 @@ sub checklock {
                        qq{    kill $other\n}.
                            qq{    rm $lockfile\n};
            } elsif (-w $lockfile) {
-               my($ans) =
+               my($ans)=
                    ExtUtils::MakeMaker::prompt
                        (qq{Other job not responding. Shall I overwrite }.
                         qq{the lockfile? (Y/N)},"y");
@@ -182,7 +180,8 @@ or
        $Signal = 1;
     };
     $SIG{'__DIE__'} = \&cleanup;
-    $self->debug("Signal handler set.") if $CPAN::DEBUG;
+    print STDERR "Signal handler set.\n"
+       unless $CPAN::Config->{'inhibit_startup_message'};
 }
 
 #-> sub CPAN::DESTROY ;
@@ -194,7 +193,7 @@ sub DESTROY {
 sub exists {
     my($mgr,$class,$id) = @_;
     CPAN::Index->reload;
-    ### Carp::croak "exists called without class argument" unless $class;
+    Carp::croak "exists called without class argument" unless $class;
     $id ||= "";
     exists $META->{$class}{$id};
 }
@@ -261,9 +260,8 @@ sub hasWAIT {
 #-> sub CPAN::instance ;
 sub instance {
     my($mgr,$class,$id) = @_;
-    ### CPAN::Index->reload; ### not faster: unless time - $CPAN::Index::last_time > 60;
     CPAN::Index->reload;
-    ### Carp::croak "instance called without class argument" unless $class;
+    Carp::croak "instance called without class argument" unless $class;
     $id ||= "";
     $META->{$class}{$id} ||= $class->new(ID => $id );
 }
@@ -305,9 +303,7 @@ sub shell {
 
     no strict;
     $META->checklock();
-    my $getcwd;
-    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
-    my $cwd = Cwd->$getcwd();
+    my $cwd = Cwd::cwd();
     # How should we determine if we have more than stub ReadLine enabled?
     my $rl_avail = $Suppress_readline ? "suppressed" :
        defined &Term::ReadLine::Perl::readline ? "enabled" :
@@ -321,7 +317,7 @@ Readline support $rl_avail
     while () {
        if ($Suppress_readline) {
            print $prompt;
-           last unless defined ($_ = <> );
+           last unless defined ($_ = <>);
            chomp;
        } else {
 #           if (defined($CPAN::ANDK) && $CPAN::DEBUG) { # !$CPAN::ANDK++;$CPAN::DEBUG=1024
@@ -402,14 +398,14 @@ sub cachesize {
 # }
 
 #-> sub CPAN::CacheMgr::clean_cache ;
-#=# sub clean_cache {
-#=#    my $self = shift;
-#=#    my $dir;
-#=#    while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
-#=#        $self->force_clean_cache($dir);
-#=#    }
-#=#    $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
-#=# }
+sub clean_cache {
+    my $self = shift;
+    my $dir;
+    while ($self->{DU} > $self->{'MAX'} and $dir = shift @{$self->{FIFO}}) {
+       $self->force_clean_cache($dir);
+    }
+    $self->debug("leaving clean_cache with $self->{DU}") if $CPAN::DEBUG;
+}
 
 #-> sub CPAN::CacheMgr::dir ;
 sub dir {
@@ -419,11 +415,8 @@ sub dir {
 #-> sub CPAN::CacheMgr::entries ;
 sub entries {
     my($self,$dir) = @_;
-    $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
     $dir ||= $self->{ID};
-    my $getcwd;
-    $getcwd  = $CPAN::Config->{'getcwd'} || 'cwd';
-    my($cwd) = Cwd->$getcwd();
+    my($cwd) = Cwd::cwd();
     chdir $dir or Carp::croak("Can't chdir to $dir: $!");
     my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
     my(@entries);
@@ -438,22 +431,22 @@ sub entries {
        }
     }
     chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
-    sort { -M $b <=> -M $a} @entries;
+    sort {-M $b <=> -M $a} @entries;
 }
 
 #-> sub CPAN::CacheMgr::disk_usage ;
 sub disk_usage {
     my($self,$dir) = @_;
-#    if (! defined $dir or $dir eq "") {
-#      $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
-#      return;
-#    }
-    return if $self->{SIZE}{$dir};
+    if (! defined $dir or $dir eq "") {
+       $self->debug("Cannot determine disk usage for some reason") if $CPAN::DEBUG;
+       return;
+    }
+    return if defined $self->{SIZE}{$dir};
     local($Du) = 0;
     find(
         sub {
             return if -l $_;
-            $Du += -s _;
+            $Du += -s;
         },
         $dir
        );
@@ -462,10 +455,14 @@ sub disk_usage {
     $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
     $self->{DU} += $Du/1024/1024;
     if ($self->{DU} > $self->{'MAX'} ) {
-       my($toremove) = shift @{$self->{FIFO}};
+       my($toremove) = $self->{FIFO}[0];
        printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
                $self->{DU}, $self->{'MAX'};
-       $self->force_clean_cache($toremove);
+       $self->clean_cache;
+    } else {
+       $self->debug("NOT have to clean the cache: $self->{DU} <= $self->{'MAX'}")
+           if $CPAN::DEBUG;
+       $self->debug($self->as_string) if $CPAN::DEBUG;
     }
     $self->{DU};
 }
@@ -483,9 +480,6 @@ sub force_clean_cache {
 #-> sub CPAN::CacheMgr::new ;
 sub new {
     my $class = shift;
-    my $time = time;
-    my($debug,$t2);
-    $debug = "";
     my $self = {
                ID => $CPAN::Config->{'build_dir'},
                MAX => $CPAN::Config->{'build_cache'},
@@ -498,12 +492,9 @@ sub new {
     my $e;
     for $e ($self->entries) {
        next if $e eq ".." || $e eq ".";
+       $self->debug("Have to check size $e") if $CPAN::DEBUG;
        $self->disk_usage($e);
     }
-    $t2 = time;
-    $debug .= "timing of CacheMgr->new: ".($t2 - $time);
-    $time = $t2;
-    CPAN->debug($debug) if $CPAN::DEBUG;
     $self;
 }
 
@@ -629,7 +620,7 @@ EOF
 
     #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
     #chmod $mode, $configpm;
-###why was that so?    $self->defaults;
+    $self->defaults;
     print "commit: wrote $configpm\n";
     1;
 }
@@ -657,88 +648,84 @@ sub init {
 my $dot_cpan;
 #-> sub CPAN::Config::load ;
 sub load {
-    my($self) = shift;
-    my(@miss);
+    my($self) = @_;
     eval {require CPAN::Config;};       # We eval, because of some MakeMaker problems
     unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
     eval {require CPAN::MyConfig;};     # where you can override system wide settings
-    return unless @miss = $self->not_loaded;
-    require CPAN::FirstTime;
-    my($configpm,$fh,$redo);
-    $redo ||= "";
-    if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
-       $configpm = $INC{"CPAN/Config.pm"};
-       $redo++;
-    } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
-       $configpm = $INC{"CPAN/MyConfig.pm"};
-       $redo++;
-    } else {
-       my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
-       my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
-       my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
-       if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
-           if (-w $configpmtest) {
-               $configpm = $configpmtest;
-           } elsif (-w $configpmdir) {
-               #_#_# following code dumped core on me with 5.003_11, a.k.
-               unlink "$configpmtest.bak" if -f "$configpmtest.bak";
-               rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
-               my $fh = FileHandle->new;
-               if ($fh->open(">$configpmtest")) {
-                   $fh->print("1;\n");
-                   $configpm = $configpmtest;
-               } else {
-                   # Should never happen
-                   Carp::confess("Cannot open >$configpmtest");
-               }
-           }
-       }
-       unless ($configpm) {
-           $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
-           File::Path::mkpath($configpmdir);
-           $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
-           if (-w $configpmtest) {
-               $configpm = $configpmtest;
-           } elsif (-w $configpmdir) {
-               #_#_# following code dumped core on me with 5.003_11, a.k.
-               my $fh = FileHandle->new;
-               if ($fh->open(">$configpmtest")) {
-                   $fh->print("1;\n");
-                   $configpm = $configpmtest;
-               } else {
-                   # Should never happen
-                   Carp::confess("Cannot open >$configpmtest");
-               }
-           } else {
-               Carp::confess(qq{WARNING: CPAN.pm is unable to }.
-                             qq{create a configuration file.});
-           }
-       }
-    }
-    local($") = ", ";
-    print qq{
-We have to reconfigure CPAN.pm due to following uninitialized parameters:
-
-@miss
-} if $redo ;
-    print qq{
+    unless ( $self->load_succeeded ) {
+         require CPAN::FirstTime;
+         my($configpm,$fh);
+         if (defined $INC{"CPAN/Config.pm"} && -w $INC{"CPAN/Config.pm"}) {
+             $configpm = $INC{"CPAN/Config.pm"};
+         } elsif (defined $INC{"CPAN/MyConfig.pm"} && -w $INC{"CPAN/MyConfig.pm"}) {
+             $configpm = $INC{"CPAN/MyConfig.pm"};
+         } else {
+             my($path_to_cpan) = File::Basename::dirname($INC{"CPAN.pm"});
+             my($configpmdir) = MM->catdir($path_to_cpan,"CPAN");
+             my($configpmtest) = MM->catfile($configpmdir,"Config.pm");
+             if (-d $configpmdir or File::Path::mkpath($configpmdir)) {
+                 if (-w $configpmtest) {
+                     $configpm = $configpmtest;
+                 } elsif (-w $configpmdir) {
+#_#_# following code dumped core on me with 5.003_11, a.k.
+                     unlink "$configpmtest.bak" if -f "$configpmtest.bak";
+                     rename $configpmtest, "$configpmtest.bak" if -f $configpmtest;
+                     my $fh = FileHandle->new;
+                     if ($fh->open(">$configpmtest")) {
+                         $fh->print("1;\n");
+                         $configpm = $configpmtest;
+                     } else {
+                         # Should never happen
+                         Carp::confess("Cannot open >$configpmtest");
+                     }
+                 }
+             }
+             unless ($configpm) {
+                 $configpmdir = MM->catdir($ENV{HOME},".cpan","CPAN");
+                 File::Path::mkpath($configpmdir);
+                 $configpmtest = MM->catfile($configpmdir,"MyConfig.pm");
+                 if (-w $configpmtest) {
+                     $configpm = $configpmtest;
+                 } elsif (-w $configpmdir) {
+#_#_# following code dumped core on me with 5.003_11, a.k.
+                     my $fh = FileHandle->new;
+                     if ($fh->open(">$configpmtest")) {
+                         $fh->print("1;\n");
+                         $configpm = $configpmtest;
+                     } else {
+                         # Should never happen
+                         Carp::confess("Cannot open >$configpmtest");
+                     }
+                 } else {
+                     Carp::confess(qq{WARNING: CPAN.pm is unable to }.
+                                   qq{create a configuration file.});
+                 }
+             }
+         }
+         CPAN->debug(qq{Calling CPAN::FirstTime::init("$configpm")})
+             if $CPAN::DEBUG;
+         print qq{
+Configuring CPAN.pm.
 $configpm initialized.
 };
-    sleep 2;
-    CPAN::FirstTime::init($configpm);
+         CPAN::FirstTime::init($configpm);
+    }
 }
 
-#-> sub CPAN::Config::not_loaded ;
-sub not_loaded {
-    my(@miss);
+#-> sub CPAN::Config::load_succeeded ;
+sub load_succeeded {
+    my($miss) = 0;
     for (qw(
            cpan_home keep_source_where build_dir build_cache index_expire
            gzip tar unzip make pager makepl_arg make_arg make_install_arg
            urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
           )) {
-       push @miss, $_ unless defined $CPAN::Config->{$_};
+       unless (defined $CPAN::Config->{$_}){
+           $miss++;
+           CPAN->debug("undefined configuration parameter $_") if $CPAN::DEBUG;
+       }
     }
-    return @miss;
+    return !$miss;
 }
 
 #-> sub CPAN::Config::unload ;
@@ -877,7 +864,7 @@ sub i {
     for $type (@type) {
        push @result, $self->expand($type,@args);
     }
-    my $result =  @result == 1 ?
+    my $result =  @result==1 ?
        $result[0]->as_string :
            join "", map {$_->as_glimpse} @result;
     $result ||= "No objects found of any type for argument @args\n";
@@ -1108,7 +1095,7 @@ sub _u_r_common {
        }
     }
     if ($what eq "r" && $version_zeroes) {
-       my $s = $version_zeroes > 1 ? "s have" : " has";
+       my $s = $version_zeroes>1 ? "s have" : " has";
        print qq{$version_zeroes installed module$s no version number to compare\n};
     }
     @result;
@@ -1213,7 +1200,7 @@ sub expand {
            push @m, $obj;
        }
     }
-    return wantarray ? @m : $m[0];
+    return @m;
 }
 
 #-> sub CPAN::Shell::format_result ;
@@ -1222,7 +1209,7 @@ sub format_result {
     my($type,@args) = @_;
     @args = '/./' unless @args;
     my(@result) = $self->expand($type,@args);
-    my $result =  @result == 1 ?
+    my $result =  @result==1 ?
        $result[0]->as_string :
            join "", map {$_->as_glimpse} @result;
     $result ||= "No objects of type $type found for argument @args\n";
@@ -1268,13 +1255,7 @@ sub rematein {
            $obj = $CPAN::META->instance('CPAN::Author',$s);
            print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
        } else {
-           print qq{Warning: Cannot $meth $s, don\'t know what it is.
-Try the command
-
-    i /$s/
-
-to find objects with similar identifiers.
-};
+           print "Warning: Cannot $meth $s, don't know what it is\n";
        }
     }
 }
@@ -1339,7 +1320,6 @@ sub localize {
     $self->debug("file [$file] aslocal [$aslocal]") if $CPAN::DEBUG;
 
     return $aslocal if -f $aslocal && -r _ && ! $force;
-    rename $aslocal, "$aslocal.bak" if -f $aslocal;
 
     my($aslocal_dir) = File::Basename::dirname($aslocal);
     File::Path::mkpath($aslocal_dir);
@@ -1445,7 +1425,7 @@ Trying with $funkyftp to get
            if (($wstatus = system($system)) == 0) {
                if ($want_compressed) {
                    $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
-                   if (system($system) == 0) {
+                   if (system($system)==0) {
                        rename $aslocal, "$aslocal.gz";
                    } else {
                        $system = "$CPAN::Config->{'gzip'} $aslocal";
@@ -1454,7 +1434,7 @@ Trying with $funkyftp to get
                    return "$aslocal.gz";
                } else {
                    $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
-                   if (system($system) == 0) {
+                   if (system($system)==0) {
                        $system = "$CPAN::Config->{'gzip'} -d $aslocal";
                        system($system);
                    } else {
@@ -1478,7 +1458,7 @@ returned status $estatus (wstat $wstatus)
                my $timestamp = 0;
                my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
                   $ctime,$blksize,$blocks) = stat($aslocal);
-               $timestamp = $mtime ||= 0;
+               $timestamp = $mtime ||=0;
 
                my($netrc) = CPAN::FTP::netrc->new;
                my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
@@ -1595,80 +1575,9 @@ Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
        print Text::Wrap::wrap("","",$mess), "\n";
     }
     print "Cannot fetch $file\n";
-    if (-f "$aslocal.bak") {
-       rename "$aslocal.bak", $aslocal;
-       print "Trying to get away with old file:\n";
-       print $self->ls($aslocal);
-       return $aslocal;
-    }
     return;
 }
 
-# find2perl needs modularization, too, all the following is stolen
-# from there
-sub ls {
-    my($self,$name) = @_;
-    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
-     $atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
-
-    my($perms,%user,%group);
-    my $pname = $name;
-
-    if (defined $blocks) {
-       $blocks = int(($blocks + 1) / 2);
-    }
-    else {
-       $blocks = int(($sizemm + 1023) / 1024);
-    }
-
-    if    (-f _) { $perms = '-'; }
-    elsif (-d _) { $perms = 'd'; }
-    elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
-    elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
-    elsif (-p _) { $perms = 'p'; }
-    elsif (-S _) { $perms = 's'; }
-    else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
-
-    my(@rwx) = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
-    my(@moname) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-    my $tmpmode = $mode;
-    my $tmp = $rwx[$tmpmode & 7];
-    $tmpmode >>= 3;
-    $tmp = $rwx[$tmpmode & 7] . $tmp;
-    $tmpmode >>= 3;
-    $tmp = $rwx[$tmpmode & 7] . $tmp;
-    substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
-    substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
-    substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
-    $perms .= $tmp;
-
-    my $user = $user{$uid} || $uid;   # too lazy to implement lookup
-    my $group = $group{$gid} || $gid;
-
-    my($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
-    my($timeyear);
-    my($moname) = $moname[$mon];
-    if (-M _ > 365.25 / 2) {
-       $timeyear = $year + 1900;
-    }
-    else {
-       $timeyear = sprintf("%02d:%02d", $hour, $min);
-    }
-
-    sprintf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
-           $ino,
-                $blocks,
-                     $perms,
-                           $nlink,
-                               $user,
-                                    $group,
-                                         $sizemm,
-                                             $moname,
-                                                $mday,
-                                                    $timeyear,
-                                                        $pname;
-}
-
 package CPAN::FTP::netrc;
 
 sub new {
@@ -1795,8 +1704,8 @@ sub complete_reload {
     my(@words) = split " ", $line;
     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
     my(@ok) = qw(cpan index);
-    return @ok if @words == 1;
-    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
+    return @ok if @words==1;
+    return grep /^\Q$word\E/, @ok if @words==2 && $word;
 }
 
 #-> sub CPAN::Complete::complete_option ;
@@ -1806,8 +1715,8 @@ sub complete_option {
     my(@words) = split " ", $line;
     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
     my(@ok) = qw(conf debug);
-    return @ok if @words == 1;
-    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
+    return @ok if @words==1;
+    return grep /^\Q$word\E/, @ok if @words==2 && $word;
     if (0) {
     } elsif ($words[1] eq 'index') {
        return ();
@@ -1819,10 +1728,9 @@ sub complete_option {
 }
 
 package CPAN::Index;
-use vars qw($last_time $date_of_03);
+use vars qw($last_time);
 @CPAN::Index::ISA = qw(CPAN::Debug);
 $last_time ||= 0;
-$date_of_03 ||= 0;
 
 #-> sub CPAN::Index::force_reload ;
 sub force_reload {
@@ -1837,53 +1745,36 @@ sub reload {
     my $time = time;
 
     # XXX check if a newer one is available. (We currently read it from time to time)
-    for ($CPAN::Config->{index_expire}) {
-       $_ = 0.001 unless $_ > 0.001;
-    }
     return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
-    my($debug,$t2);
     $last_time = $time;
 
     $cl->read_authindex($cl->reload_x(
                                      "authors/01mailrc.txt.gz",
                                      "01mailrc.gz",
                                      $force));
-    $t2 = time;
-    $debug = "timing reading 01[".($t2 - $time)."]";
-    $time = $t2;
     return if $CPAN::Signal; # this is sometimes lengthy
     $cl->read_modpacks($cl->reload_x(
                                     "modules/02packages.details.txt.gz",
                                     "02packag.gz",
                                     $force));
-    $t2 = time;
-    $debug .= "02[".($t2 - $time)."]";
-    $time = $t2;
     return if $CPAN::Signal; # this is sometimes lengthy
     $cl->read_modlist($cl->reload_x(
                                    "modules/03modlist.data.gz",
                                    "03mlist.gz",
                                    $force));
-    $t2 = time;
-    $debug .= "03[".($t2 - $time)."]";
-    $time = $t2;
-    CPAN->debug($debug) if $CPAN::DEBUG;
 }
 
 #-> sub CPAN::Index::reload_x ;
 sub reload_x {
     my($cl,$wanted,$localname,$force) = @_;
     $force ||= 0;
-    CPAN::Config->load; # we should guarantee loading wherever we rely on Config XXX
     my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},$localname);
-    if (
-       -f $abs_wanted &&
+    if (-f $abs_wanted &&
        -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
-       !$force
-       ) {
-       my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
+       !$force) {
+       my($s) = $CPAN::Config->{'index_expire'} != 1;
        $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
-                  qq{day$s. I\'ll use that.});
+                  qq{day$s. I\'ll use that.\n});
        return $abs_wanted;
     } else {
        $force ||= 1;
@@ -1918,22 +1809,23 @@ sub read_modpacks {
     print "Going to read $index_target\n";
     my $fh = FileHandle->new("$pipe|");
     while (<$fh>) {
-       last if /^\s*$/;
-    }
-    while (<$fh>) {
+       next if 1../^\s*$/;
        chomp;
        my($mod,$version,$dist) = split;
-###    $version =~ s/^\+//;
+       $version =~ s/^\+//;
 
        # if it as a bundle, instatiate a bundle object
-       my($bundle,$id,$userid);
-       
+       my($bundle);
+       if ($mod =~ /^Bundle::(.*)/) {
+           $bundle = $1;
+       }
+
        if ($mod eq 'CPAN') {
-           local($^W)= 0;
+           local($^W)=0;
            if ($version > $CPAN::VERSION){
                print qq{
-  There\'s a new CPAN.pm version (v$version) available!
-  You might want to try
+  Hey, you know what? There\'s a new CPAN.pm version (v$version)
+  available! I\'d suggest--provided you have time--you try
     install CPAN
     reload cpan
   without quitting the current session. It should be a seemless upgrade
@@ -1943,13 +1835,12 @@ sub read_modpacks {
                print qq{\n};
            }
            last if $CPAN::Signal;
-       } elsif ($mod =~ /^Bundle::(.*)/) {
-           $bundle = $1;
        }
 
+       my($id);
        if ($bundle){
            $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
-###        $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
+           $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
 # This "next" makes us faster but if the job is running long, we ignore
 # rereads which is bad. So we have to be a bit slower again.
 #      } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
@@ -1957,19 +1848,12 @@ sub read_modpacks {
        } else {
            # instantiate a module object
            $id = $CPAN::META->instance('CPAN::Module',$mod);
-###        $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
-###            if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
+           $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
        }
 
-       if ($id->cpan_file ne $dist){
-           # determine the author
-           ($userid) = $dist =~ /([^\/]+)/;
-           $id->set(
-                    'CPAN_USERID' => $userid,
-                    'CPAN_VERSION' => $version,
-                    'CPAN_FILE' => $dist
-                   );
-       }
+       # determine the author
+       my($userid) = $dist =~ /([^\/]+)/;
+       $id->set('CPAN_USERID' => $userid) if $userid =~ /\w/;
 
        # instantiate a distribution object
        unless ($CPAN::META->exists('CPAN::Distribution',$dist)) {
@@ -1977,7 +1861,8 @@ sub read_modpacks {
                                  'CPAN::Distribution' => $dist
                                 )->set(
                                        'CPAN_USERID' => $userid
-                                      );
+                                      )
+                                    if $userid =~ /\w/;
        }
 
        return if $CPAN::Signal;
@@ -1994,10 +1879,6 @@ sub read_modlist {
     my $fh = FileHandle->new("$pipe|");
     my $eval;
     while (<$fh>) {
-       if (/^Date:\s+(.*)/){
-           return if $date_of_03 eq $1;
-           ($date_of_03) = $1;
-       }
        last if /^\s*$/;
     }
     local($/) = undef;
@@ -2141,14 +2022,14 @@ sub get {
        $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
        if ($local_file =~ /z$/i){
            $self->{archived} = "tar";
-           if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")== 0) {
+           if (system("$CPAN::Config->{gzip} --decompress --stdout $local_file | $CPAN::Config->{tar} xvf -")==0) {
                $self->{unwrapped} = "YES";
            } else {
                $self->{unwrapped} = "NO";
            }
        } elsif ($local_file =~ /zip$/i) {
            $self->{archived} = "zip";
-           if (system("$CPAN::Config->{unzip} $local_file") == 0) {
+           if (system("$CPAN::Config->{unzip} $local_file")==0) {
                $self->{unwrapped} = "YES";
            } else {
                $self->{unwrapped} = "NO";
@@ -2240,12 +2121,10 @@ Please define it with "o conf shell <your shell>"
     my $dist = $self->id;
     my $dir  = $self->dir or $self->get;
     $dir = $self->dir;
-    my $getcwd;
-    $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
-    my $pwd  = Cwd->$getcwd();
+    my $pwd  = Cwd::cwd();
     chdir($dir);
     print qq{Working directory is $dir.\n};
-    system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
+    system($CPAN::Config->{'shell'})==0 or die "Subprocess shell error";
     chdir($pwd);
 }
 
@@ -2316,7 +2195,7 @@ sub verifyMD5 {
                                          'force>:-{'
                                         );
        my $system = "$CPAN::Config->{gzip} --decompress $local_file";
-       system($system) == 0 or die "Could not uncompress $local_file";
+       system($system)==0 or die "Could not uncompress $local_file";
        $local_file =~ s/\.gz$//;
     }
     $self->MD5_check_file($local_file,$basename);
@@ -2327,7 +2206,7 @@ sub MD5_check_file {
     my($self,$lfile,$basename) = @_;
     my($cksum);
     my $fh = new FileHandle;
-    local($/) = undef;
+    local($/)=undef;
     if (open $fh, $lfile){
        my $eval = <$fh>;
        close $fh;
@@ -2410,10 +2289,7 @@ sub force {
 sub perl {
     my($self) = @_;
     my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
-    my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
-    my $pwd  = Cwd->$getcwd();
-    my $candidate = $CPAN::META->catfile($pwd,$^X);
-    $perl ||= $candidate if MM->maybe_command($candidate);
+    $perl ||= "$CPAN::Cwd/$^X" if -x "$CPAN::Cwd/$^X";
     unless ($perl) {
        my ($component,$perl_name);
       DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
@@ -2470,46 +2346,44 @@ sub make {
 #          if $] > 5.00310;
        $system = "$perl $switch Makefile.PL $CPAN::Config->{makepl_arg}";
     }
-    {
-       local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
-       my($ret,$pid);
-       $@ = "";
-       if ($CPAN::Config->{inactivity_timeout}) {
-           eval {
-               alarm $CPAN::Config->{inactivity_timeout};
-               local $SIG{CHLD} = sub { wait };
-               if (defined($pid = fork)) {
-                   if ($pid) { #parent
-                       wait;
-                   } else {    #child
-                       exec $system;
-                   }
-               } else {
-                   print "Cannot fork: $!";
-                   return;
+    $SIG{ALRM} = sub { die "inactivity_timeout reached\n" };
+    my($ret,$pid);
+    $@ = "";
+    if ($CPAN::Config->{inactivity_timeout}) {
+       eval {
+           alarm $CPAN::Config->{inactivity_timeout};
+           #$SIG{CHLD} = \&REAPER;
+           if (defined($pid=fork)) {
+               if ($pid) { #parent
+                   wait;
+               } else {    #child
+                   exec $system;
                }
-           };
-           alarm 0;
-           if ($@){
-               kill 9, $pid;
-               waitpid $pid, 0;
-               print $@;
-               $self->{writemakefile} = "NO - $@";
-               $@ = "";
+           } else {
+               print "Cannot fork: $!";
                return;
            }
-       } else {
            $ret = system($system);
-           if ($ret != 0) {
-               $self->{writemakefile} = "NO";
-               return;
-           }
-       }
+       };
+       alarm 0;
+    } else {
+       $ret = system($system);
+    }
+    if ($@){
+       kill 9, $pid;
+       waitpid $pid, 0;
+       print $@;
+       $self->{writemakefile} = "NO - $@";
+       $@ = "";
+       return;
+    } elsif ($ret != 0) {
+        $self->{writemakefile} = "NO";
+        return;
     }
     $self->{writemakefile} = "YES";
     return if $CPAN::Signal;
     $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
-    if (system($system) == 0) {
+    if (system($system)==0) {
         print "  $system -- OK\n";
         $self->{'make'} = "YES";
     } else {
@@ -2540,7 +2414,7 @@ sub test {
     chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
     $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
     my $system = join " ", $CPAN::Config->{'make'}, "test";
-    if (system($system) == 0) {
+    if (system($system)==0) {
         print "  $system -- OK\n";
         $self->{'make_test'} = "YES";
     } else {
@@ -2561,7 +2435,7 @@ sub clean {
     chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
     $self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
     my $system = join " ", $CPAN::Config->{'make'}, "clean";
-    if (system($system) == 0) {
+    if (system($system)==0) {
        print "  $system -- OK\n";
        $self->force;
     } else {
@@ -2643,13 +2517,14 @@ sub contains {
        # Try to get at it in the cpan directory
        $self->debug("no parsefile") if $CPAN::DEBUG;
        my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
+       $self->debug($dist->as_string) if $CPAN::DEBUG;
        $dist->get;
        $self->debug($dist->as_string) if $CPAN::DEBUG;
        my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
        File::Path::mkpath($todir);
        my($me,$from,$to);
        ($me = $self->id) =~ s/.*://;
-       $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
+       $from = $CPAN::META->catfile($dist->{'build_dir'},"$me.pm");
        $to = $CPAN::META->catfile($todir,"$me.pm");
        File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
        $parsefile = $to;
@@ -2675,33 +2550,6 @@ sub contains {
     @result;
 }
 
-#-> sub CPAN::Bundle::find_bundle_file
-sub find_bundle_file {
-    my($self,$where,$what) = @_;
-    my $bu = $CPAN::META->catfile($where,$what);
-    return $bu if -f $bu;
-    my $manifest = $CPAN::META->catfile($where,"MANIFEST");
-    unless (-f $manifest) {
-       require ExtUtils::Manifest;
-       my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
-       my $cwd = Cwd->$getcwd();
-       chdir $where;
-       ExtUtils::Manifest::mkmanifest();
-       chdir $cwd;
-    }
-    my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
-    local($/) = "\n";
-    while (<$fh>) {
-       next if /^\s*\#/;
-       my($file) = /(\S+)/;
-       if ($file =~ m|Bundle/$what$|) {
-           $bu = $file;
-           return $CPAN::META->catfile($where,$bu);
-       }
-    }
-    Carp::croak("Could't find a Bundle file in $where");
-}
-
 #-> sub CPAN::Bundle::inst_file ;
 sub inst_file {
     my($self) = @_;
@@ -2734,13 +2582,6 @@ explicitly a file $s.
     }
 }
 
-#sub CPAN::Bundle::xs_file
-sub xs_file {
-    # If a bundle contains another that contains an xs_file we have
-    # here, we just don't bother I suppose
-    return 0;
-}
-
 #-> sub CPAN::Bundle::force ;
 sub force   { shift->rematein('force',@_); }
 #-> sub CPAN::Bundle::get ;
@@ -2793,7 +2634,7 @@ sub as_string {
                         $sprintf2,
                         'CPAN_USERID',
                         $userid,
-                        CPAN::Shell->expand('Author',$userid)->fullname
+                        $CPAN::META->instance(CPAN::Author,$userid)->fullname
                        )
     }
     push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
@@ -2908,14 +2749,10 @@ sub install {
     if (defined $inst_file) {
        $have = $self->inst_version;
     }
-    if (1){ # A block for scoping $^W, the if is just for the visual
-            # appeal
-       local($^W)=0;
-       if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
-           print $self->id, " is up to date.\n";
-       } else {
-           $doit = 1;
-       }
+    if ($inst_file && $have >= $latest && not exists $self->{'force_update'}) {
+       print $self->id, " is up to date.\n";
+    } else {
+       $doit = 1;
     }
     $self->rematein('install') if $doit;
 }
@@ -2969,7 +2806,6 @@ sub inst_version {
 CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
 
 1;
-__END__
 
 =head1 NAME
 
@@ -3145,80 +2981,13 @@ perl breaks binary compatibility. If one of the modules that CPAN uses
 is in turn depending on binary compatibility (so you cannot run CPAN
 commands), then you should try the CPAN::Nox module for recovery.
 
-=head2 The 4 Classes: Authors, Bundles, Modules, Distributions
-
-Although it may be considered internal, the class hierarchie does
-matter for both users and programmer. CPAN.pm deals with above
-mentioned four classes, and all those classes share a set of
-methods. It is a classical single polymorphism that is in effect.  A
-metaclass object registers all objects of all kinds and indexes them
-with a string. The strings referencing objects have a separated
-namespace (well, not completely separated):
-
-         Namespace                         Class
-
-   words containing a "/" (slash)      Distribution
-    words starting with Bundle::          Bundle
-          everything else            Module or Author
-
-Modules know their associated Distribution objects. They always refer
-to the most recent official release. Developers may mark their
-releases as unstable development versions (by inserting an underbar
-into the visible version number), so not always is the default
-distribution for a given module the really hottest and newest. If a
-module Foo circulates on CPAN in both version 1.23 and 1.23_90,
-CPAN.pm offers a convenient way to install version 1.23 by saying
-
-    install Foo
-
-This would install the complete distribution file (say
-BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
-you would like to install version 1.23_90, you need to know where the
-distribution file resides on CPAN relative to the authors/id/
-directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
-so he would have say
-
-    install BAR/Foo-1.23_90.tar.gz
-
-The first example will be driven by an object of the class
-CPAN::Module, the second by an object of class Distribution.
-
 =head2 ProgrammerE<39>s interface
 
 If you do not enter the shell, the available shell commands are both
 available as methods (C<CPAN::Shell-E<gt>install(...)>) and as
-functions in the calling package (C<install(...)>).
-
-There's currently only one class that has a stable interface,
-CPAN::Shell. All commands that are available in the CPAN shell are
-methods of the class CPAN::Shell. The commands that produce listings
-of modules (C<r>, C<autobundle>, C<u>) return a list of the IDs of all
-modules within the list.
-
-=over 2
-
-=item expand($type,@things)
-
-The IDs of all objects available within a program are strings that can
-be expanded to the corresponding real objects with the
-C<CPAN::Shell-E<gt>expand()> method. Expand returns a list of
-CPAN::Module objects according to the C<@things> arguments given. In
-scalar context it only returns the first element of the list.
-
-=item Programming Examples
-
-This enables the programmer to do operations like these:
-
-    # install everything that is outdated on my disk:
-    perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
-
-    # install my favorite programs if necessary:
-    for $mod (qw(Net::FTP MD5 Data::Dumper)){
-        my $obj = CPAN::Shell->expand('Module',$mod);
-        $obj->install;
-    }
-
-=back
+functions in the calling package (C<install(...)>). The
+programmerE<39>s interface has beta status. Do not heavily rely on it,
+changes may still be necessary.
 
 =head2 Cache Manager
 
index 8ac180d..c996a1c 100644 (file)
@@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw(prompt);
 use FileHandle ();
 use File::Path ();
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.18 $, 10;
+$VERSION = substr q$Revision: 1.16 $, 10;
 
 =head1 NAME
 
@@ -128,7 +128,7 @@ those.
 
     my(@path) = split($Config{path_sep},$ENV{PATH});
     my $prog;
-    for $prog (qw/gzip tar unzip make lynx ncftp ftp/){
+    for $prog (qw/gzip tar unzip make lynx ftp/){
        my $path = $CPAN::Config->{$prog} || find_exe($prog,[@path]) || $prog;
        $ans = prompt("Where is your $prog program?",$path) || $path;
        $CPAN::Config->{$prog} = $ans;
@@ -178,8 +178,7 @@ without caring about them. As sometimes the Makefile.PL contains
 question you\'re expected to answer, you can set a timer that will
 kill a 'perl Makefile.PL' process after the specified time in seconds.
 
-If you set this value to 0, these processes will wait forever. This is
-the default and recommended setting.
+If you set this value to 0, these processes will wait forever.
 
 };
 
@@ -258,9 +257,8 @@ the \$CPAN::Config takes precedence.
        $CPAN::Config->{$_} = prompt("Your $_?",$default);
     }
 
-    # We don't ask that now, it will be noticed in time, won't it?
+    # We don't ask that now, it will be noticed in time....
     $CPAN::Config->{'inhibit_startup_message'} = 0;
-    $CPAN::Config->{'getcwd'} = 'cwd';
 
     print "\n\n";
     CPAN::Config->commit($configpm);
index 0db3ecf..a26747f 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Embed.pm,v 1.2501 $
+# $Id: Embed.pm,v 1.22 1997/01/30 00:37:09 dougm Exp $
 require 5.002;
 
 package ExtUtils::Embed;
@@ -17,7 +17,7 @@ use vars qw(@ISA @EXPORT $VERSION
            );
 use strict;
 
-$VERSION = sprintf("%d.%02d", q$Revision: 1.2501 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.2202 $ =~ /(\d+)\.(\d+)/);
 #for the namespace change
 $Devel::embed::VERSION = "99.99";
 
index eb49f3e..6714355 100644 (file)
@@ -1687,6 +1687,7 @@ either say:
 or you can edit the default by saying something like:
 
        sub MY::c_o {
+           package MY;
             my($inherited) = shift->SUPER::c_o(@_);
            $inherited =~ s/old text/new text/;
            $inherited;
index 0959a2f..5df98f4 100644 (file)
@@ -10,7 +10,7 @@ use strict;
 use vars qw($VERSION @ISA @EXPORT_OK
            $Is_VMS $Debug $Verbose $Quiet $MANIFEST $found);
 
-$VERSION = substr(q$Revision: 1.33 $, 10);
+$VERSION = '1.2801';
 @ISA=('Exporter');
 @EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck', 
              'skipcheck', 'maniread', 'manicopy');
@@ -85,10 +85,10 @@ sub skipcheck {
 sub _manicheck {
     my($arg) = @_;
     my $read = maniread();
-    my $found = manifind();
     my $file;
     my(@missfile,@missentry);
     if ($arg & 1){
+       my $found = manifind();
        foreach $file (sort keys %$read){
            warn "Debug: manicheck checking from $MANIFEST $file\n" if $Debug;
            unless ( exists $found->{$file} ) {
@@ -100,6 +100,7 @@ sub _manicheck {
     if ($arg & 2){
        $read ||= {};
        my $matches = _maniskip();
+       my $found = manifind();
        my $skipwarn = $arg & 4;
        foreach $file (sort keys %$found){
            if (&$matches($file)){
@@ -118,7 +119,7 @@ sub _manicheck {
 
 sub maniread {
     my ($mfile) = @_;
-    $mfile ||= $MANIFEST;
+    $mfile = $MANIFEST unless defined $mfile;
     my $read = {};
     local *M;
     unless (open M, $mfile){
@@ -127,7 +128,6 @@ sub maniread {
     }
     while (<M>){
        chomp;
-       next if /^#/;
        if ($Is_VMS) {
            my($file)= /^(\S+)/;
            next unless $file;
@@ -151,13 +151,12 @@ sub _maniskip {
     my ($mfile) = @_;
     my $matches = sub {0};
     my @skip ;
-    $mfile ||= "$MANIFEST.SKIP";
+    $mfile = "$MANIFEST.SKIP" unless defined $mfile;
     local *M;
     return $matches unless -f $mfile;
     open M, $mfile or return $matches;
     while (<M>){
        chomp;
-       next if /^#/;
        next if /^\s*$/;
        push @skip, $_;
     }
@@ -175,7 +174,7 @@ sub _maniskip {
 sub manicopy {
     my($read,$target,$how)=@_;
     croak "manicopy() called without target argument" unless defined $target;
-    $how ||= 'cp';
+    $how = 'cp' unless defined $how && $how;
     require File::Path;
     require File::Basename;
     my(%dirs,$file);
@@ -195,7 +194,7 @@ sub manicopy {
 
 sub cp_if_diff {
     my($from, $to, $how)=@_;
-    -f $from or carp "$0: $from not found";
+    -f $from || carp "$0: $from not found";
     my($diff) = 0;
     local(*F,*T);
     open(F,$from) or croak "Can't read $from: $!\n";
@@ -210,14 +209,11 @@ sub cp_if_diff {
        if (-e $to) {
            unlink($to) or confess "unlink $to: $!";
        }
-      STRICT_SWITCH: {
-           best($from,$to), last STRICT_SWITCH if $how eq 'best';
-           cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
-           ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
-           croak("ExtUtils::Manifest::cp_if_diff " .
-                 "called with illegal how argument [$how]. " .
-                 "Legal values are 'best', 'cp', and 'ln'.");
-       }
+       STRICT_SWITCH: {
+             best($from,$to), last STRICT_SWITCH if $how eq 'best';
+               cp($from,$to), last STRICT_SWITCH if $how eq 'cp';
+               ln($from,$to), last STRICT_SWITCH if $how eq 'ln';
+         }
     }
 }
 
@@ -313,8 +309,6 @@ files found below the current directory.
 Maniread($file) reads a named C<MANIFEST> file (defaults to
 C<MANIFEST> in the current directory) and returns a HASH reference
 with files being the keys and comments being the values of the HASH.
-Blank lines and lines which start with C<#> in the C<MANIFEST> file
-are discarded.
 
 I<Manicopy($read,$target,$how)> copies the files that are the keys in
 the HASH I<%$read> to the named target directory. The HASH reference
@@ -330,9 +324,7 @@ make a tree without any symbolic link. Best is the default.
 
 The file MANIFEST.SKIP may contain regular expressions of files that
 should be ignored by mkmanifest() and filecheck(). The regular
-expressions should appear one on each line. Blank lines and lines
-which start with C<#> are skipped.  Use C<\#> if you need a regular
-expression to start with a sharp character. A typical example:
+expressions should appear one on each line. A typical example:
 
     \bRCS\b
     ^MANIFEST\.
index 3ceb10e..0442aed 100644 (file)
@@ -163,7 +163,7 @@ sub fileparse {
     }
   }
   if ($fstype =~ /^MSDOS/i) {
-    ($dirpath,$basename) = ($fullname =~ /^((?:.*[:\\\/])?)(.*)/);
+    ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/);
     $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
   }
   elsif ($fstype =~ /^MacOS/i) {
index a0d4f9d..4416cf2 100644 (file)
@@ -80,7 +80,6 @@ B<necessarily> that value in the current implementation.
 
 Magical values, tied values, and references can be made into
 constants at compile time, allowing for way cool stuff like this.
-(These error numbers aren't totally portable, alas.)
 
     use constant E2BIG => ($! = 7);
     print   E2BIG, "\n";       # something like "Arg list too long"
@@ -127,7 +126,7 @@ use vars qw($VERSION);
 #=======================================================================
 
 # Some of this stuff didn't work in version 5.003, alas.
-require 5.003_96;
+require 5.003_20;
 
 #=======================================================================
 # import() - import symbols into user's namespace
diff --git a/perl.c b/perl.c
index 9f06f13..8cbdd87 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -457,7 +457,6 @@ char **env;
     I32 oldscope;
     AV* comppadlist;
     dJMPENV;
-    int ret;
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
@@ -506,8 +505,7 @@ setuid perl scripts securely.\n");
     time(&basetime);
     oldscope = scopestack_ix;
 
-    JMPENV_PUSH(ret);
-    switch (ret) {
+    switch (JMPENV_PUSH) {
     case 1:
        STATUS_ALL_FAILURE;
        /* FALL THROUGH */
@@ -823,17 +821,15 @@ int
 perl_run(sv_interp)
 PerlInterpreter *sv_interp;
 {
-    I32 oldscope;
     dJMPENV;
-    int ret;
+    I32 oldscope;
 
     if (!(curinterp = sv_interp))
        return 255;
 
     oldscope = scopestack_ix;
 
-    JMPENV_PUSH(ret);
-    switch (ret) {
+    switch (JMPENV_PUSH) {
     case 1:
        cxstack_ix = -1;                /* start context stack again */
        break;
@@ -1009,7 +1005,6 @@ I32 flags;                /* See G_* flags in cop.h */
     static CV *DBcv;
     bool oldcatch = CATCH_GET;
     dJMPENV;
-    int ret;
 
     if (flags & G_DISCARD) {
        ENTER;
@@ -1063,8 +1058,7 @@ I32 flags;                /* See G_* flags in cop.h */
        }
        markstack_ptr++;
 
-       JMPENV_PUSH(ret);
-       switch (ret) {
+       switch (JMPENV_PUSH) {
        case 0:
            break;
        case 1:
@@ -1148,7 +1142,6 @@ I32 flags;                /* See G_* flags in cop.h */
     I32 retval;
     I32 oldscope;
     dJMPENV;
-    int ret;
     
     if (flags & G_DISCARD) {
        ENTER;
@@ -1172,8 +1165,7 @@ I32 flags;                /* See G_* flags in cop.h */
     if (flags & G_KEEPERR)
        myop.op_flags |= OPf_SPECIAL;
 
-    JMPENV_PUSH(ret);
-    switch (ret) {
+    switch (JMPENV_PUSH) {
     case 0:
        break;
     case 1:
@@ -2475,18 +2467,16 @@ call_list(oldscope, list)
 I32 oldscope;
 AV* list;
 {
-    line_t oldline = curcop->cop_line;
-    STRLEN len;
     dJMPENV;
-    int ret;
+    STRLEN len;
+    line_t oldline = curcop->cop_line;
 
     while (AvFILL(list) >= 0) {
        CV *cv = (CV*)av_shift(list);
 
        SAVEFREESV(cv);
 
-       JMPENV_PUSH(ret);
-       switch (ret) {
+       switch (JMPENV_PUSH) {
        case 0: {
                SV* atsv = GvSV(errgv);
                PUSHMARK(stack_sp);
index cd14ce2..bd4dd41 100644 (file)
@@ -404,22 +404,7 @@ if ($section =~ /^1/) {
     $name = uc File::Basename::basename($name);
 }
 $name =~ s/\.(pod|p[lm])$//i;
-
-# Lose everything up to the first of
-#     */lib/*perl*     standard or site_perl module
-#     */*perl*/lib     from -D prefix=/opt/perl
-#     */*perl*/                random module hierarchy
-# which works.
-$name =~ s-//+-/-g;
-if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
-       or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
-       or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
-    # Lose ^arch/version/.
-    $name =~ s-^[^/]+/\d+\.\d+/--;
-}
-
-# Translate Getopt/Long to Getopt::Long, etc.
-$name =~ s(/)(::)g;
+$name =~ s(/)(::)g; # translate Getopt/Long to Getopt::Long, etc.
 
 if ($name ne 'something') {
     FCHECK: {
index d51569d..7920e51 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1972,8 +1972,7 @@ OP *o;
     assert(CATCH_GET == TRUE);
     DEBUG_l(deb("(Setting up local jumplevel, runlevel = %d)\n", runlevel+1));
 #endif
-    JMPENV_PUSH(ret);
-    switch (ret) {
+    switch ((ret = JMPENV_PUSH)) {
     default:                           /* topmost level handles it */
        JMPENV_POP;
        runlevel = oldrunlevel;
index 00012c3..3b06b9c 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -89,13 +89,11 @@ extern int h_errno;
 #   define vfork fork
 #endif
 
-/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
-#ifndef Sock_size_t
-#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED)
-#    define Sock_size_t Size_t
-#  else
-#    define Sock_size_t int
-#  endif
+/* Put this after #includes because <unistd.h> defines _XOPEN_VERSION. */
+#if _XOPEN_VERSION >= 4
+#   define Sock_size_t Size_t
+#else
+#   define Sock_size_t int
 #endif
 
 #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
diff --git a/scope.h b/scope.h
index debe1f8..d6eb270 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -96,25 +96,16 @@ struct jmpenv {
 typedef struct jmpenv JMPENV;
 
 #define dJMPENV                JMPENV cur_env
-#define JMPENV_PUSH(v) \
-    STMT_START {                                       \
-       cur_env.je_prev = top_env;                      \
-       cur_env.je_ret = Sigsetjmp(cur_env.je_buf, 1);  \
-       top_env = &cur_env;                             \
-       cur_env.je_mustcatch = FALSE;                   \
-       (v) = cur_env.je_ret;                           \
-    } STMT_END
-#define JMPENV_POP \
-    STMT_START { top_env = cur_env.je_prev; } STMT_END
-#define JMPENV_JUMP(v) \
-    STMT_START {                                               \
-       if (top_env->je_prev)                                   \
-           Siglongjmp(top_env->je_buf, (v));                   \
-       if ((v) == 2)                                           \
-           exit(STATUS_NATIVE_EXPORT);                         \
-       PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");     \
-       exit(1);                                                \
-    } STMT_END
+#define JMPENV_PUSH    (cur_env.je_prev = top_env,                     \
+                        cur_env.je_ret = Sigsetjmp(cur_env.je_buf,1),  \
+                        top_env = &cur_env,                            \
+                        cur_env.je_mustcatch = FALSE,                  \
+                        cur_env.je_ret)
+#define JMPENV_POP     (top_env = cur_env.je_prev)
+#define JMPENV_JUMP(v) (top_env->je_prev ? Siglongjmp(top_env->je_buf, (v))    \
+                        : ((v) == 2) ? exit(STATUS_NATIVE_EXPORT)              \
+                        : (PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"), \
+                            exit(1)))
    
 #define CATCH_GET      (top_env->je_mustcatch)
 #define CATCH_SET(v)   (top_env->je_mustcatch = (v))
diff --git a/sv.h b/sv.h
index cf18061..39dc40e 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -572,9 +572,9 @@ SV *newRV_noinc _((SV *));
            }
 
 #define SvSetSV(dst,src) \
-               SvSetSV_and(dst,src,/*nothing*/;)
+               SvSetSV_and(dst,src,)
 #define SvSetSV_nosteal(dst,src) \
-               SvSetSV_nosteal_and(dst,src,/*nothing*/;)
+               SvSetSV_nosteal_and(dst,src,)
 
 #define SvSetMagicSV(dst,src) \
                SvSetSV_and(dst,src,SvSETMAGIC(dst))
index 860b337..0f8a117 100755 (executable)
@@ -51,7 +51,6 @@ print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ?
 print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ?
         '' : 'not '),"ok 12\n";
 print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n";
-$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT};
 print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n";
 print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n";
 
diff --git a/toke.c b/toke.c
index 724c214..b96e23e 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -622,11 +622,7 @@ sublex_start()
        return THING;
     }
     if (op_type == OP_CONST || op_type == OP_READLINE) {
-       SV *sv = q(lex_stuff);
-       STRLEN len;
-       char *p = SvPV(sv, len);
-       yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len));
-       SvREFCNT_dec(sv);
+       yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
        lex_stuff = Nullsv;
        return THING;
     }