view release on metacpan or  search on metacpan

examples/file-access-tests  view on Meta::CPAN

use PPI::Document;
use Readonly;
use Pod::Usage;

our $VERSION = '0.002';

Readonly::Scalar my $DEFAULT_SINGLE_FILE_FORMAT => 4;
Readonly::Scalar my $DEFAULT_MULTI_FILE_FORMAT  => 5;

my %opt;

GetOptions( \%opt,
    'format=s'  => \( my $format ),
    'suspect_encoding|suspect-encoding=s@' => \( my @suspect ),
    'verbose!'  => \( my $verbose ),
    help => sub { pod2usage( { -verbose => 2 } ) },
) or pod2usage( { -verbose => 0 } );

if ( @suspect ) {
    @suspect = map { split qr< \s* , \s* >smx } @suspect;
} else {
    @suspect = qw{ iso-latin-1 };
}

if ( ! @ARGV ) {
    -e 'MANIFEST'
        or die "No arguments specified and no MANIFEST found\n";
    require ExtUtils::Manifest;
    my $manifest = ExtUtils::Manifest::maniread();
    @ARGV = sort all_perl_files( keys %{ $manifest } )  ## no critic (RequireLocalizedPunctuationVars)
}

my $critic = Perl::Critic->new(
    -profile    => 'NONE',
);

$critic->add_policy(
    -policy => 'ValuesAndExpressions::ProhibitFiletest_rwxRWX',
    -config => \%opt
);

{
    no warnings qw{ newline };  ## no critic (ProhibitNoWarnings)
    Perl::Critic::Violation::set_format(
        defined $format ? $format :
        ( @ARGV > 1 || -d $ARGV[0] ) ?
            $DEFAULT_MULTI_FILE_FORMAT :
            $DEFAULT_SINGLE_FILE_FORMAT
    );
}

foreach my $fn ( @ARGV ) {

    no warnings qw{ newline };  ## no critic (ProhibitNoWarnings)
    foreach my $pf ( -e $fn ? all_perl_files( $fn ) : \$fn ) {

        # We jump through this particular hoop because PPI::Document
        # does not recognize 'use utf8;'. Instead it looks for a Byte
        # Order Mark (a.k.a. non-breaking space) as the first encoded
        # character of the file, and adjusts accordingly. UTF-8 files
        # without a BOM are therefore not read correctly. So we incur
        # the overhead of guessing and decoding if we guess a unique
        # encoding. We then feed PPI::Document the possibly-decoded file
        # content.
        my $doc;
        {
            local $/ = undef;
            open my $fh, '<', $pf
                or die "Unable to open $pf: $!\n";
            my $data = <$fh>;
            close $fh;

            my $enc = guess_encoding( $data, @suspect );
            ref $enc
                and $data = $enc->decode( $data );
            # warn "Debug - $pf encoding: ", ref $enc ? $enc->name() : $enc;

            $doc = eval { PPI::Document->new( \$data ) }
                or do {
                warn "In $pf, @{[ PPI::Document->errstr() ]}\n";
                next;
            };
        }


        # DANGER WILL ROBINSON! ENCAPSULATION VIOLATION!
        # There is no supported way to associate a file name with a
        # PPI::Document created from file content rather than file name.
        # After considering monkey-patching the filename() method, I
        # went with just hammering the name into the hash, which has the
        # advantage of being straightforward. A solid monkey-patch
        # implementation needs inside-out objects so it can fall back to
        # the original implementation of filename() if an overridden
        # file name is not present.
        ref $pf
            or $doc->{filename} = $pf;

        my @violations = Perl::Critic::Violation::sort_by_location(
            $critic->critique( $doc ) );

        if ( @violations ) {
            foreach ( @violations ) {
                print;
            }
        } elsif ( $verbose ) {
            local $_ = Perl::Critic::Violation::get_format();
            local $OUTPUT_RECORD_SEPARATOR = "\n";
            print m/ (?: \A | (?<= [^%] ) ) (?: %% )* %f /smx ?
                "$pf source OK" : 'source OK';
        }
    }
}

__END__

=head1 NAME

old-prototypes - Find old-style prototypes

=head1 SYNOPSIS