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::Spec;
  31 use File::Basename;
  32 require './test.pl';
  33
  34
  35 my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST');
  36
  37 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
  38 my @files;
  39 while (<$m>) {
  40     chomp;
  41     my($path) = split /\t+/;
  42     push @files, $path;
  43
  44 }
  45 close $m or die $!;
  46
  47 plan(scalar @files);
  48
  49 for my $file (@files) {
  50     validate_file_name($file);
  51 }
  52 exit 0;
  53
  54
  55 sub validate_file_name {
  56     my $path = shift;
  57     my $filename = basename $path;
  58
  59     note("testing $path");
  60
  61     my @path_components = split('/',$path);
  62     pop @path_components; # throw away the filename
  63     for my $component (@path_components) {
  64         if ($component =~ /\./) {
  65             fail("no directory components containing '.'");
  66             return;
  67         }
  68         if (length $component > 32) {
  69             fail("no directory with a name over 32 characters (VOS requirement)");
  70             return;
  71         }
  72     }
  73
  74
  75     if ($filename =~ /^\-/) {
  76         fail("filename does not start with -");
  77         return;
  78     }
  79
  80     my($before, $after) = split /\./, $filename;
  81     if (length $before > 39) {
  82         fail("filename has 39 or fewer characters before the dot");
  83         return;
  84     }
  85     if ($after) {
  86         if (length $after > 39) {
  87             fail("filename has 39 or fewer characters after the dot");
  88             return;
  89         }
  90     }
  91
  92     if ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
  93         fail("filename has a reserved name");
  94         return;
  95     }
  96
  97     if ($filename =~ /\s|\(|\&/) {
  98         fail("filename has a reserved character");
  99         return;
 100     }
 101     pass("filename ok");
 102 }
 103
 104 # EOF