File Coverage

blib/lib/App/Greple/xp.pm

Criterion	Covered	Total	%
statement	23	40	57.5
branch	0	16	0.0
condition	0	6	0.0
subroutine	8	9	88.8
pod	0	1	0.0
total	31	72	43.0

=head1 NAME

App::Greple::xp - extended pattern module

=head1 VERSION

Version 0.04

=head1 SYNOPSIS

greple -Mxp

=head1 DESCRIPTION

This module provides functions those can be used by B pattern
and region options.

=head1 OPTIONS

=over 7

=item B<--le-pattern> I

=item B<--inside-pattern> I

=item B<--outside-pattern> I

=item B<--include-pattern> I

=item B<--exclude-pattern> I

Read file contents and use each lines as a pattern for options.

=item B<--le-string> I

=item B<--inside-string> I

=item B<--outside-string> I

=item B<--include-string> I

=item B<--exclude-string> I

Almost same as B<*-pattern> option but each line is concidered as a
fixed string rather than regular expression.

=back

=head2 COMMENT

Lines start with hash mark (C<#>) is ignored as a comment line.

String after double slash (C) is also ignored with preceding
spaces.

=head2 WILD CARD

Because I parameter is globbed, you can use wild card to give
multiple files.  If nothing matched to the wild card, this option is
simply ignored with no message.

    $ greple -Mxp --exclude-pattern '*.exclude' ...

=head1 SEE ALSO

L

L

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 2019- Kazumasa Utashiro.

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

=cut


package App::Greple::xp;

use v5.14;
use strict;
use warnings;

our $VERSION = "0.04";

use Exporter 'import';
our @EXPORT = qw(&xp_pattern_file);

use open IO => ':utf8';
use App::Greple::Common;
use App::Greple::Regions qw(match_regions merge_regions);
use Data::Dumper;

my @default_opt = (
    hash_comment => 1,
    slash_comment => 1,
    glob => 1,
    fixed => 0,
    );

sub xp_pattern_file {
    my %opt = (@default_opt, @_);
    my $target = delete $opt{&FILELABEL} or die;
    my $file = $opt{file};
    my @files = $opt{glob} ? glob $file : ($file);
    my @r;
    for my $file (@files) {
	open my $fh, $file or die "$file: $!";
	while (my $p = <$fh>) {
	    chomp $p;
	    if ($opt{hash_comment} and !$opt{fixed}) {
		next if $p =~ /^\s*#/;
	    }
	    if ($opt{slash_comment} and !$opt{fixed}) {
		$p =~ s{\s*//.*}{};
	    }
	    next unless $p =~ /\S/;
	    my $re = $opt{fixed} ? qr/\Q$p/ : qr/$p/m;
	    push @r, match_regions pattern => $re;
	}
    }
    merge_regions @r;
}

1;

__DATA__