package Test::Portability::Files;
use strict;
use ExtUtils::Manifest qw(maniread);
use File::Basename;
use File::Find;
use File::Spec;
use Test::Builder;
require Exporter;

{ no strict;
  $VERSION = '0.05';
  @ISA = qw(Exporter);
  @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 = ();

=head1 NAME

Test::Portability::Files - Check file names portability

=head1 VERSION

Version 0.05

=head1 SYNOPSIS

    use Test::More;
    eval "use Test::Portability::Files";
    plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
    options(all_tests => 1);  # to be hyper-strict
    run_tests();

=head1 DESCRIPTION

This module is used to check the portability across operating systems 
of the names of the files present in the distribution of a module. 
The tests use the advices given in L<perlport/"Files and Filesystems">. 
The author of a distribution can select which tests to execute. 

To use this module, simply copy the code from the synopsis in a test 
file named F<t/portfs.t> for example, and add it to your F<MANIFEST>. 
You can delete the call to C<options()> to enable only most common tests. 

By default, not all tests are enabled because some are judged too cumbersome 
to be practical, especially since some of the most limited platforms (like 
MS-DOS) seem to be no longer supported. 
Here are the default options: 

=over 4

=item *

C<use_file_find> is I<not> enabled (check only the names as listed 
in F<MANIFEST>)

=item *

C<test_amiga_length> is enabled

=item *

C<test_ansi_chars> is enabled

=item *

C<test_case> is enabled

=item *

C<test_dos_length> is I<not> enabled

=item *

C<test_mac_length> is enabled

=item *

C<test_one_dot> is enabled

=item *

C<test_space> is enabled

=item *

C<test_special_chars> is enabled

=item *

C<test_symlink> is enabled

=item *

C<test_vms_length> is enabled

=back

To change any option, please see C<options()>. 


=head1 EXPORT

The following functions are exported: 

=over 4

=item *

C<options()>

=item *

C<run_tests()>

=back


=head1 FUNCTIONS

=over 4

=item C<options()>

Set the module options, in particular, select which tests to execute. 
Expects a hash. 

B<General options>

=over 4

=item *

C<use_file_find> - set to 1 to check all the files in the current 
hierarchy using C<File::Find> instead of only checking files listed 
in F<MANIFEST>. 

=back

B<Tests>

=over 4

=item *

C<all_tests> - select all tests.

=item *

C<test_amiga_length> - check that the name fits within AmigaOS name length 
limitations (107 characters). 

=item *

C<test_ansi_chars> - check that the name only uses the portable filename 
characters as defined by S<ANSI C> and recommended by L<perlport>. 

=item *

C<test_case> - check that the name of the file does not clash with 
the name of another file on case-insensitive filesystems.

=item *

C<test_dir_noext> - check that the directory has no extension.

=item *

C<test_dos_length> - check that the name fits within DOS name length limitations 
(8 characters max for the base name, 3 characters max for the extension). 

=item *

C<test_mac_length> - check that the name fits within Mac OS Classic name length 
limitations (31 characters). 

=item *

C<test_one_dot> - check that the name only has one dot.

=item *

C<test_space> - check that the name has nos space.

=item *

C<test_special_chars> - check that the name does not use special characters. 

=item *

C<test_symlink> - check that the file is not a symbolic link.

=item *

C<test_vms_length> - check that the name fits within VMS name length limitations 
(39 characters max for the base name, 39 characters max for the extension). 

=back

B<Example>

    options(use_file_find => 1, all_tests => 1);

selects all tests and runs them against all files found using C<File::Find>.

=cut

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

=item C<test_name_portability()>

Test the portability of the given file name. 

=cut

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-[!"#\$%&'\(\)\*\+/:;<>\?@\[\\\]^`\{\|\}~]- 
          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,'
    }
}

=item C<run_tests()>

Execute the tests selected by C<options()>. 

=cut

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();
        map { test_name_portability($_) } keys %$manifest;
    }
    
    # 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");
    }
}

=back

=head1 SEE ALSO

L<perlport>

=head1 AUTHOR

SE<eacute>bastien Aperghis-Tramoni, E<lt>sebastien@aperghis.netE<gt>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-test-portability-files@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.  I will be notified, and then you'll automatically
be notified of progress on your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2004 SE<eacute>bastien Aperghis-Tramoni, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Test::Portability::Files