check83.pl

   1 sub eight_dot_three {
   2     my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!);
   3     $base = substr($base, 0, 8);
   4     $ext  = substr($ext,  0, 3) if defined $ext;
   5     if (defined $dir) {
   6         return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base");
   7     } else {
   8         return ('.', defined $ext ? "$base.$ext" : $base);
   9     }
  10 }
  11
  12 my %dir;
  13
  14 if (open(MANIFEST, "MANIFEST")) {
  15     while (<MANIFEST>) {
  16         chomp;
  17         s/\s.+//;
  18         unless (-f) {
  19             warn "$_: missing\n";
  20             next;
  21         }
  22         if (tr/././ > 1) {
  23             warn "$_: more than one dot\n";
  24             next;
  25         }
  26         my ($dir, $edt) = eight_dot_three($_);
  27         next if $edt eq $_;
  28         push @{$dir{$dir}->{$edt}}, $_;
  29     }
  30 } else {
  31     die "$0: MANIFEST: $!\n";
  32 }
  33
  34 for my $dir (sort keys %dir) {
  35     for my $edt (keys %{$dir{$dir}}) {
  36         my @files = @{$dir{$dir}->{$edt}};
  37         if (@files > 1) {
  38             print "$dir $edt @files\n";
  39         }
  40     }
  41 }