next unless /\.al\z/;
my($file) = catfile($dir, $_);
$file = lc $file if $Is83 or $Is_VMS;
next if $outfiles{$file};
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;
}
closedir($outdir);
}
}
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"
unless $last_package eq $package{$fqs};
print $ts "sub $subname $proto{$fqs};\n";
$last_package = $package{$fqs};
}
print $ts "1;\n";
close($ts);
_check_unique($filename, $Maxlen, 1, @outfiles);
@outfiles;
}
sub _modpname ($) {
my($package) = @_;
my $modpname = $package;
if ($^O eq 'MSWin32') {
$modpname =~ s#::#\\#g;
} else {
my @modpnames = ();
while ($modpname =~ m#(.*?[^:])::([^:].*)#) {
push @modpnames, $1;
$modpname = $2;
}
$modpname = catfile(@modpnames, $modpname);
}
if ($Is_VMS) {
$modpname = VMS::Filespec::unixify($modpname); # may have dirs
}
$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__
# test functions so AutoSplit.pm can be applied to itself:
sub test1 ($) { "test 1\n"; }
sub test2 ($$) { "test 2\n"; }
sub test3 ($$$) { "test 3\n"; }
sub testtesttesttest4_1 { "test 4\n"; }
sub testtesttesttest4_2 { "duplicate test 4\n"; }
sub Just::Another::test5 { "another test 5\n"; }
sub test6 { return join ":", __FILE__,__LINE__; }
package Yet::Another::AutoSplit;
sub testtesttesttest4_1 ($) { "another test 4\n"; }
sub testtesttesttest4_2 ($$) { "another duplicate test 4\n"; }
package Yet::More::Attributes;
sub test_a1 ($) : locked :locked { 1; }
sub test_a2 : locked { 1; }
=5= |