package CGI::Transactor; ###################################################################### # # See # http://home.netsurf.de/thomas.schuett/WWPnWWAC # # Author: Thomas Schuett, thomas.schuett@munich.netsurf.de # Copyright (C) 2001 Thomas Schuett # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public License # as published by the Free Software Foundation. # # 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 Lesser General Public License for more details. # ###################################################################### use strict; my $VERSION = "1.00"; sub new { my $class = shift; my $self = {}; bless($self, $class); return $self; } sub get_transition { my $self = shift; my $page_name = shift; my $button_name = shift; ### ### work through transition table ### if ((! $page_name) && (! $button_name)) { $page_name = "START"; } my $result=""; my ($page,$button,$execute,$type); foreach my $transition (@{$self -> {m_trans}}) { ($page,$button,$execute,$type) = split (/;/,$transition); $page = &trim($page); $execute = &trim($execute); $button = &trim($button); $button_name = &trim($button_name); if ( (($page eq $page_name) || ($page eq "*")) && (($button eq $button_name) || ($button eq "*")) ) { $result = $execute; last; } } return ($result,$type); } sub trim { my $s = shift; if (! $s) { return ""; } # avoid regex error, if not set $s =~ s,^\s*,,; # trim before $s =~ s,\s*$,,; # trim after return $s; } sub set_trans_table_by_file { my $self = shift; my $fname = shift; open(F,"$fname") || return "Could not open file ($fname)."; my @trans = (); while () { if (/^\s*#/) { next; } # skip comment lines chomp; push @trans, ($_) ; } close F; @{$self -> {m_trans}} = @trans; 0; } sub set_trans_table { my $self = shift; @{$self -> {m_trans}} = @_; 0; } sub get_trans_table { my $self = shift; return @{$self -> {m_trans}}; } 1; __END__ =head1 NAME CGI::Transactor - Calculates, what to do next, depending on the button pressed in the recent web page. =head1 Synopsis #!/usr/bin/perl # First you define a state transition table for your web application: # page_name submit_button program_reaction # ----------------------------------------------------- my @trans_table = ( "START ; ; main_menu ", " * ; Main Menu ; main_menu ", "save_file ; Ok ; save_file_now ", "save_file ; Cancel ; show_list ", ..... ); use CGI::Transactor; $transactor = CGI::Transactor->new(); $transactor -> set_trans_table( @trans_table ); # or: $transactor -> set_trans_table_by_file("transition_table.tbl"); use CGI; my $cgi = CGI->new; print $cgi->header('text/html'); ($ret) = $transactor -> get_transition($cgi->param("page_name"), $cgi->param("sbutton")); if ($ret) { &$ret; } # call the subroutine else { print "Error: No transition found.\n"; exit 1; } exit 0; # End of the CGI program =head1 Further detailed information and explanations http://home.netsurf.de/thomas.schuett/WWPnWWAC