File Coverage

blib/lib/App/Greple/xp.pm

Criterion	Covered	Total	%
statement	42	45	93.3
branch	12	16	75.0
condition	4	6	66.6
subroutine	9	10	90.0
pod	0	2	0.0
total	67	79	84.8

=head1 NAME

App::Greple::xp - extended pattern module

=head1 VERSION

Version 1.01

=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

You can insert comment lines in pattern file.  As for fixed string
file, there is no way to write 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 MULTILINE REGEX

Complex pattern can be written on multiple lines as follows.

    (?xxn) \
    ( (?\[) | \@ )   # start with "[" or @             \
    (? [ \d : , ]+)  # sequence of digit, ":", or ","  \
    (?() \] | )      # closing "]" if start with "["   \
    $                   # EOL

=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-2025 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 = "1.01";

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: $!";
	my @p = map s/\\(?=\R)//gr, split /(? };
	for my $p (@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;
}

sub block_match {
    my $grep = shift;
    $grep->{RESULT} = [
	[ [ 0, length ],
	  map {
	      [ $_->[0][0], $_->[0][1], 0, $grep->{callback}->[0] ]
	  } $grep->result
      ] ];
}

1;

__DATA__