package Test::Portability::Files;
use strict;
use File::Basename;
use File::Find;
use File::Spec;
use Test::Builder;
require Exporter;

{ no strict;
  $VERSION = '0.01';
  @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, 
    special_chars => 1, 
    space         => 1, 
    mac_length    => 1, 
    dos_length    => 0, 
    case          => 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", 

    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:\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:", 
);

my %bad_names = ();
my %lc_names = ();

=head1 NAME

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

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

    use Test::More;
    eval "use Test::Portability::Files";
    plan skip_all => "Test::Portability::Files required for testing file names 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) seems to be no longer supported. 
Here are the default options: 

    use_file_find is not enabled (check only the names as listed in MANIFEST)

    test_ansi_chars is enabled
    test_case is enabled
    test_dos_length is not enabled
    test_mac_length is enabled
    test_one_dot is enabled
    test_space is enabled
    test_special_chars is enabled

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


=head1 EXPORT

The following functions are exported: 

=over 4

=item *

options()

=item *

run_tests()

=back


=head1 FUNCTIONS

=over 4

=item 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_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_dos_length> - check that the name is inside 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 is inside 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. 

=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 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, '\\.[^.]+?');
        $_ = $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 full 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 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 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($lc_names{lc $file}) {
            $bad_names{$file} .= 'case,';
            $bad_names{$lc_names{lc $file}} .= 'case,';
        } else {
            $lc_names{lc $file} = $file
        }
    }
}

=item 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
        open(MANIFEST, 'MANIFEST') or $Test->skip("Can't read MANIFEST!") and return;
        
        while(<MANIFEST>) {
            chomp;
            s/ *#.*$//g;
            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");
    }
}

=back

=head1 AUTHOR

SE<eacute>bastien Aperghis-Tramoni, E<lt>sebastien@perghis.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
