From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sat, 8 Aug 1998 00:01:34 +0000 (+0000)
Subject: back out change#1747 until possibly better patch is investigated
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4f7e78b905cd2e1ff7ceb03a8e8b0cc49a57f5ae;p=p5sagit%2Fp5-mst-13.2.git

back out change#1747 until possibly better patch is investigated

p4raw-link: @1747 on //depot/maint-5.005/perl: 6e19ff93dfe8cda893891d183baba8b8c8502350

p4raw-id: //depot/maint-5.005/perl@1756
---

diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm
index 78fa59b..121d261 100644
--- a/lib/AutoSplit.pm
+++ b/lib/AutoSplit.pm
@@ -11,7 +11,7 @@ use vars qw(
 	    $Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime
 	   );
 
-$VERSION = "1.0303";
+$VERSION = "1.0302";
 @ISA = qw(Exporter);
 @EXPORT = qw(&autosplit &autosplit_lib_modules);
 @EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
@@ -188,7 +188,7 @@ sub autosplit_lib_modules{
 sub autosplit_file {
     my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time)
 	= @_;
-    my(%outfiles);
+    my(@outfiles);
     local($_);
     local($/) = "\n";
 
@@ -311,24 +311,14 @@ sub autosplit_file {
 	    my $path;
 	    if (!$Is83 and open(OUT, ">$lpath")){
 	        $path=$lpath;
-		# perl downcases all filenames on VMS (which upcases all filenames) so
-		# we'd better downcase the sub name list too, or subs with upper case
-		# letters in them will get their .al files deleted right after they're
-		# created. (The mixed case sub name won't match the all-lowercase
-		# filename, and so be cleaned up as a scrap file)
-		my $opath = ($Is_VMS or $Is83) ? lc($path) : $path;
-		$outfiles{$opath} = $path;
 		print "  writing $lpath\n" if ($Verbose>=2);
 	    } else {
+		open(OUT, ">$spath") or die "Can't create $spath: $!\n";
 		$path=$spath;
-		# same as above comment
-		my $opath = ($Is_VMS or $Is83) ? lc($path) : $path;
-		my $mode = exists $outfiles{$opath} ? ">>" : ">";
-		open(OUT, "$mode$spath") or die "Can't create $spath: $!\n";
-		$outfiles{$opath} = $path;
 		print "  writing $spath (with truncated name)\n"
 			if ($Verbose>=1);
 	    }
+	    push(@outfiles, $path);
 	    print OUT <<EOT;
 # NOTE: Derived from $filename.
 # Changes made here will be lost when autosplit again.
@@ -361,8 +351,20 @@ EOT
     close(IN);
     
     if (!$keep){  # don't keep any obsolete *.al files in the directory
+	my(%outfiles);
+	# @outfiles{@outfiles} = @outfiles;
+	# perl downcases all filenames on VMS (which upcases all filenames) so
+	# we'd better downcase the sub name list too, or subs with upper case
+	# letters in them will get their .al files deleted right after they're
+	# created. (The mixed case sub name won't match the all-lowercase
+	# filename, and so be cleaned up as a scrap file)
+	if ($Is_VMS or $Is83) {
+	    %outfiles = map {lc($_) => lc($_) } @outfiles;
+	} else {
+	    @outfiles{@outfiles} = @outfiles;
+	}  
 	my(%outdirs,@outdirs);
-	for (values %outfiles) {
+	for (@outfiles) {
 	    $outdirs{File::Basename::dirname($_)}||=1;
 	}
 	for my $dir (keys %outdirs) {
@@ -397,7 +399,9 @@ EOT
     print TS "1;\n";
     close(TS);
 
-    values %outfiles;
+    _check_unique($filename, $Maxlen, 1, @outfiles);
+
+    @outfiles;
 }
 
 sub _modpname ($) {
@@ -411,6 +415,36 @@ sub _modpname ($) {
     $modpname;
 }
 
+sub _check_unique {
+    my($filename, $maxlen, $warn, @outfiles) = @_;
+    my(%notuniq) = ();
+    my(%shorts)  = ();
+    my(@toolong) = grep(
+			length(File::Basename::basename($_))
+			> $maxlen,
+			@outfiles
+		       );
+
+    foreach (@toolong){
+	my($dir) = File::Basename::dirname($_);
+	my($file) = File::Basename::basename($_);
+	my($trunc) = substr($file,0,$maxlen);
+	$notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc};
+	$shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ?
+	    "$shorts{$dir}{$trunc}, $file" : $file;
+    }
+    if (%notuniq && $warn){
+	print "$filename: some names are not unique when " .
+	    "truncated to $maxlen characters:\n";
+	foreach my $dir (sort keys %notuniq){
+	    print " directory $dir:\n";
+	    foreach my $trunc (sort keys %{$notuniq{$dir}}) {
+		print "  $shorts{$dir}{$trunc} truncate to $trunc\n";
+	    }
+	}
+    }
+}
+
 1;
 __END__