webdiag.pl Source Code
#!/usr/bin/perl # # WEBDIAG.PRL # # 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; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # Copyright (C) 1998 by Marc-Henri Poget, mpoget@hospvd.ch # # DESCRIPTION: # Build a HTML based decision graphs from a small description language. # # LOG: # 97/07/23 M.H. Poget Creation # 97/07/24 M.H. Poget Fin mise au point # 97/08/11 M.H. Poget Complement HELP et ROOT pour texte a afficher # Nouveaux mots-cles: # DATE,COPYRIGHT,TRUE,FALSE,QUESTION,POSSIBLE # 97/08/21 M.H. Poget Permet de specifier une adresse absolue pour un nouveau diagnostic # 98/08/03 M.H. Poget Font size and face can now be specified in COMMON. # 98/10/12 M.H. Poget Print English messages. # 98/10/13 M.H. Poget Remove warning when opening files. # 98/10/15 M.H. Poget Renamed $bRuleChecked into $bLinkNoQuestion eval "exec /usr/bin/perl -S $0 $*" if $running_under_some_shell; # this emulates #! processing on NIH machines. # (remove #! line above if indigestible) eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; # process any FOO=bar switches $[ = 1; # set array base to 1 $, = ' '; # set output field separator $\ = "\n"; # set output record separator #################### # States constants # #################### $C_INITIAL = 0; $C_COMMON = 1; $C_NODE = 2; $C_SWITCH = 3; $C_IF_TRUE = 4; $C_IF_FALSE = 5; $C_TEXT = 6; $C_SOL = 7; ############# # Variables # ############# $eState = $C_INITIAL; $bLinkNoQuestion = 0; # Test whether links are used outside of # questions blocks (IF and SWITCH). $sFace = 'TIMES'; $sSize = '3'; $ExitValue = 0; # When everything is ok ############################# # Loop over the input lines # ############################# line: while (<>) { chop; # strip record separator @Fld = split(' ', $_, 9999); if (/^#/) { # skip comments starting with the pound sign } # Check every keyword of the description language. # Each keyword with its parameters shall fit on a single # input line. if (/^ *COMMON/) { &checkUnexpected($C_INITIAL, 'COMMON'); &checkArgs(0); $eState = $C_COMMON; } if (/^ *FONTFACE/) { &checkUnexpected($C_COMMON, 'FONTFACE'); &checkArgs(1); $sFace = $Fld[2]; } if (/^ *FONTSIZE/) { &checkUnexpected($C_COMMON, 'FONTSIZE'); &checkArgs(1); $sSize = $Fld[2]; } if (/^ *TRUE/) { &checkUnexpected($C_COMMON, 'TRUE'); &checkArgs(1); $sTrue = $Fld[2]; } if (/^ *FALSE/) { &checkUnexpected($C_COMMON, 'FALSE'); &checkArgs(1); $sFalse = $Fld[2]; } if (/^ *QUESTION/) { &checkUnexpected($C_COMMON, 'QUESTION'); &checkArgs(1); $sQuestion = $Fld[2]; } if (/^ *POSSIBLE/) { &checkUnexpected($C_COMMON, 'POSSIBLE'); &checkMinArgs(1); &getText(2); $sSolution = $sText; } if (/^ *DATE/) { &checkUnexpected($C_COMMON, 'DATE'); &checkArgs(1); $sDate = $Fld[2]; } if (/^ *COPYRIGHT/) { &checkUnexpected($C_COMMON, 'COPYRIGHT'); &checkMinArgs(1); &getText(2); $sCopyright = $sText; } if (/^ *ROOT/) { &checkUnexpected($C_COMMON, 'ROOT'); &checkArgs(1); $sRoot = $Fld[2]; } if (/^ *NEW/) { &checkUnexpected($C_COMMON, 'NEW'); &checkMinArgs(1); $sNewURL = $Fld[2]; &getText(3); $sNew = $sText; } if (/^ *TITLE/) { &checkUnexpected($C_COMMON, 'TITLE'); &checkMinArgs(1); &getText(2); $sTitle = $sText; } if (/^ *FNAME/) { &checkUnexpected($C_COMMON, 'FNAME'); &checkArgs(1); $sFile = $Fld[2]; } if (/^ *HELP/) { &checkUnexpected($C_COMMON, 'HELP'); &checkMinArgs(1); $sHelp = $Fld[2]; &getText(3); $sHelpText = $sText } if (/^ *NODE/) { &checkUnexpected($C_INITIAL, 'NODE'); &checkArgs(1); $eState = $C_NODE; # A new node definition has been found, its # corresponding HTML file can be created. # This file becomes the new current file where to # write HTML statements. &getNode($Fld[2]); $sCurrFile = $aNodeFile{$Fld[2]}; $aFileCreated{$Fld[2]} = 1; &putHeader($Fld[2]); } if (/^ *IF/) { &checkUnexpected($C_NODE, 'IF'); &checkMinArgs(1); &getText(2); $eState = $C_IF_TRUE; &putQuestion($sText); } if (/^ *SWITCH/) { &checkUnexpected($C_NODE, 'SWITCH'); &checkMinArgs(1); &getText(2); $eState = $C_SWITCH; &putQuestion($sText); } if (/^ *TEXT/) { &checkUnexpected($C_NODE, 'TEXT'); &checkArgs(0); $eState = $C_TEXT; &putText(); $bLinkNoQuestion = 1; } if (/^ *SOLUTION/) { &checkUnexpected($C_NODE, 'SOLUTION'); &checkArgs(0); $eState = $C_SOL; &putSolution(); $bLinkNoQuestion = 1; } if (/^ *NEXT/) { &checkMinArgs(1); # A link to a node has been found. Define the node. &getNode($Fld[2]); if ($eState == $C_IF_TRUE) { &putNext($Fld[2], $sTrue); $eState = $C_IF_FALSE; } elsif ($eState == $C_IF_FALSE) { &putNext($Fld[2], $sFalse); } elsif ($eState == $C_SWITCH || $eState == $C_TEXT || $eState == $C_SOL) { &getText(3); &putNext($Fld[2], $sText); $bLinkNoQuestion = 1; } else { &dispUnexpected('NEXT'); $ExitValue = 1; last line; } } if (/^ *URL/) { &checkMinArgs(1); if ($eState == $C_IF_TRUE) { &putURL($Fld[2], $sTrue); $eState = $C_IF_FALSE; } elsif ($eState == $C_IF_FALSE) { &putURL($Fld[2], $sFalse); } elsif ($eState == $C_SWITCH || $eState == $C_TEXT || $eState == $C_SOL) { &getText(3); &putURL($Fld[2], $sText); $bLinkNoQuestion = 1; } else { &dispUnexpected('URL'); $ExitValue = 1; last line; } } if (/^ *END/) { &checkArgs(0); if ($eState == $C_NODE) { &putFooter(); } if ($eState == $C_SWITCH || $eState == $C_IF_FALSE || $eState == $C_TEXT || $eState == $C_SOL) { $eState = $C_NODE; &endList(); } else { $eState = $C_INITIAL; } } if (/^[^#]/) { if ($eState == $C_TEXT || $eState == $C_SOL) { if ($bLinkNoQuestion == 0) { &Pick('>>', $sCurrFile) && (print $fh $_); } } $bLinkNoQuestion = 0; } } # Check whether all the nodes files have been generated. # If not, it means that a NODE block is missing or that there # is a spelling mistake in a NEXT statement. print 'Nodes'; print '====='; foreach $sNode (keys %aNode) { if (defined $aFileCreated{$sNode}) { printf "%-20s%15s\n", $sNode, $aNodeFile{$sNode}; } else { printf "Missing definition for node: %s\n", $sNode; } } exit $ExitValue; ################### # Local functions # ################### sub dispUnexpected { # # Display a message indicating that an unexpected keyword # has been found in the input file. # local($sxKeyword) = @_; printf "line %d: %s unexpected\n", $., $sxKeyword; } sub checkUnexpected { # # Check whether the found keyword is authorized in the # current state. # local($exState, $sxKeyword) = @_; if ($eState ne $exState) { &dispUnexpected($sxKeyword); $ExitValue = 1; last line; } } sub checkArgs { # # Check whether the found keyword has exactly $ixReqNbArgs. # local($ixReqNbArgs) = @_; if (($ixReqNbArgs + 1) != $#Fld) { printf "line %d: waits %d arguments\n", $., $ixReqNbArgs; $ExitValue = 1; last line; } } sub checkMinArgs { # # Check whether the found keyword has at least $ixReqNbArgs. # local($ixReqNbArgs) = @_; if (($ixReqNbArgs + 1) > $#Fld) { printf "line %d: waits at least %d arguments\n", $., $ixReqNbArgs; $ExitValue = 1; last line; } } sub getNode { # # Assign a node number and a filename to a node name. # local($sxNode) = @_; if (!(defined $aNode{$sxNode})) { if ($sxNode eq $sRoot) { # Root node is the first one. $aNode{$sxNode} = 0; } else { # All other nodes are numbered starting from 1. $aNode{$sxNode} = ++$nNode; } # Create the filename for later use. $aNodeFile{$sxNode} = sprintf('%s%03d.htm', $sFile, $aNode{$sxNode}); } } sub getText { # # Get the text following a keyword. # local($ixStart) = @_; local ($bFirst) = 1; while ($ixStart <= $#Fld) { if ($bFirst == 1) { $sText = $Fld[$ixStart]; $bFirst = 0; } else { $sText = $sText . ' ' . $Fld[$ixStart]; } $ixStart++; } } sub Pick { # # Check whether a file is opened and opens when not. # local($mode,$name) = @_; $fh = $name; open($name,$mode.$name) unless $opened{$name}++; } ################## # HTML functions # ################## sub putHeader { local($sxNode) = @_; &Pick('>', $sCurrFile) && (printf $fh "<HTML>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<HEAD>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<TITLE>%s</TITLE>\n",$sTitle); &Pick('>>', $sCurrFile) && (printf $fh "<META NAME=GENERATOR CONTENT=\"Webdiag.prl 0.1\">\n"); &Pick('>>', $sCurrFile) && (printf $fh "<X-SAS-WINDOW TOP=25 BOTTOM=451 LEFT=81 RIGHT=749>\n"); &Pick('>>', $sCurrFile) && (printf $fh "</HEAD>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<BODY BGCOLOR=\"#FFFFFF\">\n\n"); &Pick('>>', $sCurrFile) && (printf $fh "<FONT SIZE=%s FACE=%s>\n", $sSize, $sFace); &Pick('>>', $sCurrFile) && (printf $fh "<P><A NAME=\"NODE\"></A></P>\n\n"); # &Pick('>>', $sCurrFile) && # (printf $fh "<H2>%s: %03d</H2>\n\n", $sTitle, $aNode{$sxNode}); &Pick('>>', $sCurrFile) && (printf $fh "<H2>%s</H2>\n\n", $sTitle); } sub putFooter { &Pick('>>', $sCurrFile) && (printf $fh "<HR>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<PRE><A HREF=\"%s#NODE\" TARGET=\"_self\">%s</A>", $sNewURL,$sNew); &Pick('>>', $sCurrFile) && (printf $fh " <A HREF=\"%s\" TARGET=\"_self\">%s</A></PRE>\n", $sHelp,$sHelpText); &Pick('>>', $sCurrFile) && (printf $fh "<HR>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<P>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<P><CENTER><FONT SIZE=\"-1\">© %s %s</FONT></CENTER></P>\n",$sDate,$sCopyright); &Pick('>>', $sCurrFile) && (printf $fh "</BODY>\n"); &Pick('>>', $sCurrFile) && (printf $fh "</HTML>\n"); } sub putQuestion { local($sxText) = @_; &Pick('>>', $sCurrFile) && (printf $fh "<HR>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<H3>%s</H3>\n",$sQuestion); &Pick('>>', $sCurrFile) && (printf $fh "%s\n", $sText); &Pick('>>', $sCurrFile) && (printf $fh "<UL>\n"); } sub putText { &Pick('>>', $sCurrFile) && (printf $fh "<HR>\n"); } sub putSolution { &Pick('>>', $sCurrFile) && (printf $fh "<HR>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<H3>%s</H3>\n",$sSolution); } sub endList { &Pick('>>', $sCurrFile) && (printf $fh "</UL>\n"); } sub putNext { local($sxNode, $sxText) = @_; if ($eState == $C_TEXT || $eState == $C_SOL) { &Pick('>>', $sCurrFile) && (printf $fh "<P>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<A HREF=\"%s#NODE\" TARGET=\"_self\">%s</A>\n", $aNodeFile{$sxNode}, $sxText); &Pick('>>', $sCurrFile) && (printf $fh "<P>\n"); } else { &Pick('>>', $sCurrFile) && (printf $fh "<LI><A HREF=\"%s#NODE\" TARGET=\"_self\">%s</A>\n", $aNodeFile{$sxNode}, $sxText); } } sub putURL { local($sxURL, $sxText) = @_; if ($eState == $C_TEXT || $eState == $C_SOL) { &Pick('>>', $sCurrFile) && (printf $fh "<P>\n"); &Pick('>>', $sCurrFile) && (printf $fh "<A HREF=\"%s\" TARGET=\"_self\">%s</A>\n", $sxURL, $sxText); &Pick('>>', $sCurrFile) && (printf $fh "<P>\n"); } else { &Pick('>>', $sCurrFile) && (printf $fh "<LI><A HREF=\"%s\" TARGET=\"_self\">%s</A>\n", $sxURL, $sxText); } } |