t/porting/filenames.t

   1 #!./perl -w
   2
   3 =head1 filenames.t
   4
   5 Test the well-formed-ness of filenames names in the MANIFEST file. Current
   6 tests being done:
   7
   8 =over 4
   9
  10 =item * no more than 39 characters before the dot, and 39 after
  11
  12 =item * no filenames starting with -
  13
  14 =item * don't use any of these names (regardless of case) before the dot: CON,
  15 PRN, AUX, NUL, COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, LPT1,
  16 LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, and LPT9
  17
  18 =item * no spaces, ( or & in filenames
  19
  20 =back
  21
  22 =cut
  23
  24 BEGIN {
  25     chdir 't';
  26     @INC = '../lib';
  27 }
  28
  29 use strict;
  30 use File::Basename;
  31 require './test.pl';
  32
  33
  34 my $manifest = '../MANIFEST';
  35
  36 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
  37 my @files;
  38 while (<$m>) {
  39     chomp;
  40     my($path) = split /\t+/;
  41     push @files, $path;
  42
  43 }
  44 close $m or die $!;
  45
  46 plan(scalar @files);
  47
  48 PATHNAME: for my $pathname (@files) {
  49     my @path_components = split('/',$pathname);
  50     my $filename = pop @path_components;
  51     for my $component (@path_components) {
  52         if ($component =~ /\./) {
  53             fail("$pathname has directory components containing '.'");
  54             next PATHNAME;
  55         }
  56         if (length $component > 32) {
  57             fail("$pathname has a name over 32 characters (VOS requirement)");
  58             next PATHNAME;
  59         }
  60     }
  61
  62
  63     if ($filename =~ /^\-/) {
  64         fail("$pathname starts with -");
  65             next PATHNAME;
  66     }
  67
  68     my($before, $after) = split /\./, $filename;
  69     if (length $before > 39) {
  70         fail("$pathname has more than 39 characters before the dot");
  71     } elsif ($after && length $after > 39) {
  72         fail("$pathname has more than 39 characters after the dot");
  73     } elsif ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
  74         fail("$pathname has a reserved name");
  75     } elsif ($filename =~ /\s|\(|\&/) {
  76         fail("$pathname has a reserved character");
  77     } else {
  78         pass("$pathname ok");
  79     }
  80 }
  81
  82 # EOF