<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright (C) 1998-09  Stephane Galland &lt;galland@arakhne.org&gt;
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

=pod

=head1 NAME

Bib2HTML::Parser::BibScanner - A scanner for extracted bibtex entries

=head1 SYNOPSYS

use Bib2HTML::Parser::BibScanner ;

my $scan = Bib2HTML::Parser::BibScanner-&gt;new() ;

=head1 DESCRIPTION

Bib2HTML::Parser::BibScanner is a Perl module, which scannes
a source file to recognize the bibtex entries

=head1 GETTING STARTED

=head2 Initialization

To start a scanner, say something like this:

    use Bib2HTML::Parser::BibScanner;

    my $scan = Bib2HTML::Parser::BibScanner-&gt;new() ;

...or something similar.

=head1 METHOD DESCRIPTIONS

This section contains only the methods in BibScanner.pm itself.

=over

=cut

package Bib2HTML::Parser::BibScanner;

@ISA = ('Bib2HTML::Parser::Scanner');
@EXPORT = qw();
@EXPORT_OK = qw();

use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
use Exporter;
use Carp ;
use File::Basename ;

use Bib2HTML::Parser::Scanner ;
use Bib2HTML::General::Misc ;

#------------------------------------------------------
#
# Global vars
#
#------------------------------------------------------

# Version number of the scanner
my $VERSION = "2.0" ;

#------------------------------------------------------
#
# Constructor
#
#------------------------------------------------------

