Clarify the 8.3 rule.
[p5sagit/p5-mst-13.2.git] / Porting / check83.pl
CommitLineData
8c284f99 1#!/usr/local/bin/perl
2
4d8cc5f8 3# Check whether there are naming conflicts when names are truncated to
4# the DOSish case-ignoring 8.3 format, plus other portability no-nos.
8c284f99 5
9a715e86 6# The "8.3 rule" is "if reducing the directory entry names within one
7# directory to lowercase and 8.3-truncated causes conflicts, that's
8# a bad thing". So the rule is NOT "no filename shall be longer
9# than eight and a suffix if present not longer than three".
10
11# TODO: this doesn't actually check for *directory entries*, what
12# this does is to check for *MANIFES entries*, which are only files,
13# not directories. In other words, a conflict between a directory
14# "abcdefghx" and a file "abcdefghy" wouldn't be noticed-- or even
15# for a directory "abcdefgh" and a file "abcdefghy".
16
9e371ce5 17sub eight_dot_three {
18 my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!);
4d8cc5f8 19 my $file = $base . defined $ext ? ".$ext" : "";
9e371ce5 20 $base = substr($base, 0, 8);
21 $ext = substr($ext, 0, 3) if defined $ext;
4d8cc5f8 22 if ($dir =~ /\./) {
23 warn "$dir: directory name contains '.'\n";
24 }
25 if ($file =~ /[^A-Za-z0-9\._-]/) {
26 warn "$file: filename contains non-portable characters\n";
27 }
28 if (length $file > 30) {
29 warn "$file: filename longer than 30 characters\n";
30 }
9e371ce5 31 if (defined $dir) {
32 return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base");
33 } else {
34 return ('.', defined $ext ? "$base.$ext" : $base);
35 }
36}
37
38my %dir;
39
40if (open(MANIFEST, "MANIFEST")) {
41 while (<MANIFEST>) {
42 chomp;
43 s/\s.+//;
44 unless (-f) {
45 warn "$_: missing\n";
46 next;
47 }
48 if (tr/././ > 1) {
8c284f99 49 print "$_: more than one dot\n";
9e371ce5 50 next;
51 }
52 my ($dir, $edt) = eight_dot_three($_);
8c284f99 53 ($dir, $edt) = map { lc } ($dir, $edt);
9e371ce5 54 push @{$dir{$dir}->{$edt}}, $_;
55 }
56} else {
57 die "$0: MANIFEST: $!\n";
58}
59
60for my $dir (sort keys %dir) {
61 for my $edt (keys %{$dir{$dir}}) {
62 my @files = @{$dir{$dir}->{$edt}};
63 if (@files > 1) {
8c284f99 64 print "@files: directory $dir conflict $edt\n";
9e371ce5 65 }
66 }
67}