Porting/check83.pl

   1 #!/usr/local/bin/perl
   2
   3 # Check whether there are naming conflicts when names are truncated
   4 # to the DOSish case-ignoring 8.3 format
   5
   6 sub eight_dot_three {
   7     my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!);
   8     $base = substr($base, 0, 8);
   9     $ext  = substr($ext,  0, 3) if defined $ext;
  10     if (defined $dir) {
  11         return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base");
  12     } else {
  13         return ('.', defined $ext ? "$base.$ext" : $base);
  14     }
  15 }
  16
  17 my %dir;
  18
  19 if (open(MANIFEST, "MANIFEST")) {
  20     while (<MANIFEST>) {
  21         chomp;
  22         s/\s.+//;
  23         unless (-f) {
  24             warn "$_: missing\n";
  25             next;
  26         }
  27         if (tr/././ > 1) {
  28             print "$_: more than one dot\n";
  29             next;
  30         }
  31         my ($dir, $edt) = eight_dot_three($_);
  32         ($dir, $edt) = map { lc } ($dir, $edt);
  33         push @{$dir{$dir}->{$edt}}, $_;
  34     }
  35 } else {
  36     die "$0: MANIFEST: $!\n";
  37 }
  38
  39 for my $dir (sort keys %dir) {
  40     for my $edt (keys %{$dir{$dir}}) {
  41         my @files = @{$dir{$dir}->{$edt}};
  42         if (@files > 1) {
  43             print "@files: directory $dir conflict $edt\n";
  44         }
  45     }
  46 }