sub new() : method {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $parent = ref($proto) &amp;&amp; $proto ;

  my $self ;
  if ( $parent ) {
    %{$self} = %{$parent} ;
  }
  else {
    if ( $_[0] ) {
      if ( ! $_[1] ) {
	Bib2HTML::General::Error::syserr( "You must supply the initial state to the ".
					   "BibScanner constructor" ) ;
      }
      if ( ! $_[2] ) {
	Bib2HTML::General::Error::syserr( "You must supply the final states to the ".
					  "BibScanner constructor" ) ;
      }
      $self = $class-&gt;SUPER::new( $_[0], $_[1], $_[2] ) ;
    }
    else {
      $self = $class-&gt;SUPER::new(
              { 'main' =&gt; [ { state =&gt; 'line_comment',
			      pattern =&gt; '\\%',
			      merge =&gt; 1,
			      splitmerging =&gt; 1,
			    },
			    { state =&gt; 'block_comment',
			      pattern =&gt; '\\@COMMENT\\s*\\{\\s*',
			      caseinsensitive =&gt; 1,
			    },
			    { state =&gt; 'line_comment',
			      pattern =&gt; '\\@COMMENT\b\\s*',
			      merge =&gt; 1,
			      splitmerging =&gt; 1,
			      caseinsensitive =&gt; 1,
			    },
			    { state =&gt; 'constant',
			      pattern =&gt; '\\@STRING\\s*\\{\\s*',
			      caseinsensitive =&gt; 1,
			    },
                            { state =&gt; 'preamble',
			      pattern =&gt; '\\@PREAMBLE\\s*',
			      caseinsensitive =&gt; 1,
			    },
			    { state =&gt; 'entry',
			      pattern =&gt; '@',
			      merge =&gt; 1,
			    },
                            { state =&gt; 'main',
			      pattern =&gt; '[^@%]+',
			    },
			  ],
		# Eats the comment
	        'line_comment' =&gt; [ { state =&gt; 'main',
				      pattern =&gt; "\n",
				    },
				    { state =&gt; 'line_comment',
				      pattern =&gt; "[^\n]+",
				      merge =&gt; 1,
				    },
				  ],
	        'block_comment' =&gt; [ { state =&gt; 'main',
				       pattern =&gt; "\\}",
			               splitmerging =&gt; 1,
				       merge =&gt; 1,
				     },
				     { state =&gt; 'block_comment',
				       pattern =&gt; "[^\\}]+",
				       merge =&gt; 1,
				     },
				   ],
		# Matches @something
		'entry' =&gt; [ { state =&gt; 'entry_type',
			       pattern =&gt; '[a-zA-Z]+',
			     },
			   ],
		'entry_type' =&gt; [ { state =&gt; 'entry_key',
				    pattern =&gt; "\\{\\s*",
				  },
				  { state =&gt; 'entry_type',
				    pattern =&gt; "\\s+",
				  },
			   ],
		'entry_key' =&gt; [ { state =&gt; 'entry_fields',
				   pattern =&gt; '[^,\s]+',
				 },
				 { state =&gt; 'entry_key',
				   pattern =&gt; '\\s+',
				 },
			   ],
		'entry_fields' =&gt; [ { state =&gt; 'entry_fields',
				      pattern =&gt; ',\\s*',
				    },
				    { state =&gt; 'entry_fields',
				      pattern =&gt; '\\s+',
				    },
				    { state =&gt; 'entry_fieldname',
				      pattern =&gt; '[a-zA-Z0-9.:_\\-]+',
				    },
				    { state =&gt; 'main',
				      pattern =&gt; '\\s*\\}',
				    },
				  ],
		'entry_fieldname' =&gt; [ { state =&gt; 'string',
					 pattern =&gt; '\\s*=\\s*',
				       },
				       { state =&gt; 'main',
					 pattern =&gt; '\\}',
				       },
				       { state =&gt; 'entry_fieldname',
					 pattern =&gt; '\\s+',
				       },
				       { state =&gt; 'entry_fields',
					 pattern =&gt; '.',
				       },
				     ],
		# Matches @STRING
		'constant' =&gt; [ { state =&gt; 'main',
				  pattern =&gt; '\\}',
				},
				{ state =&gt; 'constant_name',
				  pattern =&gt; '[a-zA-Z0-9.:]+',
				},
				{ state =&gt; 'constant',
				  pattern =&gt; '\\s+',
				},
			      ],
		'constant_name' =&gt; [ { state =&gt; 'string',
				       pattern =&gt; '=\\s*',
				     },
				     { state =&gt; 'main',
				       pattern =&gt; '\\}',
				     },
				     { state =&gt; 'constant_name',
				       pattern =&gt; '\\s+',
				     },
				   ],
		# Matches @PREAMBLE
		'preamble' =&gt; [ { state =&gt; 'braced_string',
				  pattern =&gt; '\\{',
				  merge =&gt; 1,
				  splitmerging =&gt; 1,
				},
				{ state =&gt; 'preamble',
				  pattern =&gt; '\\s+',
				},
			      ],
		'preamble_end' =&gt; [ { state =&gt; 'main',
				      pattern =&gt; '.',
				    },
				  ],
		# Matches a string
		'string' =&gt; [ { state =&gt; 'string',
				pattern =&gt; '\\s+',
			      },
			      { state =&gt; 'braced_string',
				pattern =&gt; '{',
				merge =&gt; 1,
				splitmerging =&gt; 1,
			      },
			      { state =&gt; 'quoted_string',
				pattern =&gt; '\"',
				merge =&gt; 1,
				splitmerging =&gt; 1,
			      },
			      { state =&gt; 'keyword_string',
				pattern =&gt; '[^\\s"{},;#]+',
			      }
			    ],
		'keyword_string' =&gt; [],
		# Matches a braced string
		'braced_string' =&gt; [ { state =&gt; 'close_braced_string',
				       pattern =&gt; '}',
				     },
				     { state =&gt; 'open_braced_string',
				       pattern =&gt; '{',
				     },
				     { state =&gt; 'braced_string',
				       pattern =&gt; '\\\\.',
				       merge =&gt; 1,
				     },
				     { state =&gt; 'braced_string',
				       pattern =&gt; '[^{}\\\\]+',
				       merge =&gt; 1,
				     }
				   ],
		'close_braced_string' =&gt; [],
		'open_braced_string' =&gt; [],
		# Matches a quoted string
		'quoted_string' =&gt; [ { state =&gt; 'quote_quoted_string',
				       pattern =&gt; '\"',
				     },
				     { state =&gt; 'quoted_string',
				       pattern =&gt; '\\\\.',
				       merge =&gt; 1,
				     },
				     { state =&gt; 'quoted_string',
				       pattern =&gt; '[^\"\\\\]+',
				       merge =&gt; 1,
				     }
				   ],
		'quote_quoted_string' =&gt; [],
		# Concatenation operator
		'concatenation_operator' =&gt; [ { state =&gt; 'string',
						pattern =&gt; '\\s*\\#\\s*',
					      },
					      { state=&gt; 'concatenation_operator',
						pattern =&gt; '[^#]',
					      },
					    ],
	      },
	      'main',
	      [ 'main', 'line_comment' ]
              ) ;
    }
    # Initializes the class attributes
    $self-&gt;clearentries() ;
  }
  bless( $self, $class );
  return $self;
}

