diff options
Diffstat (limited to 'gnu/usr.bin/perl/Porting')
| -rw-r--r-- | gnu/usr.bin/perl/Porting/check83.pl | 56 |
1 files changed, 21 insertions, 35 deletions
diff --git a/gnu/usr.bin/perl/Porting/check83.pl b/gnu/usr.bin/perl/Porting/check83.pl index fbe56555898..7006d23c1fe 100644 --- a/gnu/usr.bin/perl/Porting/check83.pl +++ b/gnu/usr.bin/perl/Porting/check83.pl @@ -1,6 +1,4 @@ -#!/usr/bin/perl -w - -use strict; +#!/usr/local/bin/perl # Check whether there are naming conflicts when names are truncated to # the DOSish case-ignoring 8.3 format, plus other portability no-nos. @@ -11,30 +9,25 @@ use strict; # "no filename shall be longer than eight and a suffix if present # not longer than three". -# The 8-level depth rule is for older VMS systems that likely won't -# even be able to unpack the tarball if more than eight levels -# (including the top of the source tree) are present. - -my %seen; -my $maxl = 30; # make up a limit for a maximum filename length +# TODO: this doesn't actually check for *directory entries*, what this +# does is to check for *MANIFEST entries*, which are only files, not +# directories. In other words, a 8.3 conflict between a directory +# "abcdefghx" and a file "abcdefghy" wouldn't be noticed-- or even for +# a directory "abcdefgh" and a file "abcdefghy". sub eight_dot_three { - return () if $seen{$_[0]}++; - my ($dir, $base, $ext) = ($_[0] =~ m{^(?:(.+)/)?([^/.]*)(?:\.([^/.]+))?$}); - my $file = $base . ( defined $ext ? ".$ext" : "" ); + my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!); + my $file = $base . defined $ext ? ".$ext" : ""; $base = substr($base, 0, 8); $ext = substr($ext, 0, 3) if defined $ext; - if (defined $dir && $dir =~ /\./) { - print "directory name contains '.': $dir\n"; - } - if ($base eq "") { - print "filename starts with dot: $_[0]\n"; + if ($dir =~ /\./) { + warn "$dir: directory name contains '.'\n"; } if ($file =~ /[^A-Za-z0-9\._-]/) { - print "filename contains non-portable characters: $_[0]\n"; + warn "$file: filename contains non-portable characters\n"; } - if (length $file > $maxl) { - print "filename longer than $maxl characters: $file\n"; + if (length $file > 30) { + warn "$file: filename longer than 30 characters\n"; # make up a limit } if (defined $dir) { return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base"); @@ -45,28 +38,21 @@ sub eight_dot_three { my %dir; -if (open(MANIFEST, '<', 'MANIFEST')) { +if (open(MANIFEST, "MANIFEST")) { while (<MANIFEST>) { chomp; s/\s.+//; unless (-f) { - print "missing: $_\n"; + warn "$_: missing\n"; next; } if (tr/././ > 1) { - print "more than one dot: $_\n"; + print "$_: more than one dot\n"; next; } - if ((my $slashes = $_ =~ tr|\/|\/|) > 7) { - print "more than eight levels deep: $_\n"; - next; - } - while (m!/|\z!g) { - my ($dir, $edt) = eight_dot_three("$`"); - next unless defined $dir; - ($dir, $edt) = map { lc } ($dir, $edt); - push @{$dir{$dir}->{$edt}}, $_; - } + my ($dir, $edt) = eight_dot_three($_); + ($dir, $edt) = map { lc } ($dir, $edt); + push @{$dir{$dir}->{$edt}}, $_; } } else { die "$0: MANIFEST: $!\n"; @@ -74,9 +60,9 @@ if (open(MANIFEST, '<', 'MANIFEST')) { for my $dir (sort keys %dir) { for my $edt (keys %{$dir{$dir}}) { - my @files = @{$dir{$dir}{$edt}}; + my @files = @{$dir{$dir}->{$edt}}; if (@files > 1) { - print "conflict on filename $edt:\n", map " $_\n", @files; + print "@files: directory $dir conflict $edt\n"; } } } |