summaryrefslogtreecommitdiff
path: root/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm
diff options
context:
space:
mode:
Diffstat (limited to 'biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm')
-rw-r--r--biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm643
1 files changed, 643 insertions, 0 deletions
diff --git a/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm b/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm
new file mode 100644
index 0000000000..d3b090c3a6
--- /dev/null
+++ b/biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm
@@ -0,0 +1,643 @@
+# Copyright (C) 1998-09 Stephane Galland <galland@arakhne.org>
+#
+# 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::StateMachine - A state machine
+
+=head1 SYNOPSYS
+
+use Bib2HTML::Parser::StateMachine ;
+
+my $sm = Bib2HTML::Parser::StateMachine->new(
+ transitions,
+ initial_state,
+ final_states
+ ) ;
+
+=head1 DESCRIPTION
+
+Bib2HTML::Parser::StateMachine is a Perl module, which
+implementes a state machine.
+
+=head1 GETTING STARTED
+
+=head2 Initialization
+
+To start a scanner, say something like this:
+
+ use Bib2HTML::Parser::StateMachine;
+
+ my $sm = Bib2HTML::Parser::StateMachine->new(
+ { '0' => [ { callback => 'myfunc',
+ pattern => 'a+',
+ state => '1',
+ },
+ { state => '0' },
+ ],
+ '1' => { state => '0',
+ },
+ },
+ '0',
+ [ '1' ]
+ ) ;
+
+...or something similar. Acceptable parameters to the constructor are:
+
+=over
+
+=item * transitions (hash ref)
+
+describes the states of this machine. It must be an
+associative array in which the keys are the name of
+each states, and the associated values describe the
+states with an array of transitions or with only
+one transition. A transition is defined as an
+associative array in which the following keys are
+recognized:
+
+=over
+
+=item * state (string)
+
+is the name of the state on which the machine must <be
+after this transition. B<This value is required.>
+
+=item * pattern (string)
+
+is a regular expression that describe the selection
+condition needed to do this translation. B<This
+value is optional>. But, only once transition
+is able to not defined the pattern. This special
+transition is the default (if no other transition
+could be selected). If the pattern was equal to
+the string "$EOF", it matchs the end of the stream
+(see changestateforEOF()).
+
+=item * callback (string)
+
+is the name (not the reference) to a function that
+must be called each time this transition was selected.
+B<This value is optional>.
+
+=item * merge (boolean)
+
+if true, the recognized
+token will be merged to the next token.
+B<This value is optional>.
+
+=item * splitmerging (boolean)
+
+if true, the previously saved tokens
+are passed to the callbacks functions.
+If I<merge> was also true, the current
+token is not merging.
+B<This value is optional>.
+
+=back
+
+=item * initial_state (string)
+
+is the name of the initial state of the machine.
+This state must be defined inside the previous parameter.
+
+=item * final_states (array ref)
+
+is an array that lists all the final states recognized
+by this machine. This array is used by isfinalstate()
+to determine is this machine is inside a stable final
+state.
+
+=back
+
+=head2 State change
+
+To change the state of the machine, say something like this:
+
+ $scan->changestatefrom( "the string" ) ;
+
+...where "the string" is a string which permits to select
+the next state.
+
+=head1 METHOD DESCRIPTIONS
+
+This section contains only the methods in StateMachine.pm itself.
+
+=over
+
+=cut
+
+package Bib2HTML::Parser::StateMachine;
+
+@ISA = ('Exporter');
+@EXPORT = qw();
+@EXPORT_OK = qw();
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
+use Exporter;
+use Carp ;
+use File::Basename ;
+
+use Bib2HTML::General::Misc ;
+use Bib2HTML::General::Verbose ;
+
+#------------------------------------------------------
+#
+# Global vars
+#
+#------------------------------------------------------
+
+# Version number of the scanner
+my $VERSION = "1.0" ;
+
+#------------------------------------------------------
+#
+# Constructor
+#
+#------------------------------------------------------
+
+sub new($$$) : method {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $parent = ref($proto) && $proto ;
+
+ my $self ;
+ if ( $parent ) {
+ %{$self} = %{$parent} ;
+ }
+ else {
+ $self = { } ;
+ # Sets the description of this machine
+ $self->{'SM_STATES'} = { 'SM_PREVIOUS_TOKEN' => "",
+ } ;
+ foreach my $state ( keys %{$_[0]} ) {
+ my $list ;
+ # Gets the list of the transitions
+ if ( isarray( $_[0]{$state} ) ) {
+ $list = $_[0]{$state} ;
+ }
+ else {
+ $list = [ $_[0]{$state} ] ;
+ }
+ # Checks the transitions
+ my $default = 0 ;
+ foreach my $trans ( @{$list} ) {
+ # Search for the target state
+ if ( ( exists $trans->{'state'} ) &&
+ ( "s".$trans->{'state'} eq "s" ) ) {
+ confess( "A transition of the state '$state' ".
+ "must have a target state." ) ;
+ }
+ if ( ! exists $_[0]{$trans->{'state'}} ) {
+ confess( "The transition state '".
+ $trans->{'state'}.
+ "' from '$state' was not found." ) ;
+ }
+ # Search for the default transition
+ if ( ! $trans->{'pattern'} ) {
+ if ( $default ) {
+ confess( "More than once default transition ".
+ "for the transition '$state'." ) ;
+ }
+ $default = 1 ;
+ $trans->{'pattern'} = '.' ;
+ }
+ elsif ( ! is_valid_regex( $trans->{'pattern'} ) ) {
+ confess( "The regular expression '".
+ $trans->{'pattern'}.
+ "' is not well-formed." ) ;
+ }
+ }
+ # Copies the state
+ @{$self->{'SM_STATES'}{$state}} = @{$list} ;
+ }
+
+ # Sets the initial state
+ if ( exists $self->{'SM_STATES'}{$_[1]} ) {
+ $self->{'SM_INITIAL_STATE'} = $_[1] ;
+ $self->{'SM_CURRENT_STATE'} = $_[1] ;
+ }
+ else {
+ confess( "The initial state '$_[1]' is not defined." ) ;
+ }
+
+ # Sets the final states
+ $self->{'SM_FINAL_STATES'} = [] ;
+ foreach my $state ( @{$_[2]} ) {
+ if ( exists $self->{'SM_STATES'}{$state} ) {
+ push( @{$self->{'SM_FINAL_STATES'}}, $state ) ;
+ }
+ else {
+ confess( "The final state '$state' is not defined." ) ;
+ }
+ }
+ if ( isemptyarray( $self->{'SM_FINAL_STATES'} ) ) {
+ confess( "No final state defined." ) ;
+ }
+ }
+ bless( $self, $class );
+ return $self;
+}
+
+#------------------------------------------------------
+#
+# Getters / Setters
+#
+#------------------------------------------------------
+
+=pod
+
+=item * getcurrentstate()
+
+Replies the name of the current state of this
+machine.
+
+=cut
+sub getcurrentstate() : method {
+ my $self = shift ;
+ return $self->{'SM_CURRENT_STATE'} ;
+}
+
+=pod
+
+=item * isfinalstate()
+
+Replies the machine is inside a final state.
+
+=cut
+sub isfinalstate() : method {
+ my $self = shift ;
+ return strinarray( $self->{'SM_CURRENT_STATE'},
+ $self->{'SM_FINAL_STATES'} ) ;
+}
+
+=pod
+
+=item * resetstatemachine()
+
+Forces the state of this machine to the initial
+state.
+
+=cut
+sub resetstatemachine() : method {
+ my $self = shift ;
+ $self->{'SM_CURRENT_STATE'} = $self->{'SM_INITIAL_STATE'} ;
+ $self->{'SM_PREVIOUS_TOKEN'} = "" ;
+}
+
+#------------------------------------------------------
+#
+# State changement functions
+#
+#------------------------------------------------------
+
+=pod
+
+=item * changestatefrom()
+
+This method permits to select the new state according to
+the specified string and to the current state.
+The state transitions are defined when initializing.
+This method calls the callback function specified
+to the constructor, or (if not exists) calls the
+class methods transition_callback_XXX_YYY() and
+state_callback_YYY(), where XXX is the name of
+the old state, and YYY is the name of the new state.
+
+This method replies the rest of the specified
+parameter that is not eaten.
+
+Takes 1 arg:
+
+=over
+
+=item * token (string)
+
+is eaten to determine the new state.
+
+=back
+
+=item * transition_callback_XXX_YYY()
+
+This method is called each time a transition
+from the state XXX to the state YYY was
+encountered.
+Takes 1 arg:
+
+=over
+
+=item * token (string)
+
+is the last recognized token.
+
+=back
+
+=item * state_callback_YYY()
+
+This method is called each time the machine
+arrived inside a state (except for the
+initial state).
+Takes 1 arg:
+
+=over
+
+=item * token (string)
+
+is the last recognized token.
+
+=back
+
+=cut
+sub changestatefrom($) : method {
+ my $self = shift ;
+ my $input = $_[0] || '' ;
+
+ # Searches the max token matching
+ my $trans = $self->_searchtransition( $input, 0 ) ;
+
+ # Treats the translation matching
+ if ( ! isemptyhash( $trans ) ) {
+ my ($token,$rest) ;
+ if ( $trans->{'caseinsensitive'} ) {
+ $input =~ /^($trans->{'pattern'})(.*)$/si ;
+ ($token,$rest) = ($1,$2) ;
+ }
+ else {
+ $input =~ /^($trans->{'pattern'})(.*)$/s ;
+ ($token,$rest) = ($1,$2) ;
+ }
+
+ my $oldstate = $self->{'SM_CURRENT_STATE'} ;
+ $self->{'SM_CURRENT_STATE'} = $trans->{'state'} ;
+ $input = $rest ;
+
+ my $for_event = undef ;
+ if ( ( $trans->{'merge'} ) &&
+ ( $trans->{'splitmerging'} ) ) {
+ # Generates an transition event
+ # and merges the current token
+ $for_event = $self->{'SM_PREVIOUS_TOKEN'} ;
+ $self->{'SM_PREVIOUS_TOKEN'} = $token ;
+ }
+ elsif ( ( $trans->{'merge'} ) &&
+ ( ! $trans->{'splitmerging'} ) ) {
+ # Merges the current token
+ $self->{'SM_PREVIOUS_TOKEN'} .= $token ;
+ }
+ else {
+ # Does not merged the current token
+ $for_event = $self->{'SM_PREVIOUS_TOKEN'} . $token ;
+ $self->{'SM_PREVIOUS_TOKEN'} = "" ;
+ }
+
+ if ( defined $for_event ) {
+ $self->_callback( $for_event,
+ $oldstate,
+ $trans ) ;
+ }
+ }
+ elsif ( $self->can('backend_error_function') ) {
+ $self->backend_error_function( "Syntax error: unexpected character sequence \"".
+ tohumanreadable("$input").
+ "\"\n(unable to find a transition from ".
+ "the state '".
+ $self->{'SM_CURRENT_STATE'}.
+ "')." ) ;
+ exit(1) ;
+ }
+ else {
+ confess( "Syntax error: unexpected character sequence \"".
+ tohumanreadable("$input").
+ "\"\n(unable to find a transition from ".
+ "the state '".
+ $self->{'SM_CURRENT_STATE'}.
+ "')." ) ;
+ }
+ return $input ;
+}
+
+=pod
+
+=item * changestateforEOF()
+
+This method permits to select the new state according to
+an EOF and to the current state.
+The state transitions are defined when initializing.
+This method calls the class method
+EOF_callback_function() (only if no transition with
+the pattern '$EOF' was found from the current state).
+
+=item * EOF_callback_function()
+
+The methid is called each time the EOF was encountered
+and a transition with pattern '$EOF' is not found from
+the current state.
+
+=over
+
+=item * token (string)
+
+is the token which is not already eaten by the machine.
+
+=back
+
+=cut
+sub changestateforEOF() : method {
+ my $self = shift ;
+
+ # Calls the callback functions
+ # if a token was not treated
+
+ my $trans = $self->_searchtransition( "", 1 ) ;
+ if ( ! isemptyhash( $trans ) ) {
+ my $oldstate = $self->{'SM_CURRENT_STATE'} ;
+ $self->{'SM_CURRENT_STATE'} = $trans->{'state'} ;
+ $self->_callback( $self->{'SM_PREVIOUS_CONTENT'},
+ $oldstate,
+ $trans ) ;
+ }
+ else {
+ if ( Bib2HTML::General::Verbose::currentlevel() >= 4 ) {
+ my $verbstr = join( '',
+ "\t\ttoken = '",
+ tohumanreadable($self->{'SM_PREVIOUS_TOKEN'}),
+ "'" ) ;
+ $verbstr .= ", when EOF in '".$self->{'SM_CURRENT_STATE'}."'" ;
+ Bib2HTML::General::Verbose::verb( "$verbstr.", 4 ) ;
+ }
+ my $reffunc = $self->can( "EOF_callback_function" ) ;
+ if ( $reffunc ) {
+ $self->$reffunc( $self->{'SM_PREVIOUS_TOKEN'} ) ;
+ }
+ }
+}
+
+=pod
+
+=item * _callback()
+
+Calls the callback functions.
+Takes 3 args:
+
+=over
+
+=item * token (string)
+
+is the token to pass to the callback functions.
+
+=item * old_state (string)
+
+is the name of the state before the transition
+(the name of the state after the transition is
+stored inside $self->{'SM_CURRENT_STATE'}).
+
+=item * transition (hash ref)
+
+is the transition choosen.
+
+=back
+
+=cut
+sub _callback($$$) : method {
+ my $self = shift ;
+ my $token = $_[0] || '' ;
+ my $oldstate = $_[1] || confess( 'you must supply the old state' ) ;
+ if ( Bib2HTML::General::Verbose::currentlevel() >= 4 ) {
+ my $verbstr = join( '',
+ "\t\ttoken = '",
+ tohumanreadable($token),
+ "'" ) ;
+ if ( $self->{'SM_CURRENT_STATE'} eq $oldstate ) {
+ $verbstr .= ", in state '".tohumanreadable($oldstate)."'" ;
+ }
+ else {
+ $verbstr .= join( '',
+ ", transition: '",
+ tohumanreadable($oldstate),
+ "' -> '",
+ tohumanreadable($self->{'SM_CURRENT_STATE'}),
+ "'" ) ;
+ }
+ Bib2HTML::General::Verbose::verb( "$verbstr.", 4 ) ;
+ }
+
+ if ( ishash( $_[2] ) ) {
+ if ( ( exists $_[2]->{'callback'} ) &&
+ ( my $func = $self->can($_[2]->{'callback'}) ) ) {
+ $self->$func( $token, $oldstate ) ;
+ }
+ else {
+ my $reffunc = $self->can( "transition_callback_".
+ $oldstate."_".
+ $self->{'SM_CURRENT_STATE'} ) ;
+ if ( $reffunc ) {
+ $self->$reffunc( $token ) ;
+ }
+ $reffunc = $self->can( "state_callback_".
+ $self->{'SM_CURRENT_STATE'} ) ;
+ if ( $reffunc ) {
+ $self->$reffunc( $token, $oldstate ) ;
+ }
+ }
+ }
+}
+
+=pod
+
+=item * _searchtransition()
+
+Search a valid transition
+Takes 2 args:
+
+=over
+
+=item * input (string)
+
+is the content of the string to scan.
+
+=item * eof (boolean)
+
+is true if an EOF was encountered. In this
+case, the I<input> will be ignored.
+
+=back
+
+=cut
+sub _searchtransition($$) : method {
+ my $self = shift ;
+ my $input = $_[0] || '' ;
+ my $eof = $_[1] || 0 ;
+ # Searches the max token matching
+ my $maxlength = 0 ;
+ my $trans = {} ;
+ my $recognizedtoken = "" ;
+ foreach my $t (@{$self->{'SM_STATES'}{$self->{'SM_CURRENT_STATE'}}}) {
+ if ( ( ( $eof ) &&
+ ( $input eq '$EOF' ) ) ||
+ ( ( $t->{'caseinsensitive'} ) &&
+ ( $input =~ /^($t->{'pattern'})/si ) ) ||
+ ( ( ! $t->{'caseinsensitive'} ) &&
+ ( $input =~ /^($t->{'pattern'})/s ) ) ) {
+ my $token = $1 ;
+ if ( length($token) > $maxlength ) {
+ $maxlength = length($token) ;
+ $trans = $t ;
+ $recognizedtoken = $token ;
+ }
+ }
+ }
+ if ( ( $recognizedtoken ) && ( Bib2HTML::General::Verbose::currentlevel() >= 5 ) ) {
+ Bib2HTML::General::Verbose::verb( join( '',
+ "\t\tnext transition:\n\t\t\tfrom: ",
+ $self->{'SM_CURRENT_STATE'},
+ "\n\t\t\tto: ",
+ $trans->{'state'},
+ "\n\t\t\tpattern: /",
+ $trans->{'pattern'},
+ "/\n\t\t\ttoken: '",
+ $recognizedtoken,
+ "'\n"),
+ 5 ) ;
+ }
+ return $trans ;
+}
+
+1;
+__END__
+
+=back
+
+=head1 COPYRIGHT
+
+(c) Copyright 1998-09 Stéphane Galland <galland@arakhne.org>, under GPL.
+
+=head1 AUTHORS
+
+=over
+
+=item *
+
+Conceived and initially developed by Stéphane Galland E<lt>galland@arakhne.orgE<gt>.
+
+=back
+
+=head1 SEE ALSO
+
+bib2html.pl