Skip to content

Commit 6e19ff9

Browse files
gbarrGurusamy Sarathy
authored and
Gurusamy Sarathy
committed
make AutoSplit safer on filesystems with short filenames
Message-ID: <[email protected]> Subject: [ PATCH perl5.005_02-TRIAL2 ] AutoSplit and 8.3 p4raw-id: //depot/maint-5.005/perl@1747
1 parent e47a9bb commit 6e19ff9

File tree

1 file changed

+16
-50
lines changed

1 file changed

+16
-50
lines changed

lib/AutoSplit.pm

Lines changed: 16 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ use vars qw(
1111
$Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime
1212
);
1313

14-
$VERSION = "1.0302";
14+
$VERSION = "1.0303";
1515
@ISA = qw(Exporter);
1616
@EXPORT = qw(&autosplit &autosplit_lib_modules);
1717
@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
@@ -188,7 +188,7 @@ sub autosplit_lib_modules{
188188
sub autosplit_file {
189189
my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time)
190190
= @_;
191-
my(@outfiles);
191+
my(%outfiles);
192192
local($_);
193193
local($/) = "\n";
194194

@@ -311,14 +311,24 @@ sub autosplit_file {
311311
my $path;
312312
if (!$Is83 and open(OUT, ">$lpath")){
313313
$path=$lpath;
314+
# perl downcases all filenames on VMS (which upcases all filenames) so
315+
# we'd better downcase the sub name list too, or subs with upper case
316+
# letters in them will get their .al files deleted right after they're
317+
# created. (The mixed case sub name won't match the all-lowercase
318+
# filename, and so be cleaned up as a scrap file)
319+
my $opath = ($Is_VMS or $Is83) ? lc($path) : $path;
320+
$outfiles{$opath} = $path;
314321
print " writing $lpath\n" if ($Verbose>=2);
315322
} else {
316-
open(OUT, ">$spath") or die "Can't create $spath: $!\n";
317323
$path=$spath;
324+
# same as above comment
325+
my $opath = ($Is_VMS or $Is83) ? lc($path) : $path;
326+
my $mode = exists $outfiles{$opath} ? ">>" : ">";
327+
open(OUT, "$mode$spath") or die "Can't create $spath: $!\n";
328+
$outfiles{$opath} = $path;
318329
print " writing $spath (with truncated name)\n"
319330
if ($Verbose>=1);
320331
}
321-
push(@outfiles, $path);
322332
print OUT <<EOT;
323333
# NOTE: Derived from $filename.
324334
# Changes made here will be lost when autosplit again.
@@ -351,20 +361,8 @@ EOT
351361
close(IN);
352362

353363
if (!$keep){ # don't keep any obsolete *.al files in the directory
354-
my(%outfiles);
355-
# @outfiles{@outfiles} = @outfiles;
356-
# perl downcases all filenames on VMS (which upcases all filenames) so
357-
# we'd better downcase the sub name list too, or subs with upper case
358-
# letters in them will get their .al files deleted right after they're
359-
# created. (The mixed case sub name won't match the all-lowercase
360-
# filename, and so be cleaned up as a scrap file)
361-
if ($Is_VMS or $Is83) {
362-
%outfiles = map {lc($_) => lc($_) } @outfiles;
363-
} else {
364-
@outfiles{@outfiles} = @outfiles;
365-
}
366364
my(%outdirs,@outdirs);
367-
for (@outfiles) {
365+
for (values %outfiles) {
368366
$outdirs{File::Basename::dirname($_)}||=1;
369367
}
370368
for my $dir (keys %outdirs) {
@@ -399,9 +397,7 @@ EOT
399397
print TS "1;\n";
400398
close(TS);
401399

402-
_check_unique($filename, $Maxlen, 1, @outfiles);
403-
404-
@outfiles;
400+
values %outfiles;
405401
}
406402

407403
sub _modpname ($) {
@@ -415,36 +411,6 @@ sub _modpname ($) {
415411
$modpname;
416412
}
417413

418-
sub _check_unique {
419-
my($filename, $maxlen, $warn, @outfiles) = @_;
420-
my(%notuniq) = ();
421-
my(%shorts) = ();
422-
my(@toolong) = grep(
423-
length(File::Basename::basename($_))
424-
> $maxlen,
425-
@outfiles
426-
);
427-
428-
foreach (@toolong){
429-
my($dir) = File::Basename::dirname($_);
430-
my($file) = File::Basename::basename($_);
431-
my($trunc) = substr($file,0,$maxlen);
432-
$notuniq{$dir}{$trunc} = 1 if $shorts{$dir}{$trunc};
433-
$shorts{$dir}{$trunc} = $shorts{$dir}{$trunc} ?
434-
"$shorts{$dir}{$trunc}, $file" : $file;
435-
}
436-
if (%notuniq && $warn){
437-
print "$filename: some names are not unique when " .
438-
"truncated to $maxlen characters:\n";
439-
foreach my $dir (sort keys %notuniq){
440-
print " directory $dir:\n";
441-
foreach my $trunc (sort keys %{$notuniq{$dir}}) {
442-
print " $shorts{$dir}{$trunc} truncate to $trunc\n";
443-
}
444-
}
445-
}
446-
}
447-
448414
1;
449415
__END__
450416

0 commit comments

Comments
 (0)