view release on metacpan or  search on metacpan

xt/portability_files.t  view on Meta::CPAN

        }

        # 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
            my $manifest = maniread();
            foreach (keys %$manifest) { test_name_portability($_) }
        }

        # check the results
        if (keys %bad_names) {
            $Test->ok(0, "File names portability");

            my %errors_list = ();
            for my $file (keys %bad_names) {
                for my $error (split ',', $bad_names{$file}) {
                    $errors_list{$error} = [] if not ref $errors_list{$error};
                    push @{ $errors_list{$error} }, $file;
                }
            }

            for my $error (sort keys %errors_list) {
                $Test->diag($errors_text{$error});

                for my $file (sort @{ $errors_list{$error} }) {
                    $Test->diag("   $file");
                }

                $Test->diag(' ');
            }
        } else {
            $Test->ok(1, "File names portability");
        }
    }

}    # end of BEGIN