File Coverage

blib/lib/SpeL/Parser/Chunk.pm

Criterion	Covered	Total	%
statement	104	147	70.7
branch	16	32	50.0
condition	2	6	33.3
subroutine	14	16	87.5
pod	4	4	100.0
total	140	205	68.2

# -*- cperl -*-
# ABSTRACT: LaTeX file parser


use strict;
use warnings;
package SpeL::Parser::Chunk;

use parent 'Exporter';
use Carp;

use IO::File;
use File::Basename;

use SpeL::Object::Document;
use SpeL::Object::ElementList;
#use Data::Dumper;

our $prepmacrolist = [];
our $prepenvlist = [];

our $gobblematcher = qr/verbatim|listing/i;

our $elements = do {
  use Regexp::Grammars;
  qr{
#





#


      #                           & not \&   \,\quad\qquad  whitespace   comment
      #                   (?: (?

                (?: \\, | \\quad | \\qquad | ~ | \\\s | [\s\n] | (\%[^\n]*\n) )* |
                \\hskip \s* (:?\d+)?(?:\.\d+)? \s*  |
		\\relax


                pt | mm | cm | in | ex | em | mu | sp


                <[Element]>*



                (?:  |
                      |
                      |
		     |
		     |
		     |
                     |
                     |
                     |
                     |
                     |
                     |
                     |
                     |
                     |
                     |
                     |
		    \|  \| |
		     )




                (?:  |
                      |
                      |
                     |
                     |
                     |
                     |
                     )



                 |
                 # never triggerd,
		                   # had to hide this in Relation



                <[RelationChain]>* |
                 <[RelationChain]>*


                 ?



                = |
                \\approx |
                \\equiv |
                \\ne\b |
                \> |
		\< |
                \\gt\b |
		\\gg\b |
                \\lt\b |
		\\ll\b |
                \\ge\b |
                \\le\b |
	        \\in\b |
		\\[Ll]eftarrow |
		\\[Rr]ightarrow |
		\\[Ll]eftrightarrow |
		\\[Ll]ongleftarrow |
		\\[Rr]ongrightarrow |
		\\[Ll]ongleftrightarrow |
		\\[Uu]parrow |
		\\[Dd]ownarrow |
		\\[Uu]pdownarrow |
		\\(?:long)?mapsto |
		\\(?:leads)?to |
		(?




                (  ? |
		    |
		     |
		    |
		    |
		    |
		  ?   |
		  ?   |
		  ?   |
		  ?   |
		  ?   |
		  ?   |
		   |
		    |
		    |
		    |
		    |
		    |
		  ?   )


                     |
                     |
                     |
		     |
		     |



                     |
                     |



                \\left <.ws> (?:\(|\[|\\\{|\||\\\|) |
                \\left <.ws> \.


                (?:\\right) <.ws> (?:\)|\]|\\\}|\||\\\|) |
                \\right <.ws> \.


                \\frac \{ (?:  |  ) \}
                       \{ (?:  |  ) \}


                 |
                  |
                  |
		  |
		  |
                  |
		  |
                ?


		 <.ws> \{ <.ws>  <.ws> \} |
                  |
                  |



                  |
                  |



                 \{  \} |



                 |
                 |
                 |
                 |
                 |
                 |
		 |
		 |
		 |
		 |



                \\ num <.ws> \{  \}


                \\ qty <.ws> \{  \} <.ws>


                \\ unit <.ws>


                (?
	          \{
		    (?: (?> [^{}]+ ) | (?&braceunit))*
		  \}
	        )


                 |
                 |



		\!


                \\sqrt <.ws> \[  \] <.ws> \{  \} |
                \\sqrt <.ws> \{  \}



                \\ ( (?!\\)(?!end)(?!begin)(?!par)(?!item)(?!left)(?!right)(?!hskip)  ) ? <[Args]>*



                \\  <[Args]>*  |

                \\ ( (?!\\)(?!end)(?!begin)(?!par)(?!item)(?!left)(?!right)(?!hskip)(?!underbrace)(?!overbrace)  ) ? <[Args=Mathargs]>*



		\\  <[Args]>



                \\ begin <.ws> \{  \}

                \\ end <.ws> \{ <.everbatimtag( :verbatimtag )> \}


                 \\ begin <.ws> \{  \} ? <[Args]>*
                   <.ws>
                \\ end <.ws> \{ <.etag( :tag )> \}
                |
                 \\ begin <.ws> \{  \} ? <[Args]>*
                   <.ws>



                \\\[

                \\\]


                \\ begin <.ws> \{  \} ? ? <[Args]>*
		<[MathUnit]>+ % <.eol> <.ws>
                \\ end <.ws> \{ <.mathetag( :mathtag )> \}
                |
                \\ begin <.ws> \{  \} ? ? <[Args]>*
                  <[MathUnit]>+ % <.eol> <.ws>



                \\ begin <.ws> \{  \} ? <[Args]>*
                  <[MathUnit]>+ % <.eol> <.ws>
                \\ end <.ws> \{ <.mathetaginner( :mathtaginner )> \}
                |
                \\ begin <.ws> \{  \} ? <[Args]>*
                  <[MathUnit]>+ % <.eol> <.ws>



                \\ begin <.ws> \{  \} ? <[Args]>*
                  <[MathUnit]>+ % <.eol> <.ws>
                \\ end <.ws> \{ <.matrixetag( :matrixtag )> \}
                |
                \\ begin <.ws> \{  \} ? <[Args]>*
                  <[MathUnit]>+ % <.eol> <.ws>




                \{  \}


                \{  \}


                [\$]  [\$] \s* |
                \\[\(]  \\[\)] \s*


                \\ item ? <[Args]>* (  <[Element]> )*

                 ,

             ;

            ,


          \\ begin <.ws> \{ <\:env> \}

            \\ end <.ws> \{ <\:env> \}

               \{

               \}

               =

            \\ transpose

           \\ end \{

           \\ begin <.ws> \{  \}

                  [^][\$&%#_{}~^\s]++



          array\*? | aligned\*?

         (??{quotemeta $ARG{mathtaginner}})

             (?:[bBpvV]|small)?matrix\*?

            (??{quotemeta $ARG{matrixtag}})

               equation\*? | eqnarray\*? | alignat\*? | align\*? | gather\*?

              (??{quotemeta $ARG{mathtag}})

            \\\{ | \\\} | \\\[ | \\\]

                  \^

                  \_

                  \&

           \\,

                  \\\\(?:\[[^]]+\])?

                 (??{quotemeta $ARG{tag}})

         (??{quotemeta $ARG{verbatimtag}})

               <.ws> \[ <[MATCH=Option]>+ % (,) \]

                  <.ws> \{  \}

                  <.ws> \{  \}


                ( =)? ?

                  [^][|\$%#_{}~^,=\s\\-]++

                  [a-zA-Z@]++\*?

             [#]+ \d+


                 <.sub>  <.sup>  |
                 <.sup>  <.sub>  |
                 <.sup>  |
                 <.sub>  |



                 |
                 |
                 |
                 |



                \\ int |
                \\ sum |
                \\ lim |
		\\ max |
		\\ min


                [^][|\$%&#_{}^\\]++


                ( (?: [^\$%&#_{}|^\\] |
		    \\ \& |
		    \\ \" |
		    \\ \, |
		    \\ \' |
		    \\ \` |
		    \\ \{ |
                    \\ \} |
		    \\ \$ |
		    \\ %  |
		    \\ _  )+ )



                 |
                 ? <.ws>  |
                 ? (? |
		 ? <.ws>  |
                 ? (? |
                 ? <.ws>



                \\
                    arcsin | asin | arccos | acos | arctan | atan | arccot | acot |
                    sinh | cosh | tanh | coth)>


                \\  (?: <.sub> )?


                \\ underbrace


                \\ overbrace


                (  |  ) ?


                [a-zA-Z]


 		\\(?:mit|mup)?[aA]lpha |
		\\(?:mit|mup)?[bB]eta |
		\\(?:mit|mup)?[gG]amma |
		\\(?:mit|mup)?[dD]elta |
                \\(?:mit|mup)?(?:var)?epsilon |
                \\(?:mit|mup)?[zZ]eta |
                \\(?:mit|mup)?[eE]ta |
                \\(?:mit|mup)?[tT]heta |
                \\(?:mit|mup)?vartheta |
                \\(?:mit|mup)?iota |
                \\(?:mit|mup)?[kK]appa
                \\(?:mit|mup)?[lL]ambda |
                \\(?:mit|mup)?[mM]u |
                \\(?:mit|mup)?[nN]u |
                \\(?:mit|mup)?[xX]i |
                \\(?:mit|mup)?[pP]i |
                \\(?:var)?rho |
                \\(?:mit|mup)?[sS]igma |
                \\(?:mit|mup)?[tT]au |
                \\(?:mit|mup)?[uU]psilon |
                \\(?:mit|mup)?[pP]hi |
                \\(?:mit|mup)?varphi |
                \\(?:mit|mup)?[cC]hi |
                \\(?:mit|mup)?[pP]si |
                \\(?:mit|mup)?[oO]mega


                ([+-]) |
                \\pm


                 ? |


        j | i






		                 | ((?:\.|,)\d+)
                                 | \\ pi ({})?
                                 | \\ infty ({})? )>


                 (?:
                         		  | ((?:\.|,)\d+) )> )?
		               (?: [eE] )?


                \w | \\_

       .*?

  }xs
};


our $chunk = do {
  use Regexp::Grammars;
  qr{
      #
#

       <.ws>?








             \\ endinput
  }xs
};

# to debug:
#
#



sub new {
  my $class = shift;

  my $self = {};
  $class = (ref $class ? ref $class : $class );
  bless $self, $class;

  $self->{lines} = [];
  $self->{lineinfo} = [];
  return $self;
}


sub parseDocumentString {
  my $self = shift;
  my ( $document, $filename, $debug ) = @_;

  # preprocess macros and environments that are in the list
  # say STDERR "Before cleansing:\n" . $document;
  # Final prep to accomdate for docstrip '{Change History}'

  $debug = 0 unless( defined( $debug ) );

  if ( $debug ) {
    say STDERR "=== Original ======================================================";
    say STDERR $document;
  }

  foreach my $entry (@$prepmacrolist) {
    my $mac_regexp = qr/ ( \\ $entry->{macro} ) /x;
    my $optarg_regexp = qr/ (
			      \[
			      [^]]*
			      \]
			    )? /x;
    my $mandarg_regexp = qr/ (?
			     \{
			       (?:
				 (?> [^{}]+ )
			       |
				 (?&braceunit)
			       )*
			     \}
			   )
			 /x;

    my $regexp = $mac_regexp;
    my $i = 1;
    my $optargcount = 0;
    if ( $entry->{argc}
	 ne '-NoValue-'
	 and
	 $entry->{argc} > 0 ) {
      if ( $entry->{optarg} ne '-NoValue-' ) {
	$regexp .= qr/ \s* /x . $optarg_regexp;
	$optargcount = 1;
	++$i;
      }
      for( ; $i <= $entry->{argc}; ++$i ) {
	$regexp .= qr/ \s* /x . $mandarg_regexp;
      }
    }

    while( 1 ) {
      my @matches = $document =~ /$regexp/;
      last unless( scalar @matches );

      my $replacement = $entry->{replacement};
      my $m = 1;
      foreach( $m = 1; $m < @matches; ++$m ) {
	if ( defined $matches[$m] ) {
	  my $r = $matches[$m];
	  $r = substr( $r, 1, length( $r ) -2 );
	  $replacement =~ s/##$m/$r/;
	}
	else {
	  # this only occurs for $m = 1, i.e. when the optional
	  # argument was not specified in the text, therefore,
	  # we replace it by the default
	  $replacement =~ s/##$m/$entry->{optarg}/;
	}
      }
      $document =~ s/$regexp/$replacement/;
    }
    #     $document =~ s/$arr->[0]/$2/g;
    #   }
    #   else {
    #     $document =~ s/$arr->[0]//g;
    #   }
  }


  foreach my $entry (@$prepenvlist) {

    my $envbegin_regexp  = qr/ \\ begin \{ $entry->{env} \} /x;
    my $envend_regexp  = qr/ \\ end \{ $entry->{env} \} /x;
    my $optarg_regexp = qr/ (
			      \[
			      [^]]*
			      \]
			    )?
			  /x;
    my $mandarg_regexp = qr/ (?
			      \{
			      (?:
				(?> [^{}]+ )
			      |
				(?&braceunit)
			      )*
			      \}
			    )
			  /x;
    my $envcontent_regexp = qr/ ( .* ) /sx;

    my $regexp = $envbegin_regexp;
    my $i = 1;
    my $optargcount = 0;
    if ( $entry->{argc}
	 ne '-NoValue-'
	 and
	 $entry->{argc} > 0 ) {
      if ( $entry->{optarg} ne '-NoValue-' ) {
	$regexp .= qr/ \s* /x . $optarg_regexp;
	$optargcount = 1;
	++$i;
      }
      for( ; $i <= $entry->{argc}; ++$i ) {
	$regexp .= qr/ \s* /x . $mandarg_regexp;
      }
    }
    $regexp .= $envcontent_regexp;
    $regexp .= $envend_regexp;

    while( 1 ) {
      my @matches = $document =~ /$regexp/;
      last unless( scalar @matches );

      my $replacement = $entry->{replacement};
      my $m = 1;
      foreach( $m = 1; $m < @matches; ++$m ) {
	if ( defined $matches[$m] ) {
	  my $r = $matches[$m];
	  $r = substr( $r, 1, length( $r ) -2 );
	  $replacement =~ s/##$m/$r/;
	}
	else {
	  # this only occurs for $m = 1, i.e. when the optional
	  # argument was not specified in the text, therefore,
	  # we replace it by the default
	  $replacement =~ s/##$m/$entry->{optarg}/;
	}
      }
      $document =~ s/$regexp/$replacement/;
    }
  }
  if ( $debug ) {
    say STDERR "=== Prepped  ======================================================";
    say STDERR $document;
  }


  # Parse the document
  my $doc = SpeL::Object::Document->new();
  $doc->{ElementList} = SpeL::Object::ElementList->new();
  $doc->{ElementList}->{Element} = [];

  my $result;
  if ( $result = ( $document . "\n\\endinput" ) =~ $SpeL::Parser::Chunk::chunk ) {
    if( exists $/{Document}->{ElementList}->{Element} ) {
      push @{$doc->{ElementList}->{Element}},
	@{$/{Document}->{ElementList}->{Element}};
    }
  }
  else {
    $![0] =~ /^(.*)__(\d+),(\d+)__(.*)$/;
    $![0] = $1 . $self->_errloc( $3 ) . $4;
    die( "Error: failed to parse $filename\n" .
	 "=> " . join( "\n   ", @! ) . "\n" );
  }

  if ( $debug ) {
    say STDERR "=== Parsed   ======================================================";
    say STDERR Data::Dumper->Dump( [ $doc ], [ 'tree' ] );
  }

  return $doc;
}



sub parseDocument {
  my $self = shift;
  my ( $filename, $debug ) = @_;

  $self->{path} = dirname( $filename );

  my $file = IO::File->new();
  $file->open( "<$filename" )
    or croak( "Error: canot open '$filename' for reading\n" );
  @{$self->{lines}} = <$file>;

  # setup lineposition bookkeeping
  my $firstlineindex = 0;
  @{$self->{lineinfo}} =
    map{ my $retval = $firstlineindex;
         $firstlineindex += length( $_ );
         $retval
       } @{$self->{lines}};
  push @{$self->{lineinfo}}, $self->{lineinfo}->[-1] + 1;

  # parse
  my $document = join( '', @{$self->{lines}} );
  $document =~ s/^\{(.*)\}$/$1/s; # solve docstrip's problem of {Change History}
  $self->{tree} = $self->parseDocumentString( $document, $filename, $debug );

  delete $self->{lines};
  delete $self->{lineinfo};
}


sub object {
  my $self = shift;
  return $self;
}


sub _report {
  my ( $match ) = @_;
  return "__$match->{matchpos},$match->{matchline}__";
}


sub _errloc {
  my $self = shift;
  my ( $matchline ) = @_;
  return "line $matchline";
}


1;

__END__