view release on metacpan or  search on metacpan

lib/App/Critique/Command/collect.pm  view on Meta::CPAN

    }

    return;
}

sub generate_file_predicate {
    my ($session, %args) = @_;

    my $filter       = $args{filter};
    my $match        = $args{match};
    my $no_violation = $args{no_violation};

    my $c = $session->perl_critic;

    # lets build an array of code_ref filters, that will be use to filter
    # the files, the code refs assume the params will be $path,$rel.

    #-------------------------------#
    # match | filter | no-violation #
    #-------------------------------#
    #    1  |    1   |      1       # collect with match, filter and no violations
    #    1  |    1   |      0       # collect with match and filter
    #    1  |    0   |      1       # collect with match and no violations
    #    1  |    0   |      0       # collect with match
    #-------------------------------#
    #    0  |    1   |      1       # collect with filter and no violations
    #    0  |    1   |      0       # collect with filter
    #-------------------------------#
    #    0  |    0   |      1       # collect with no violations
    #-------------------------------#
    #    0  |    0   |      0       # collect
    #-------------------------------#

    my @filters = (sub { return 1 });
    push @filters, sub { return $_[1] =~ /$match/ } if $match ;
    push @filters, sub { return $_[1] !~ /$filter/} if $filter;
    push @filters, sub {
        return scalar $c->critique( $_[0]->stringify )
    }  if $no_violation;

    my $predicate = sub {
        my ($root,$path) = @_;
        my $rel = $path->relative( $root );
        for my $file_filter( @filters ) {
            return unless $file_filter->($path,$rel);
        }
        return 1;
    };

    $session->set_file_criteria({
        filter       => $filter,
        match        => $match,
        no_violation => $no_violation
    });

    return $predicate;
}

# NOTE:
# This was mostly taken from the guts of
# Perl::Critic::Util::{_is_perl,_is_backup}
# - SL
sub is_perl_file {
    my ($file) = @_;

    # skip all the backups
    return 0 if $file =~ m{ [.] swp \z}xms;
    return 0 if $file =~ m{ [.] bak \z}xms;
    return 0 if $file =~ m{  ~ \z}xms;
    return 0 if $file =~ m{ \A [#] .+ [#] \z}xms;

    # but grab the perl files
    return 1 if $file =~ m{ [.] PL    \z}xms;
    return 1 if $file =~ m{ [.] p[lm] \z}xms;
    return 1 if $file =~ m{ [.] t     \z}xms;
    return 1 if $file =~ m{ [.] psgi  \z}xms;
    return 1 if $file =~ m{ [.] cgi   \z}xms;

    # if we have to, check for shebang
    my $first;
    {
        open my $fh, '<', $file or return 0;
        $first = <$fh>;
        close $fh;
    }

    return 1 if defined $first && ( $first =~ m{ \A [#]!.*perl }xms );
    return 0;
}

1;

=pod

=head1 NAME

App::Critique::Command::collect - Collect set of files for current critique session

=head1 VERSION

version 0.05

=head1 DESCRIPTION

This command will traverse the critque directory and gather all available Perl
files for critiquing. It will then store this list inside the correct critique
session file for processing during the critique session.

It should be noted that this is a destructive command, meaning that if you have
begun critiquing your files and you re-run this command it will overwrite that
list and you will loose any tracking information you currently have.

=head1 AUTHOR

Stevan Little <stevan@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2016 by Stevan Little.

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

=cut

__END__