#------------------------------------------------------
#
# Callback functions
#
#------------------------------------------------------

sub transition_callback_concatenation_operator_concatenation_operator($) {
  my $self = shift ;
  $self-&gt;ungetpattern( $_[0] ) ;
  $self-&gt;pop_state() ;
}

sub transition_callback_concatenation_operator_string($) {
  my $self = shift ;
  $self-&gt;translate_to_contatenatedstring() ;
}

sub transition_callback_string_keyword_string($) {
  my $self = shift ;
  $self-&gt;setstring($_[0],1) ;
  $self-&gt;pop_state() ;
}

sub transition_callback_braced_string_close_braced_string($) {
  my $self = shift ;
  $self-&gt;setstring($_[0]) ;
  if ( $self-&gt;{'BUFFER'}{'BRACE_COUNT'} &gt; 0 ) {
    $self-&gt;{'BUFFER'}{'BRACE_COUNT'} -- ;
    $self-&gt;set_state('braced_string');
  }
  else {
    $self-&gt;pop_state() ;
  }
}

sub transition_callback_braced_string_open_braced_string($) {
  my $self = shift ;
  $self-&gt;{'BUFFER'}{'BRACE_COUNT'} ++ ;
  $self-&gt;setstring($_[0]) ;
  $self-&gt;set_state('braced_string');
}

sub transition_callback_string_braced_string($) {
  my $self = shift ;
  $self-&gt;{'BUFFER'}{'BRACE_COUNT'} = 0 ;
}

sub transition_callback_quoted_string_quote_quoted_string($) {
  my $self = shift ;
  $self-&gt;setstring($_[0]) ;
  $self-&gt;pop_state('braced_string') ;
}

sub state_callback_string($$) {
  my $self = shift ;
  if ( ( $_[1] !~ /string/ ) &amp;&amp;
       ( $_[1] ne 'concatenation_operator' ) ) {
    $self-&gt;clearstring() ;
    $self-&gt;push_state($_[1]) ;
  }
  $self-&gt;push_state('concatenation_operator') ;
}

sub transition_callback_entry_fields_main($) {
  my $self = shift ;
  $self-&gt;addentry( $self-&gt;{'BUFFER'}{'currententry'}{'key'},
                   $self-&gt;{'BUFFER'}{'currententry'}{'type'},
                   $self-&gt;{'BUFFER'}{'currententry'}{'fields'},
		   $self-&gt;{'BUFFER'}{'currententry'}{'lineno'} ) ;
  delete( $self-&gt;{'BUFFER'}{'currententry'} ) ;
}

sub transition_callback_entry_fieldname_main($) {
  my $self = shift ;
  my $field = $self-&gt;{'BUFFER'}{'currentfield'} ;
  $self-&gt;{'BUFFER'}{'currententry'}{'fields'}{$field} = $self-&gt;clearstring() ;
  $self-&gt;transition_callback_entry_fields_main(undef) ;
}

