File Coverage

blib/lib/File/MultilineGrep.pm

Criterion	Covered	Total	%
statement	15	58	25.8
branch	0	30	0.0
condition	0	9	0.0
subroutine	5	7	71.4
pod	1	1	100.0
total	21	105	20.0

package File::MultilineGrep;

use 5.006;
use strict;
use warnings FATAL => 'all';
use English;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(file_multiline_grep);

use Carp;
our $VERSION = '0.01';

my %group_lines  = () ;  # reset %group_lines
my $line;

#-------------------------------------------------#
sub file_multiline_grep
{
   my ($begin_pattern, $finish_pattern, $middle_pattern, $numeration, $file, $separator) = @_ ;

   my $one_separator_flag = 0;
   if ($begin_pattern and ! $finish_pattern)
   {
      $finish_pattern = $begin_pattern;
      $one_separator_flag = 1;
   }

   my $inside_flag  = 0;
   my $match_flag   = 0;
   my $next_line;
   my $FILE;
   if (defined $file) { open ($FILE, "<$file") || die "Error: Can't open file $file: $!"; }
   else { $FILE = *STDIN; }

   MAIN_LOOP: while (1)
   {
      if ($next_line)
      {
         $line = $next_line ;
         $next_line = '';
      }
      else
      {
         $line = <$FILE> ;
         unless ($line)
         {  # found EOF
            $one_separator_flag && $match_flag && &_PrintMatchingGroup($numeration, $match_flag, $separator) ;
            exit 0;
         }
      }

      if ($inside_flag ) { $group_lines{$.} = $line }
      else
      {
         ($line !~ /$begin_pattern/) && next MAIN_LOOP;

         $inside_flag     = 1 ;
         $group_lines{$.} = $line ;
         $line            = $' ;
      }

      # $inside_flag = 1
      if ( (! $match_flag) && ($line =~ /$middle_pattern/) )
      {
         $match_flag = $.
      }

      if ( $line =~ /$finish_pattern/ )
      {
         $next_line       = $' ;
         $match_flag  &&  &_PrintMatchingGroup($numeration, $match_flag, $separator) ;
         $match_flag  = 0 ;
         %group_lines  = () ;  # reset %group_lines

         unless ($one_separator_flag) { $inside_flag  = 0 }
      }
   }  #  end of "MAIN_LOOP: while(1)"
}  #  end of "sub file_multiline_grep"

#-------------------------------------------------#
sub _PrintMatchingGroup
{
   my ($numeration, $match_line_nr, $separator) = @_ ;
   for my $line_nr (sort {$a <=> $b} keys %group_lines)
   {
      if ($numeration)
      {
         if ($line_nr == $match_line_nr) { printf "%3d= ", $line_nr; }
         else                            { printf "%3d: ", $line_nr; }
      }
      print $group_lines{ $line_nr };
   }
   defined $separator && print "$separator\n";
}  #  end of "sub PrintMatchingGroup"

#-------------------------------------------------#
1;

__END__