#! /usr/bin/perl # sm.pl -- a state machine CGI based engine (in perl) # $Id: sm.pl,v 1.3 1999/12/07 05:56:02 cgd Exp cgd $ # Carlos Duarte , 990626 ## # how to use this: # . if the cgi is named "foo.pl". then there should be a dir named "foo" # with all used html files in it # . each invocation of this script, sees a LINKFROM variable, and a # function with that name is run... # . except for first call, where default() is called (or if LINKFROM is invalid) # . each called function should return the next state (i.e. html page # to show next, and the function to run after it) # . html_subst(xxx) = value, will replace all per value (case sens) # . form_hidden(xxx) = value, will add input variable xxx=value to each form # . the special combination ..., will # replace all tags in "..." repeatedly, until tag variable are empty # (each tag with multiple values is separated per "\0") # use strict; use CGI; defined &die_catcher and $SIG{__DIE__} = \&die_catcher; my %form_hidden; # for gen_page my %html_subst; # for gen_page my $cgi = new CGI; my ( $self_dir, # full path of this file, with no filename $self_file, # filename of this file (with no path) $self_base, # filename with no extension $self_href # valid callself href ) = get_self_info(); ######################################################################## ## persistent vars: those will travel between all cgi invocations ## cgi -> html via hidden; html -> via param ## use vars qw($year ); my @global_vars = qw(year ); ######################################################################## ## main: get vars, run action func, and generate page ## { for (@global_vars) { eval "\$$_=\$cgi->param('$_');"; } my $linkfrom = $cgi->param('LINKFROM'); my $linkto; if (is_ok($linkfrom)) { eval "\$linkto = $linkfrom();"; } else { $linkto = default(); } for (@global_vars) { eval "\$form_hidden{'$_'}=\$$_; "; } $form_hidden{'LINKFROM'} = $linkto; gen_page("$self_dir/$self_base/$linkto.html", \%form_hidden, \%html_subst); } exit; ######################################################################## ## aux functions -- dont need changes # get info about this cgi location sub get_self_info { my $dir = $ENV{PWD}; my $file = $0; $file =~ s#^.*/##; my $base = $file; $base =~ s#\.[^.]*$##; my $href = $cgi->script_name(); $href eq "" and $href = $ENV{SCRIPT_NAME}; $href eq "" and $href = "/cgi-bin/$file"; $dir eq "" and $dir = "."; return ($dir, $file, $base, $href); } # quotes special html symbols sub hquote { local $_ = shift; s/\&/&/g; s/\/>/g; s/\"/"/g; return $_; } # filename, \%hidden, \%subst # replaces all on subst, and introduce input type=hidden # variable defined in hidden on filename # sub gen_page { local ($_,$.,$/); my $fn = shift; my %hid = %{ scalar shift }; my %subst = %{ scalar shift }; local *F; undef $/; open F, $fn or die "can't open $fn: $!"; $_ = ; close F; # add input type=hidden variables... my $r; for my $k (keys %hid) { $r .= ''."\n"; } s#(#$1 method=post action='$self_href'>#sig; s##\n$r\n$&#sig; # handle loops my $temp; while (s/^(.*?)(.*?)//s) { $temp .= $1; my $tt = $2; ## body of loop for (;;) { my $at_least_one=0; my $t = $tt; $t =~ s//do { my $r; my $p = index($subst{$2}, "\0"); if ($p == -1) { $r = $subst{$2}; $subst{$2} = ""; } else { $r = substr($subst{$2}, 0, $p); $subst{$2} = substr($subst{$2}, $p+1); } $r ne "" and $at_least_one++; $1 eq ":" and $r = hquote($r); $r; }/seg or last; $at_least_one or last; $temp .= $t; } } $temp .= $_; # left overs # handle $temp =~ s//do { my $r = $subst{$2}; my $p = index($r, "\0"); $p != -1 and $r = substr($r, 0, $p); $1 eq ":" and $r = hquote($r); $r; }/seg; print $cgi->header; print $temp; } # quote binary data to AABB... where AA is two hex digits of first char, etc.. sub _q { local $_ = shift; s/./sprintf("%02x",ord($&))/seg; return $_; } # unquote AABB... to binary sub _uq { local $_ = shift; s/../chr(hex($&))/seg; return $_; } ######################################################################## ## USER FUNCTIONS, defaults should be ok # $subject, $message, @whom sub sendmail { local $_; my $mail; local *MM; my $subj = shift; my $mess = shift; $_ = `uname`; if (/^linu/i) { $mail = "mail"; } else { $mail = "mailx"; } my $guys = join ' ', @_; $subj =~ s/'/'\\''/g; # if this fails, what else can go wrong?!? open MM, "|$mail -s '$subj' $guys"; $mess =~ s/(^|\n)~/$1~~/sg; ## escape the ~ commands print MM $mess; print MM "\n----\n"; print MM "Date: ", scalar localtime, "\n"; print MM "Cgi: ", $self_href, "\n"; close MM; } # catch our dies... sub die_catcher { my $msg = shift; print $cgi->header; print< Failure page

Failure: $msg

 
Date: ${\(scalar localtime)}
Cgi: $self_href
EOM ## this will also send mail to someone responsabile #my $s = $msg; #$s =~ s/^\s*//s; $s =~ s/\n.*$//; #length($s) > 72 and $s = substr($s, 0, 72); #sendmail($s, $msg, 'operacoes@teleweb.pt'); exit; } # validate if FUNC can be called, as defined per LINKFROM # return 1 if yes, 0 if not # sub is_ok { my $func = shift; # func must exist defined &$func or return 0; # must have a file .html with the same name return 0 unless ( -f "$self_dir/$self_base/$func.html" ); ## more checks (return 0 on fail) return 1; } # to cumulate errors: _err(msg); # then, to flag the error: _err() and return _err(); # my (@_err, $_err); sub _err { if (@_) { push @_err, @_; return; } $_err==0 and return $_err = !!@_err; return _error(@_err); } # if there is an user error (invalid data, for instance), use: # return _error(reason1, ...); # sub _error { local $_; # save state -- subst and hidden information for (keys %form_hidden) { $form_hidden{"hidden_".$_} = _q $form_hidden{$_}; delete $form_hidden{$_}; } for (keys %html_subst) { $form_hidden{"subst_".$_} = _q $html_subst{$_}; delete $html_subst{$_}; } # setup error message for (@_) { $html_subst{'ERRORMSG'} .= "$_\0"; } $form_hidden{'LINKSAVE'} = $cgi->param('LINKFROM'); return "error"; } # a more or less general error action sub error { local $_; for ($cgi->param()) { my $val = $cgi->param($_); if (s/^hidden_//) { $form_hidden{$_} = _uq $val; next; } if (s/^subst_//) { $html_subst{$_} = _uq $val; next; } } return scalar $cgi->param('LINKSAVE'); } ######################################################################## ## USER CODE ## ## convention: xxx() for states, and _xxx() for actions that gen data for xxx() ## sub default { return "first"; } sub first { $html_subst{'year'} = $year; ### on error, this must be loaded $year =~ /^\d+$/ or return _error("$year: bad year specification"); $html_subst{'output'} = `cal $year`; return "cal"; } sub cal { $html_subst{'year'} = $year; return "first"; }