1#!./perl -w
2
3=head1 filenames.t
4
5Test the well-formed-ness of filenames names in the MANIFEST file. Current
6tests 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,
15PRN, AUX, NUL, COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9, LPT1,
16LPT2, LPT3, LPT4, LPT5, LPT6, LPT7, LPT8, and LPT9
17
18=item * no spaces, ( or & in filenames
19
20=back
21
22=cut
23
24BEGIN {
25    chdir 't';
26    @INC = '../lib';
27}
28
29use strict;
30use File::Basename;
31require './test.pl';
32
33
34my $manifest = '../MANIFEST';
35
36open my $m, '<', $manifest or die "Can't open '$manifest': $!";
37my @files;
38while (<$m>) {
39    chomp;
40    my($path) = split /\t+/;
41    push @files, $path;
42
43}
44close $m or die $!;
45
46plan(scalar @files);
47
48PATHNAME: 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
83