File Coverage

blib/lib/App/BoolFindGrep/Grep.pm

Criterion	Covered	Total	%
statement	42	58	72.4
branch	11	24	45.8
condition	3	5	60.0
subroutine	9	10	90.0
pod	1	1	100.0
total	66	98	67.3

package App::BoolFindGrep::Grep;

use common::sense;
use charnames q(:full);
use Carp;
use English qw[-no_match_vars];
use IO::File;
use Moo;

our $VERSION = '0.03'; # VERSION

has match_expr => ( is => q(rw), default => undef );
has patterns   => ( is => q(rw), default => sub { {}; }, );
has greped     => ( is => q(rw), default => sub { {}; }, );
has fixed_strings => (
    is      => q(rw),
    isa     => sub { ( $_[0] == 1 || $_[0] == 0 ) or die; },
    default => 0,
);
has ignore_case => (
    is      => q(rw),
    isa     => sub { ( $_[0] == 1 || $_[0] == 0 ) or die; },
    default => 0,
);
has line_regexp => (
    is      => q(rw),
    isa     => sub { ( $_[0] == 1 || $_[0] == 0 ) or die; },
    default => 0,
);
has word_regexp => (
    is      => q(rw),
    isa     => sub { ( $_[0] == 1 || $_[0] == 0 ) or die; },
    default => 0,
);

sub process {
    my $self = shift;
    my @file = splice @_;

    return unless defined $self->match_expr();
    return unless %{ $self->patterns() };

    $self->_process_patterns();

    while ( my $file = shift @file ) {
        croak sprintf q('%s': nonexistent file.), $file if !-e $file;
        croak sprintf q('%s': irregular file.),   $file if !-f $file;
        croak sprintf q('%s': unreadable file.),  $file if !-r $file;
        if ( my $fh = IO::File->new( $file, q(r) ) ) {
            while ( my $line = readline $fh ) {
                chomp $line;
                $self->_search( $line, $file );
            }
        }
        else { croak $OS_ERROR; }
    }

    return 1;
} ## end sub process

sub _search {
    my $self   = shift;
    my $string = shift;
    my $file   = shift;

    foreach my $pattern ( keys %{ $self->patterns } ) {
        my $re = $self->patterns->{$pattern};
        $self->greped->{$file}{$pattern} //= 0;

        $self->greped->{$file}{$pattern}++
            if $string =~ m{$re};
    }

    return 1;
} ## end sub search

sub _process_patterns {
    my $self = shift;

    die if $self->line_regexp() && $self->word_regexp();

    foreach my $pattern ( keys %{ $self->patterns() } ) {
        my $value = $pattern;
        $value = quotemeta $value if $self->fixed_strings();

        if ( $self->line_regexp() ) {
            $value = sprintf q(\A%s\z), $value;
        }
        elsif ( $self->word_regexp() ) {
            $value = sprintf q(\b%s\b), $value;
        }

        $value = $self->ignore_case() ? qr{$value}i : qr{$value};

        $self->patterns->{$pattern} = $value;
    } ## end foreach my $pattern ( keys ...)

    return 1;
} ## end sub process_patterns

no Moo;
__PACKAGE__->meta->make_immutable;

1;

__END__