File Coverage

blib/lib/Parse/Lex.pm

Criterion	Covered	Total	%
statement	13	13	100.0
branch	2	2	100.0
condition			n/a
subroutine	5	5	100.0
pod	0	1	0.0
total	20	21	95.2

require 5.004;
use strict qw(vars);
use strict qw(refs);
use strict qw(subs);

package Parse::Lex;
use Parse::ALex;
$Parse::Lex::VERSION = '2.21';
@Parse::Lex::ISA = qw(Parse::Tokenizer);

my $lexer = __PACKAGE__->clone;
sub prototype { $lexer or __PACKAGE__->SUPER::prototype }

####################################################################
#Structure of the next routine:
#  HEADER_STRING | HEADER_STREAM
#  TOKEN+
#  FOOTER

# %%...%% are processed by the Parse::Template class
# In %%%% $template and $self are the same Parse::Template instance
# RegExp must be delimited by // or m!!

my %TEMPLATE = ();

$TEMPLATE{'WITH_SKIP_PART'} =  q@
   if ($LEX_POS < $LEX_LENGTH and $LEX_BUFFER =~ /\G(?:%%$SKIP%%)/cg) {
     $textLength = pos($LEX_BUFFER) - $LEX_POS; # length $&
     $LEX_OFFSET += $textLength;
     $LEX_POS += $textLength;
     %% $IS_HOLD ? HOLD_SKIP_PART(): ''%%
   }
@;
$TEMPLATE{'WITH_SKIP_LAST_READ_PART'} =  q@
		if ($LEX_BUFFER =~ /\G(?:%%$SKIP%%)/cg) { # skip this pattern
		  $textLength = pos($LEX_BUFFER) - $LEX_POS; # length $&
		  $LEX_OFFSET += $textLength;
		  $LEX_POS += $textLength;
                  %% $IS_HOLD ? HOLD_SKIP_PART(): ''%%
		} else {
		  last READ;
		}
@;
$TEMPLATE{'HOLD_SKIP_PART'} =  q@$self->[%%$HOLD_TEXT%%] .= $1;@;
$TEMPLATE{'HEADER_STRING_PART'} =  q@
  {
   pos($LEX_BUFFER) = $LEX_POS;
   my $textLength = 0;
   #
   %% $SKIP ne '' ? WITH_SKIP_PART() : '' %%
   if ($LEX_POS == $LEX_LENGTH) {
     $self->[%%$EOI%%] = 1;
     $LEX_TOKEN = $Parse::Token::EOI;
     return $Parse::Token::EOI;
   }
   $LEX_TOKEN = undef;
   my $content = '';
   #
 CASE:{
@;
$TEMPLATE{'HEADER_STREAM_PART'} =  q@
  {
   pos($LEX_BUFFER) = $LEX_POS;
   my $textLength = 0;
   my $LEX_FH = $$LEX_FHR;
   #
   %% $SKIP ne '' ? WITH_SKIP_PART() : '' %%
   if ($LEX_POS == $LEX_LENGTH) {
     if ($self->[%%$EOI%%]) # if EOI
       {
         $LEX_TOKEN = $Parse::Token::EOI;
         return $Parse::Token::EOI;
       }
     else
       {
	READ:{
	    do {
	      $LEX_BUFFER = <$LEX_FH>;
	      if (defined($LEX_BUFFER)) {
		pos($LEX_BUFFER) = $LEX_POS = 0;
		$LEX_LENGTH = CORE::length($LEX_BUFFER);
		$LEX_RECORD++;
		%%$SKIP ne '' ? WITH_SKIP_LAST_READ_PART() : '' %%
	      } else {
		$self->[%%$EOI%%] = 1;
		$LEX_TOKEN = $Parse::Token::EOI;
		return $Parse::Token::EOI;
	      }
	    } while ($LEX_POS == $LEX_LENGTH);
	  }# READ
      }
   }
   my $content = '';
   $LEX_TOKEN = undef;
   #
 CASE:{
@;
$TEMPLATE{'HOLD_TOKEN_PART'} = q@$self->[%%$HOLD_TEXT%%] .= $content;@;
$TEMPLATE{'FOOTER_PART'} = q!
  }#CASE
  %%$IS_HOLD ? HOLD_TOKEN_PART() : ''%%
  $self->[%%$PENDING_TOKEN%%] = $LEX_TOKEN;
  $LEX_TOKEN;
}
!;
$lexer->template(Parse::Template->new(%TEMPLATE)); # code template

1;
__END__