view release on metacpan or  search on metacpan

xt/portability_files.t  view on Meta::CPAN

    my %lc_names = ();

    sub options {
        my %opts = @_;
        for my $test (keys %tests) {
            $tests{$test} = $opts{"test_$test"} if exists $opts{"test_$test"};
        }
        for my $opt (keys %options) {
            $options{$opt} = $opts{$opt} if exists $opts{$opt};
        }
        @tests{ keys %tests } = (1) x (keys %tests) if $opts{all_tests};
    }

    sub test_name_portability {
        my ($file, $file_name, $file_path, $file_ext);

        # extract path, base name and extension
        if ($options{use_file_find}) {

            # using Find::File
            # skip generated files
            return if $_ eq File::Spec->curdir or $_ eq 'pm_to_blib';
            my $firstdir = (File::Spec->splitdir(File::Spec->canonpath($File::Find::name)))[0];
            return if $firstdir eq 'blib' or $firstdir eq '_build';

            $file = $File::Find::name;
            ($file_name, $file_path, $file_ext) = fileparse($file, '\\.[^.]+?');

        } else {    # only check against MANIFEST
            $file = shift;
            ($file_name, $file_path, $file_ext) = fileparse($file, '\\.[^.]+?');

            #for my $dir (File::Spec->splitdir(File::Spec->canonpath($file_path))) {
            #    test_name_portability($dir)
            #}

            $_ = $file_name . $file_ext;
        }

        #print STDERR "file $file\t=> path='$file_path', name='$file_name', ext='$file_ext'\n";

        # After this point, the following variables are expected to hold these semantics
        #   $file must contain the path to the file (t/00load.t)
        #   $_ must contain the full name of the file (00load.t)
        #   $file_name must contain the base name of the file (00load)
        #   $file_path must contain the path to the directory containing the file (t/)
        #   $file_ext must contain the extension (if any) of the file (.t)

        # check if the name only uses portable filename characters, as defined by ANSI C
        if ($tests{ansi_chars}) {
            /^[A-Za-z0-9][A-Za-z0-9._-]*$/ or $bad_names{$file} .= 'ansi_chars,';
        }

        # check if the name contains more than one dot
        if ($tests{one_dot}) {
            tr/.// > 1 and $bad_names{$file} .= 'one_dot,';
        }

        # check if the name contains special chars
        if ($tests{special_chars}) {
            m-[!"#\$%&'\(\)\*\+/:;<>\?@\[\\\]^`\{\|\}~]-    # " for poor editors
                and $bad_names{$file} .= 'special_chars,';
        }

        # check if the name contains a space char
        if ($tests{space}) {
            m/ / and $bad_names{$file} .= 'space,';
        }

        # check the length of the name, compared to Mac OS Classic max length
        if ($tests{mac_length}) {
            length > 31 and $bad_names{$file} .= 'mac_length,';
        }

        # check the length of the name, compared to AmigaOS max length
        if ($tests{amiga_length}) {
            length > 107 and $bad_names{$file} .= 'amiga_length,';
        }

        # check the length of the name, compared to VMS max length
        if ($tests{vms_length}) {
            (length($file_name) <= 39 and length($file_ext) <= 40) or $bad_names{$file} .= 'vms_length,';
        }

        # check the length of the name, compared to DOS max length
        if ($tests{dos_length}) {
            (length($file_name) <= 8 and length($file_ext) <= 4) or $bad_names{$file} .= 'dos_length,';
        }

        # check if the name is unique on case-insensitive filesystems
        if ($tests{case}) {
            if (not $lc_names{$file} and $lc_names{ lc $file }) {
                $bad_names{$file} .= 'case,';
                $bad_names{ $lc_names{ lc $file } } .= 'case,';
            } else {
                $lc_names{ lc $file } = $file;
            }
        }

        # check if the file is a symbolic link
        if ($tests{'symlink'}) {
            -l $file and $bad_names{$file} .= 'symlink,';
        }

        # if it's a directory, check that it has no extension
        if ($tests{'dir_noext'}) {
            -d $file and tr/.// > 0 and $bad_names{$file} .= 'dir_noext,';
        }
    }

    sub run_tests {
        fileparse_set_fstype('Unix');

        if ($options{use_file_find}) {

            # check all files found using File::Find
            find(\&test_name_portability, File::Spec->curdir);

        } else {

            # check only against files listed in MANIFEST