diff options
Diffstat (limited to 'biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm')
-rw-r--r-- | biblio/bibtex/utils/bib2ml/src/Bib2HTML/Parser/StateMachine.pm | 643 |
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 |