sub transition_callback_entry_fieldname_entry_fields($) {
  my $self = shift ;
  my $field = $self-&gt;{'BUFFER'}{'currentfield'} ;
  $self-&gt;{'BUFFER'}{'currententry'}{'fields'}{$field} = $self-&gt;clearstring() ;
}

sub transition_callback_entry_fields_entry_fieldname($) {
  my $self = shift ;
  $self-&gt;{'BUFFER'}{'currentfield'} = $_[0] || '' ;
}

sub transition_callback_entry_key_entry_fields($) {
  my $self = shift ;
  $self-&gt;{'BUFFER'}{'currententry'}{'key'} = $_[0] || '' ;
}

sub transition_callback_entry_entry_type($) {
  my $self = shift ;
  my $type = $_[0] || '' ;
  $type =~ s/^\s*\@// ;
  $self-&gt;{'BUFFER'}{'currententry'} = { 'type' =&gt; lc($type),
					'lineno' =&gt; $self-&gt;{'LINENO'},
				      } ;
}

sub transition_callback_preamble_braced_string($) {
  my $self = shift ;
  $self-&gt;{'BUFFER'}{'BRACE_COUNT'} = 0 ;
  $self-&gt;push_state('preamble_end');
}

sub transition_callback_preamble_end_main($) {
  my $self = shift ;
  $self-&gt;addpreamble( $self-&gt;clearstring(), $self-&gt;{'LINENO'} ) ;
  $self-&gt;ungetpattern($_[0]);
}

sub transition_callback_constant_constant_name($) {
  my $self = shift ;
  $self-&gt;{'BUFFER'}{'constant'}{'name'} = $_[0] || '' ;
  $self-&gt;{'BUFFER'}{'constant'}{'lineno'} = $self-&gt;{'LINENO'} ;
}

sub transition_callback_constant_name_main($) {
  my $self = shift ;
  $self-&gt;addconstant( $self-&gt;{'BUFFER'}{'constant'}{'name'},
                      $self-&gt;clearstring(),
		      $self-&gt;{'BUFFER'}{'constant'}{'lineno'} ) ;
}

sub transition_callback_block_comment_main($) {
  my $self = shift ;
  $self-&gt;addcomment("$_[0]");
}

#------------------------------------------------------
#
# Scanning API
#
#------------------------------------------------------

=pod

=item * scanentries()

Replies an array that contains the bibtex
parts readed from the source file.
Takes 1 arg:

=over

=item * filename (string)

is the name of the file from which the bibtex parts must
be extracted.

=back

