For VMS, a belated entry into the $^O jungle that is File::Find::_find_dir.

[perl5.git] / lib / AutoSplit.pm

diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index bf4d811..bf0f925 100644 (file)
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -3,7 +3,6 @@ package AutoSplit;
 use 5.006_001;
 use Exporter ();
 use Config qw(%Config);
-use Carp qw(carp);
 use File::Basename ();
 use File::Path qw(mkpath);
 use File::Spec::Functions qw(curdir catfile catdir);
@@ -11,7 +10,7 @@ use strict;
 our($VERSION, @ISA, @EXPORT, @EXPORT_OK, $Verbose, $Keep, $Maxlen,
     $CheckForAutoloader, $CheckModTime);
 
-$VERSION = "1.0307";
+$VERSION = "1.04_01";
 @ISA = qw(Exporter);
 @EXPORT = qw(&autosplit &autosplit_lib_modules);
 @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
@@ -148,10 +147,12 @@ if (defined (&Dos::UseLFN)) {
 my $Is_VMS = ($^O eq 'VMS');
 
 # allow checking for valid ': attrlist' attachments
-my $nested;
+# (we use 'our' rather than 'my' here, due to the rather complex and buggy
+# behaviour of lexicals with qr// and (??{$lex}) )
+our $nested;
 $nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x;
-my $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
-my $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
+our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x;
+our $attr_list = qr{ \s* : \s* (?: $one_attr )* }x;
 
 
 
@@ -166,6 +167,10 @@ sub autosplit{
     autosplit_file($file, $autodir, $keep, $ckal, $ckmt);
 }
 
+sub carp{
+    require Carp;
+    goto &Carp::carp;
+}
 
 # This function is used during perl building/installation
 # ./miniperl -e 'use AutoSplit; autosplit_lib_modules(@ARGV)' ...
@@ -227,17 +232,18 @@ sub autosplit_file {
     # allow just a package name to be used
     $filename .= ".pm" unless ($filename =~ m/\.pm\z/);
 
-    open(IN, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
+    open(my $in, "<$filename") or die "AutoSplit: Can't open $filename: $!\n";
     my($pm_mod_time) = (stat($filename))[9];
     my($autoloader_seen) = 0;
     my($in_pod) = 0;
     my($def_package,$last_package,$this_package,$fnr);
-    while (<IN>) {
+    while (<$in>) {
        # Skip pod text.
        $fnr++;
        $in_pod = 1 if /^=\w/;
        $in_pod = 0 if /^=cut/;
        next if ($in_pod || /^=cut/);
+        next if /^\s*#/;
 
        # record last package name seen
        $def_package = $1 if (m/^\s*package\s+([\w:]+)\s*;/);
@@ -296,7 +302,8 @@ sub autosplit_file {
     my @cache = ();
     my $caching = 1;
     $last_package = '';
-    while (<IN>) {
+    my $out;
+    while (<$in>) {
        $fnr++;
        $in_pod = 1 if /^=\w/;
        $in_pod = 0 if /^=cut/;
@@ -307,8 +314,9 @@ sub autosplit_file {
        if (/^package\s+([\w:]+)\s*;/) {
            $this_package = $def_package = $1;
        }
+
        if (/^sub\s+([\w:]+)(\s*(?:\(.*?\))?(?:$attr_list)?)/) {
-           print OUT "# end of $last_package\::$subname\n1;\n"
+           print $out "# end of $last_package\::$subname\n1;\n"
                if $last_package;
            $subname = $1;
            my $proto = $2 || '';
@@ -328,18 +336,19 @@ sub autosplit_file {
            my($lpath) = catfile($modnamedir, "$lname.al");
            my($spath) = catfile($modnamedir, "$sname.al");
            my $path;
-           if (!$Is83 and open(OUT, ">$lpath")){
+
+           if (!$Is83 and open($out, ">$lpath")){
                $path=$lpath;
                print "  writing $lpath\n" if ($Verbose>=2);
            } else {
-               open(OUT, ">$spath") or die "Can't create $spath: $!\n";
+               open($out, ">$spath") or die "Can't create $spath: $!\n";
                $path=$spath;
                print "  writing $spath (with truncated name)\n"
                        if ($Verbose>=1);
            }
            push(@outfiles, $path);
            my $lineno = $fnr - @cache;
-           print OUT <<EOT;
+           print $out <<EOT;
 # NOTE: Derived from $filename.
 # Changes made here will be lost when autosplit is run again.
 # See AutoSplit.pm.
@@ -347,30 +356,30 @@ package $this_package;
 
 #line $lineno "$filename (autosplit into $path)"
 EOT
-           print OUT @cache;
+           print $out @cache;
            @cache = ();
            $caching = 0;
        }
        if($caching) {
            push(@cache, $_) if @cache || /\S/;
        } else {
-           print OUT $_;
+           print $out $_;
        }
        if(/^\}/) {
            if($caching) {
-               print OUT @cache;
+               print $out @cache;
                @cache = ();
            }
-           print OUT "\n";
+           print $out "\n";
            $caching = 1;
        }
        $last_package = $this_package if defined $this_package;
     }
     if ($subname) {
-       print OUT @cache,"1;\n# end of $last_package\::$subname\n";
-       close(OUT);
+       print $out @cache,"1;\n# end of $last_package\::$subname\n";
+       close($out);
     }
-    close(IN);
+    close($in);
     
     if (!$keep){  # don't keep any obsolete *.al files in the directory
        my(%outfiles);
@@ -390,8 +399,8 @@ EOT
            $outdirs{File::Basename::dirname($_)}||=1;
        }
        for my $dir (keys %outdirs) {
-           opendir(OUTDIR,$dir);
-           foreach (sort readdir(OUTDIR)){
+           opendir(my $outdir,$dir);
+           foreach (sort readdir($outdir)){
                next unless /\.al\z/;
                my($file) = catfile($dir, $_);
                $file = lc $file if $Is83 or $Is_VMS;
@@ -399,27 +408,27 @@ EOT
                print "  deleting $file\n" if ($Verbose>=2);
                my($deleted,$thistime);  # catch all versions on VMS
                do { $deleted += ($thistime = unlink $file) } while ($thistime);
-               carp "Unable to delete $file: $!" unless $deleted;
+               carp ("Unable to delete $file: $!") unless $deleted;
            }
-           closedir(OUTDIR);
+           closedir($outdir);
        }
     }
 
-    open(TS,">$al_idx_file") or
-       carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!";
-    print TS "# Index created by AutoSplit for $filename\n";
-    print TS "#    (file acts as timestamp)\n";
+    open(my $ts,">$al_idx_file") or
+       carp ("AutoSplit: unable to create timestamp file ($al_idx_file): $!");
+    print $ts "# Index created by AutoSplit for $filename\n";
+    print $ts "#    (file acts as timestamp)\n";
     $last_package = '';
     for my $fqs (@subnames) {
        my($subname) = $fqs;
        $subname =~ s/.*:://;
-       print TS "package $package{$fqs};\n"
+       print $ts "package $package{$fqs};\n"
            unless $last_package eq $package{$fqs};
-       print TS "sub $subname $proto{$fqs};\n";
+       print $ts "sub $subname $proto{$fqs};\n";
        $last_package = $package{$fqs};
     }
-    print TS "1;\n";
-    close(TS);
+    print $ts "1;\n";
+    close($ts);
 
     _check_unique($filename, $Maxlen, 1, @outfiles);