diff options
| -rw-r--r-- | Porting/pumpkin.pod | 1 | ||||
| -rw-r--r-- | check83.pl | 41 |
2 files changed, 42 insertions, 0 deletions
diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index a816c48752..44fde71970 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -158,6 +158,7 @@ settled elsewhere. If feasible, try to keep filenames 8.3-compliant to humor those poor souls that get joy from running Perl under such dire limitations. +There's a script, check83.pl, for keeping your nose 8.3-clean. =head2 Seek consensus on major changes diff --git a/check83.pl b/check83.pl new file mode 100644 index 0000000000..69e00c659d --- /dev/null +++ b/check83.pl @@ -0,0 +1,41 @@ +sub eight_dot_three { + my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!); + $base = substr($base, 0, 8); + $ext = substr($ext, 0, 3) if defined $ext; + if (defined $dir) { + return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base"); + } else { + return ('.', defined $ext ? "$base.$ext" : $base); + } +} + +my %dir; + +if (open(MANIFEST, "MANIFEST")) { + while (<MANIFEST>) { + chomp; + s/\s.+//; + unless (-f) { + warn "$_: missing\n"; + next; + } + if (tr/././ > 1) { + warn "$_: more than one dot\n"; + next; + } + my ($dir, $edt) = eight_dot_three($_); + next if $edt eq $_; + push @{$dir{$dir}->{$edt}}, $_; + } +} else { + die "$0: MANIFEST: $!\n"; +} + +for my $dir (sort keys %dir) { + for my $edt (keys %{$dir{$dir}}) { + my @files = @{$dir{$dir}->{$edt}}; + if (@files > 1) { + print "$dir $edt @files\n"; + } + } +} |