Porting/check83.pl

   1 #!/usr/local/bin/perl
   2
   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.
   5
   6 sub eight_dot_three {
   7     my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!);
   8     my $file = $base . defined $ext ? ".$ext" : "";
   9     $base = substr($base, 0, 8);
  10     $ext  = substr($ext,  0, 3) if defined $ext;
  11     if ($dir =~ /\./)  {
  12         warn "$dir: directory name contains '.'\n";
  13     }
  14     if ($file =~ /[^A-Za-z0-9\._-]/) {
  15         warn "$file: filename contains non-portable characters\n";
  16     }
  17     if (length $file > 30) {
  18         warn "$file: filename longer than 30 characters\n";
  19     }
  20     if (defined $dir) {
  21         return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base");
  22     } else {
  23         return ('.', defined $ext ? "$base.$ext" : $base);
  24     }
  25 }
  26
  27 my %dir;
  28
  29 if (open(MANIFEST, "MANIFEST")) {
  30     while (<MANIFEST>) {
  31         chomp;
  32         s/\s.+//;
  33         unless (-f) {
  34             warn "$_: missing\n";
  35             next;
  36         }
  37         if (tr/././ > 1) {
  38             print "$_: more than one dot\n";
  39             next;
  40         }
  41         my ($dir, $edt) = eight_dot_three($_);
  42         ($dir, $edt) = map { lc } ($dir, $edt);
  43         push @{$dir{$dir}->{$edt}}, $_;
  44     }
  45 } else {
  46     die "$0: MANIFEST: $!\n";
  47 }
  48
  49 for my $dir (sort keys %dir) {
  50     for my $edt (keys %{$dir{$dir}}) {
  51         my @files = @{$dir{$dir}->{$edt}};
  52         if (@files > 1) {
  53             print "@files: directory $dir conflict $edt\n";
  54         }
  55     }
  56 }