=cut
sub scanentries($) : method {
  my $self = shift ;
  my $filename = $_[0] || confess( 'you must supply the filename' ) ;
  $self-&gt;clearentries() ;
  $self-&gt;clearstring() ;

  if ( ! $self-&gt;scan( $filename ) ) {
    Bib2HTML::General::Error::err( "Unexpected end of file (state: ".$self-&gt;{'SM_CURRENT_STATE'}.")",
				   $filename,
				   $self-&gt;{'LINENO'} ) ;
  }

  Bib2HTML::General::Verbose::three( join( '',
					   "\t",
					   hashcount($self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'}),
					   " entr",
					   (hashcount($self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'})&gt;1)?"ies":"y" ) ) ;

  return $self-&gt;getentries() ;
}

#------------------------------------------------------
#
# Block functions
#
#------------------------------------------------------

=pod

=item * clearentries()

Destroyes all recognized blocks.

=cut
sub clearentries() {
  my $self = shift ;
  $self-&gt;{'BIBSCANNER_ENTRIES'} = { 'constants' =&gt; {},
				    'comments' =&gt; [],
				    'preambles' =&gt; [],
				    'entries' =&gt; {},
				  } ;
}

=pod

=item * getentries()

Replies the readed entries

=cut
sub getentries() {
  my $self = shift ;
  return $self-&gt;{'BIBSCANNER_ENTRIES'} ;
}

=pod

=item * addconstant()

Adds a constant inside the readed data.
Takes 3 args:

=over

=item * name (string)

is the name of the constant

=item * value (string)

is the value of the constant

=item * lineno (integer)

is the line number where the constant starts

=back

=cut
sub addconstant($$$) {
  my $self = shift ;
  my $name = $_[0] || '' ;
  my $lineno = $_[2] || 0 ;
  my $lcname = lc( $name ) ;
  if ( ! $lcname ) {
    Bib2HTML::General::Error::warm( "I expected a string name. Ignore this constant definition.",
				    $self-&gt;{'FILENAME'},
				    $self-&gt;{'LINENO'} ) ;
  }
  elsif ( exists $self-&gt;{'BIBSCANNER_ENTRIES'}{'constants'}{$lcname} ) {
    Bib2HTML::General::Error::warm( "the \@STRING '".$name."' was already ".
				    "defined. Ignored the last instance.",
				    $self-&gt;{'FILENAME'},
				    $lineno ) ;
  }
  else {
    $self-&gt;{'BIBSCANNER_ENTRIES'}{'constants'}{$lcname}{'text'} = $_[1] ;
    $self-&gt;{'BIBSCANNER_ENTRIES'}{'constants'}{$lcname}{'location'} = $self-&gt;{'FILENAME'}.":".$lineno ;
  }
}

=pod

=item * addcomment()

Adds a comment inside the readed data.
Takes 3 args:

=over

=item * value (string)

is the value of the comment

=back

=cut
sub addcomment($) {
  my $self = shift ;
  my $value = $_[0] || '' ;
  push @{$self-&gt;{'BIBSCANNER_ENTRIES'}{'comments'}}, "$value";
}

=pod

=item * addpreamble()

Adds a preamble inside the readed data.
Takes 1 args:

=over

=item * content (string)

is the content of the preamble

=item * lineno (integer)

is the line number where the preamble starts

=back

=cut
sub addpreamble($$) {
  my $self = shift ;
  my $lineno = $_[1] || 0 ;
  if ( $_[0] ) {
    push @{$self-&gt;{'BIBSCANNER_ENTRIES'}{'preambles'}}, { 'tex' =&gt; $_[0],
							  'location' =&gt; $self-&gt;{'FILENAME'}.":".$lineno,
							} ;
  }
}

=pod

=item * addentry()

Adds an entry inside the readed data.
Takes 3 args:

=over

=item * key (string)

is the bibtex key

=item * type (string)

is the bibtex type of the entry

=item * fields (hash)

is the list of the field for this entry

=item * lineno (integer)

is the line number where the entry starts

=back

=cut
sub addentry($$$$) {
  my $self = shift ;
  my $key = $_[0] || confess( 'you must supply the entry key' ) ;
  my $type = $_[1] || confess( 'you must supply the entry type' ) ;
  my $fields = $_[2] || { } ;
  my $lineno = $_[3] || 0 ;
  $fields = { } unless ishash( $fields ) ;

  if ($key !~ /^[a-zA-Z0-9.:_\-=\+]+$/) {
    Bib2HTML::General::Error::warm( "the entry '".$key."' does not respect the ".
				    "official entry key guidelines from ".
				    "the BibTeX specifications.",
				    $self-&gt;{'FILENAME'},
				    $lineno ) ;
  }

  if ( exists $self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'}{$key} ) {
    Bib2HTML::General::Error::warm( "the entry '".$key."' was already ".
				    "defined. Ignored the last instance.",
				    $self-&gt;{'FILENAME'},
				    $lineno ) ;
  }
  else {
    $self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'}{$key}{'type'} = lc($type) ;
    $self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'}{$key}{'location'} = $self-&gt;{'FILENAME'}.":".$lineno ;
    $self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'}{$key}{'dirname'} = dirname($self-&gt;{'FILENAME'}) ;
    while ( my ($k, $value) = each (%{$fields}) ) {
      # Patched by: Martin P.J. ZINSER &lt;zinser@zinser.no-ip.info&gt;
      #   lc was added to support multi-case field names
      $self-&gt;{'BIBSCANNER_ENTRIES'}{'entries'}{$key}{'fields'}{lc($k)} = $value ;
    }
  }
}

#------------------------------------------------------
#
# String functions
#
#------------------------------------------------------

=pod

=item * clearstring()

Clear the string, and replies the old value.

=cut
sub clearstring() {
  my $self = shift ;
  my $str = $self-&gt;getstring() ;
  delete( $self-&gt;{'BUFFER'}{'string'} ) ;
  return $str ;
}

=pod

=item * getstring()

Replies the current string.

=cut
sub getstring() {
  my $self = shift ;
  if ( isarray( $self-&gt;{'BUFFER'}{'string'} ) ) {
    for(my $i=0; $i&lt;=$#{$self-&gt;{'BUFFER'}{'string'}}; $i++) {
      $self-&gt;{'BUFFER'}{'string'}[$i] = $self-&gt;cleanstring($self-&gt;{'BUFFER'}{'string'}[$i]) ;
    }
    return $self-&gt;{'BUFFER'}{'string'} ;
  }
  else {
    return $self-&gt;cleanstring($self-&gt;{'BUFFER'}{'string'}) ;
  }
}

=pod

=item * cleanstring()

Removes string delimiters.
Takes 1 arg:

=over

=item * text (string)

is the string to remove.

=over

=cut
sub cleanstring($) {
  my $self = shift ;
  my $text = $_[0] || '' ;
  $text =~ s/[ \t]*[\n\r][ \t]*/ /gm ;
  if ( $text =~ /^\".*\"$/ ) {
    $text =~ s/^\"/{/ ;
    $text =~ s/\"$/}/ ;
  }
  return $text ;
}

=pod

=item * setstring()

Sets the string.

=cut
sub setstring($;$) {
  my $self = shift ;
  my $iskeyword = $_[1] || 0 ;
  my $str = $_[0] || '' ;
  if ( isarray( $self-&gt;{'BUFFER'}{'string'} ) ) {
    my $last = $#{$self-&gt;{'BUFFER'}{'string'}} ;
    if ( $self-&gt;{'BUFFER'}{'string'}[$last] ) {
      $self-&gt;{'BUFFER'}{'string'}[$last] .= $str ;
    }
    else {
      $self-&gt;{'BUFFER'}{'string'}[$last] = $str ;
    }
  }
  elsif ( $self-&gt;{'BUFFER'}{'string'} ) {
    $self-&gt;{'BUFFER'}{'string'} .= $str ;
  }
  else {
    $self-&gt;{'BUFFER'}{'string'} = $str ;
  }
}

=pod

=item * translate_to_contatenatedstring()

Sets the string as a concatened string if
it was not already set as.
Adds an empty element to this contatened
string.
A concatened string is used to split the 
different components of the string in order
to extract the potential string constant to
replace.

=cut
sub translate_to_contatenatedstring() {
  my $self = shift ;
  force_add_value_entry($self-&gt;{'BUFFER'}, 'string', '' ) ;
}

1;
__END__

=back

=head1 COPYRIGHT

(c) Copyright 1998-09 Stéphane Galland &lt;galland@arakhne.org&gt;, under GPL.

=head1 AUTHORS

=over

=item *

Conceived and initially developed by Stéphane Galland E&lt;lt&gt;galland@arakhne.orgE&lt;gt&gt;.

=back

=head1 SEE ALSO

bib2html.pl
</pre></body></html>