File Coverage

blib/lib/SpeL/Parser/Auxiliary.pm

Criterion	Covered	Total	%
statement	75	94	79.7
branch	12	18	66.6
condition			n/a
subroutine	10	14	71.4
pod	5	5	100.0
total	102	131	77.8

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


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

use parent 'Exporter';
use Carp;

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

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

      <[line]>+



       (  |  |  | <.otherwise> ) \n

       \\ newlabel  \{ <[args=Arg]>{5} \}

       \\ bibcite

       \\ \@ input

       [^\n]*

       \{  \}
                   |

		   \{    \}

       ([^\{\}]*)

       \\ endinput

  }xms
};

# 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 parseAuxFile {
  my $self = shift;
  my ( $filename ) = @_;

  my $file = IO::File->new();
  $file->open( "<$filename" )
    or croak( "Error: canot open aux file '$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 $contents = join( '', @{$self->{lines}} ) . '\endinput';

  my $result;
  if ( $result = ( $contents ) =~ $SpeL::Parser::Auxiliary::grammar ) {
    $self->{tree} = \%/;
  }
  else {
    $![0] =~ /^(.*)__(\d+),(\d+)__(.*)$/;
    $![0] = $1 . $self->_errloc( $3 ) . $4;
    die( "Error: failed to parse $filename\n" .
         "=> " . join( "\n   ", @! ) . "\n" );
  }
  delete $self->{lines};
  delete $self->{lineinfo};

  # say STDERR Data::Dumper->Dump( [ $self ] , [ qw (doc) ] );
}



sub parseAuxString {
  my $self = shift;
  my ( $string ) = @_;

  $string .= "\n\\endinput";

  my $result;
  if ( $result = ( $string ) =~ $SpeL::Parser::Auxiliary::grammar ) {
    return \%/;
  }
  else {
    $![0] =~ /^(.*)__(\d+),(\d+)__(.*)$/;
    $![0] = $1 . $self->_errloc( $3 ) . $4;
    die( "Error: failed to parse string\n" .
	 "=> " . join( "\n   ", @! ) . "\n" );
  }
}


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


sub database {
  my $self = shift;
  my $db = { bibcite => {},
	     newlabel => {} };
  for my $line ( @{$self->{tree}->{line}} ) {
    if ( ref( $line ) eq 'HASH' ) {
      foreach my $key ( (keys %$line)[0] ) {
	$key =~ /bibcite/ and do {
	  $db->{$key}->{$line->{$key}->{label}} = $line->{$key}->{text};
	  last;
	};
	$key =~ /newlabel/ and do {
	  # if the caption text field of the label contains curly brackets,
	  # the field will be the hash of the Regexp::Grammars parser and
	  # we need to replace it by its context field:
	  if ( ref( $line->{$key}->{args}->[2] )  eq 'HASH' ) {
	    $line->{$key}->{args}->[2] = $line->{$key}->{args}->[2]->{''};
	    # remove the opening and closing curly brace
	    $line->{$key}->{args}->[2] =~ s/^\{(.*)\}$/$1/;
	  }
	  $db->{$key}->{$line->{$key}->{label}} = $line->{$key}->{args};
	  last;
	};
	$key =~ /input/ and do {
	  my $auxparser = SpeL::Parser::Auxiliary->new();
	  $auxparser->parseAuxFile( $line->{$key}->{file} );
	  $db =
	    {
	     bibcite  => { %{$db->{bibcite}}, %{$auxparser->database()->{bibcite}} },
	     newlabel => { %{$db->{newlabel}}, %{$auxparser->database()->{newlabel}} },
	    };
	  last;
	};
      }
    }
  }
  return $db;
}


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


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

1;

__END__