[inseparable changes from match from perl-5.003_97g to perl-5.003_97h]

[perl5.git] / lib / AutoSplit.pm

diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index b1d797a..2fd0cac 100644 (file)
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -5,6 +5,7 @@ require Exporter;
 
 use Config;
 use Carp;
+use File::Path qw(mkpath);
 
 @ISA = qw(Exporter);
 @EXPORT = qw(&autosplit &autosplit_lib_modules);
@@ -21,7 +22,7 @@ AutoSplit - split a package for autoloading
  use AutoSplit; autosplit($file, $dir, $keep, $check, $modtime);
 
 for perl versions 5.002 and later:
- 
+
  perl -MAutoSplit -e 'autosplit($ARGV[0], $ARGV[1], $k, $chk, $modtime)' ...
 
 =head1 DESCRIPTION
@@ -38,7 +39,7 @@ last update of the hierarchy.
 
 The remaining three arguments to C<autosplit> govern other options to the
 autosplitter. If the third argument, I<$keep>, is false, then any pre-existing
-C<.al> files in the autoload directory are removed if they are no longer
+C<*.al> files in the autoload directory are removed if they are no longer
 part of the module (obsoleted functions). The fourth argument, I<$check>,
 instructs C<autosplit> to check the module currently being split to ensure
 that it does include a C<use> specification for the AutoLoader module, and
@@ -149,14 +150,12 @@ sub autosplit_file{
 
     # where to write output files
     $autodir = "lib/auto" unless $autodir;
-    ($autodir = VMS::Filespec::unixpath($autodir)) =~ s#/$## if $Is_VMS;
+    if ($Is_VMS) {
+       ($autodir = VMS::Filespec::unixpath($autodir)) =~ s{/$}{};
+       $filename = VMS::Filespec::unixify($filename); # may have dirs
+    }
     unless (-d $autodir){
-       local($", @p)="/";
-       foreach(split(/\//,$autodir)){
-           push(@p, $_);
-           next if -d "@p/";
-           mkdir("@p",0755) or die "AutoSplit unable to mkdir @p: $!";
-       }
+       mkpath($autodir,0,0755);
        # We should never need to create the auto dir here. installperl
        # (or similar) should have done it. Expecting it to exist is a valuable
        # sanity check against autosplitting into some random directory by mistake.
@@ -190,13 +189,20 @@ sub autosplit_file{
 
     $package or die "Can't find 'package Name;' in $filename\n";
 
-    my($modpname) = $package; $modpname =~ s#::#/#g;
-    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+    my($modpname) = $package; 
+    if ($^O eq 'MSWin32') {
+       $modpname =~ s#::#\\#g; 
+    } else {
+       $modpname =~ s#::#/#g;
+    }
 
-    die "Package $package does not match filename $filename"
-           unless ($filename =~ m/$modpname.pm$/ or
+    die "Package $package ($modpname.pm) does not match filename $filename"
+           unless ($filename =~ m/\Q$modpname.pm\E$/ or
+                   ($^O eq "msdos") or ($^O eq 'MSWin32') or
                    $Is_VMS && $filename =~ m/$modpname.pm/i);
 
+    my($al_idx_file) = "$autodir/$modpname/$IndexFile";
+
     if ($check_mod_time){
        my($al_ts_time) = (stat("$al_idx_file"))[9] || 1;
        if ($al_ts_time >= $pm_mod_time){
@@ -211,12 +217,7 @@ sub autosplit_file{
        if $Verbose;
 
     unless (-d "$autodir/$modpname"){
-       local($", @p)="/";
-       foreach(split(/\//,"$autodir/$modpname")){
-           push(@p, $_);
-           next if -d "@p/";
-           mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!";
-       }
+       mkpath("$autodir/$modpname",0,0777);
     }
 
     # We must try to deal with some SVR3 systems with a limit of 14
@@ -247,14 +248,17 @@ sub autosplit_file{
 
     open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning
     my(@subnames, %proto);
+    my @cache = ();
+    my $caching = 1;
     while (<IN>) {
+       next if /^=\w/ .. /^=cut/;
        if (/^package ([\w:]+)\s*;/) {
            warn "package $1; in AutoSplit section ignored. Not currently supported.";
        }
        if (/^sub\s+([\w:]+)(\s*\(.*?\))?/) {
            print OUT "1;\n";
            my $subname = $1;
-           $proto{$1} = $2 or '';
+           $proto{$1} = $2 || '';
            if ($subname =~ m/::/){
                warn "subs with package names not currently supported in AutoSplit section";
            }
@@ -274,10 +278,26 @@ sub autosplit_file{
            print OUT "# NOTE: Derived from $filename.  ",
                        "Changes made here will be lost.\n";
            print OUT "package $package;\n\n";
+           print OUT @cache;
+           @cache = ();
+           $caching = 0;
+       }
+       if($caching) {
+           push(@cache, $_) if @cache || /\S/;
+       }
+       else {
+           print OUT $_;
+       }
+       if(/^}/) {
+           if($caching) {
+               print OUT @cache;
+               @cache = ();
+           }
+           print OUT "\n";
+           $caching = 1;
        }
-       print OUT $_;
     }
-    print OUT "1;\n";
+    print OUT @cache,"1;\n";
     close(OUT);
     close(IN);