#!/usr/bin/perl

use strict;
use warnings;

Test::Portability::Files->import();

options(
    test_ansi_chars   => 0,
    test_dos_length   => 0,
    test_mac_length   => 0,
    test_amiga_length => 0,

);
run_tests();

# The following code is copied from Test::Portability::Files
# with the patch by RT #21631
# See http://rt.cpan.org/Public/Bug/Display.html?id=21631
## no critic(ProhibitExcessComplexity)
BEGIN {

    package Test::Portability::Files;
    use strict;
    use ExtUtils::Manifest qw(maniread);
    use File::Basename;

    #use File::Find;
    use File::Spec;
    use Test::Builder;

    {
        no strict 'vars';
        $VERSION = '0.05';
        @EXPORT = qw(&options &run_tests);
        @EXPORT_OK = @EXPORT;
    }

    my $Test = Test::Builder->new;

    sub import {
        my $self = shift;
        my $caller = caller;

        {
            no strict 'refs';
            *{ $caller . '::options' } = \&options;
            *{ $caller . '::run_tests' } = \&run_tests;
        }

        $Test->exported_to($caller);
        $Test->plan(tests => 1) unless $Test->has_plan;
    }

    my %options = (use_file_find => 0,);

    my %tests = (
        ansi_chars    => 1,
        one_dot       => 1,
        dir_noext     => 1,
        special_chars => 1,
        space         => 1,
        mac_length    => 1,
        amiga_length  => 1,
        vms_length    => 1,
        dos_length    => 0,
        case          => 1,
        'symlink'     => 1,
    );

    my %errors_text = (    # wrap the text at this column --------------------------------> |
        ansi_chars => "These files does not respect the portable filename characters\n"
            . "as defined by ANSI C and perlport:\n",

        one_dot => "These files contain more than one dot in their name:\n",

        dir_noext => "These directories have an extension in their name:\n",

        special_chars => "These files contain special characters that may break on\n"
            . "several systems, please correct:\n",

        space => "These files contain space in their name, which is not well\n" . "handled on several systems:\n",

        mac_length => "These files have a name more than 31 characters long, which\n"
            . "will be truncated on Mac OS Classic and old AmigaOS:\n",

        amiga_length => "These files have a name more than 107 characters long, which\n"
            . "will be truncated on recent AmigaOS:\n",

        vms_length => "These files have a name or extension too long for VMS (both\n"
            . "are limited to 39 characters):\n",

        dos_length => "These files have a name too long for MS-DOS and compatible\n" . "systems:\n",

        case => "The name of these files differ only by the case, which can\n"
            . "cause real problems on case-insensitive filesystems:",

        'symlink' => "The following files are symbolic links, which are not\n"
            . "supported on several operating systems:",
    );

    my %bad_names = ();
    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
            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
