r1889 - in packages/libcgi-formalware-perl/trunk: . debian lib
lib/CGI t
Daniel Ruoso
ruoso-guest at costa.debian.org
Tue Jan 10 22:02:28 UTC 2006
Author: ruoso-guest
Date: 2006-01-10 22:01:49 +0000 (Tue, 10 Jan 2006)
New Revision: 1889
Added:
packages/libcgi-formalware-perl/trunk/Build.PL
packages/libcgi-formalware-perl/trunk/MANIFEST.SKIP
packages/libcgi-formalware-perl/trunk/META.yml
packages/libcgi-formalware-perl/trunk/debian/watch
packages/libcgi-formalware-perl/trunk/lib/
packages/libcgi-formalware-perl/trunk/lib/CGI/
packages/libcgi-formalware-perl/trunk/lib/CGI/Formalware.pm
packages/libcgi-formalware-perl/trunk/t/
packages/libcgi-formalware-perl/trunk/t/pod.t
packages/libcgi-formalware-perl/trunk/t/test.t
Removed:
packages/libcgi-formalware-perl/trunk/Formalware.html
packages/libcgi-formalware-perl/trunk/Formalware.pm
packages/libcgi-formalware-perl/trunk/test.pl
Modified:
packages/libcgi-formalware-perl/trunk/Changes.txt
packages/libcgi-formalware-perl/trunk/MANIFEST
packages/libcgi-formalware-perl/trunk/Makefile.PL
packages/libcgi-formalware-perl/trunk/README
packages/libcgi-formalware-perl/trunk/debian/changelog
Log:
New Upstream Release
Added: packages/libcgi-formalware-perl/trunk/Build.PL
===================================================================
--- packages/libcgi-formalware-perl/trunk/Build.PL 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/Build.PL 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,19 @@
+use Module::Build;
+
+Module::Build -> new
+(
+ module_name => 'CGI::Formalware',
+ license => 'artistic',
+ dist_author => 'Ron Savage <ron at savage.net.au>',
+ build_requires =>
+ {
+ Test::More => 0,
+ Test::Pod => 0,
+ },
+ requires =>
+ {
+ CGI => '2.45',
+ Net::Telnet => '3.01',
+ XML::DOM => '1.14',
+ },
+) -> create_build_script();
\ No newline at end of file
Modified: packages/libcgi-formalware-perl/trunk/Changes.txt
===================================================================
--- packages/libcgi-formalware-perl/trunk/Changes.txt 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/Changes.txt 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,5 +1,18 @@
Revision history for Perl extension CGI::Formalware.
+1.13 Thu Oct 27 19:40:00 2005
+ - Regenerate META.yml with Module::Build V 0.2611 to correct a faulty
+ META.yml output by V 0.24 which falsely said 'provides: {}',
+ which in turn stopped the PAUSE indexer from finding the module file,
+ which in turn meant this module might be omitted from the master index:
+ ftp://pause.perl.org/pub/PAUSE/modules/01modules.index.html
+
+1.12 Mon Jul 19 14:10:00 2004
+ - Change Makefile.PL to coexist with Module::Build
+ - Delete ./test.pl
+ - Rewrite t/test.t to use Test::More
+ - Add t/pod.t to test all PODs
+
1.11 Sun Mar 23 11:29:00 2003
- Move demos into examples/ directory
- Change test.xml to use CSS /css/test.css rather than /test.css
Deleted: packages/libcgi-formalware-perl/trunk/Formalware.html
===================================================================
--- packages/libcgi-formalware-perl/trunk/Formalware.html 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/Formalware.html 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,474 +0,0 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml">
-<head>
-<title>C<CGI::Formalware> - Convert an XML file into a suite of CGI forms.</title>
-<link rev="made" href="mailto:" />
-</head>
-
-<body style="background-color: white">
-
-<p><a name="__index__"></a></p>
-<!-- INDEX BEGIN -->
-
-<ul>
-
- <li><a href="#name">NAME</a></li>
- <li><a href="#synopsis">SYNOPSIS</a></li>
- <li><a href="#description">DESCRIPTION</a></li>
- <li><a href="#installation">INSTALLATION</a></li>
- <li><a href="#audience">AUDIENCE</a></li>
- <li><a href="#security">SECURITY</a></li>
- <li><a href="#constructor_new">CONSTRUCTOR new</a></li>
- <li><a href="#highlights">HIGHLIGHTS</a></li>
- <li><a href="#navigation">NAVIGATION</a></li>
- <li><a href="#cascading_style_sheets">CASCADING STYLE SHEETS</a></li>
- <li><a href="#environment_variables">ENVIRONMENT VARIABLES</a></li>
- <li><a href="#input_data_validation">INPUT DATA VALIDATION</a></li>
- <li><a href="#xml_dtd">XML DTD</a></li>
- <li><a href="#xml_file_format">XML FILE FORMAT</a></li>
- <li><a href="#nested_forms">NESTED FORMS</a></li>
- <li><a href="#required_modules">REQUIRED MODULES</a></li>
- <li><a href="#author">AUTHOR</a></li>
- <li><a href="#licence">LICENCE</a></li>
-</ul>
-<!-- INDEX END -->
-
-<hr />
-<p>
-</p>
-<h1><a name="name">NAME</a></h1>
-<p><code>CGI::Formalware</code> - Convert an XML file into a suite of CGI forms.</p>
-<p>
-</p>
-<hr />
-<h1><a name="synopsis">SYNOPSIS</a></h1>
-<p>In your browser, type: localhost/cgi-bin/x.pl</p>
-<p>where x.pl contains nothing more than:</p>
-<pre>
- #!perl -w
- use strict;
- use lib 'C:/Perl';
- use lib 'C:/Perl/Scripts/General'; # Ie $PERL5LIB.
- use CGI::Formalware;
- my($form) = CGI::Formalware -> new({form2file => 1, debug => 1});
- $form -> process();
- exit(0);</pre>
-<p>Upon starting, <code>CGI::Formalware</code> asks for the name of your XML file, which
-is assumed to be in cgi-bin/.</p>
-<p>
-</p>
-<hr />
-<h1><a name="description">DESCRIPTION</a></h1>
-<p>To provide a type of repository for frequently used scripts, which can then be executed
-locally or remotely (via Net::Telnet), by just entering a password (for remote scripts),
-and clicking.</p>
-<p>
-</p>
-<hr />
-<h1><a name="installation">INSTALLATION</a></h1>
-<p>You install <code>CGI::Formalware</code>, as you would install any perl module library,
-by running these commands:</p>
-<pre>
- perl Makefile.PL
- make
- make test
- make install</pre>
-<p>If you want to install a private copy of <code>CGI::Formalware</code> in your home
-directory, then you should try to produce the initial Makefile with
-something like this command:</p>
-<pre>
- perl Makefile.PL LIB=~/perl
- or
- perl Makefile.PL LIB=C:/Perl/Site/Lib</pre>
-<p>If, like me, you don't have permission to write man pages into unix system
-directories, use:</p>
-<pre>
- make pure_install</pre>
-<p>instead of make install. This option is secreted in the middle of p 414 of the
-second edition of the dromedary book.</p>
-<p>
-</p>
-<hr />
-<h1><a name="audience">AUDIENCE</a></h1>
-<p>Webmasters.</p>
-<p>
-</p>
-<hr />
-<h1><a name="security">SECURITY</a></h1>
-<p>None. Even worse, <code>CGI::Formalware</code> is designed to circumvent a web server's
-concept of what Apache calls DocumentRoot.</p>
-<p>
-</p>
-<hr />
-<h1><a name="constructor_new">CONSTRUCTOR new</a></h1>
-<p>new takes either no parameters, or an anonymous hash. See the example above.
-Keys and values recognized are:</p>
-<ul>
-<li></li>
-debug => 1 means turn on debugging. At the moment this opens and closes the
-file CGI-Formalware.log, but does not write anything to it
-<p></p>
-<li></li>
-form2file => 1 means output each form to a file, using the name given
-by the form's formFileName attribute. The forms are written to cgi-bin/.
-If the form has no such attribute, this option is ignored. See example below
-<p></p>
-<li></li>
-timeScripts => 1 means report elapsed time at the end of each script's output
-<p></p></ul>
-<p>
-</p>
-<hr />
-<h1><a name="highlights">HIGHLIGHTS</a></h1>
-<ul>
-<li></li>
-Read an XML file, whose format is fixed, and generate a suite of CGI forms
-<p></p>
-<li></li>
-A cascading style sheet can be specified for each form individually
-<p></p>
-<li></li>
-A Table of Contents may appear on each form
-<p></p>
-<li></li>
-Each form is more-or-less assumed to contain a list of scripts
-<p></p>
-<li></li>
-Tokens in the XML correspond to a few functions available in Lincoln Stein's
-CGI.pm. Available tokens are:
-<ul>
-<li></li>
-fileField
-<pre>
- <fileField
- name = 'fileName'
- prompt = 'Filename: '
- size = '60'
- override = '0'
- /></pre>
-<p></p>
-<li></li>
-horizontalRule
-<pre>
- <horizontalRule /></pre>
-<p></p>
-<li></li>
-paragraph
-<pre>
- <paragraph /></pre>
-<pre>
- <paragraph text = 'Output a comment' /></pre>
-<p></p>
-<li></li>
-radioGroup
-<pre>
- <radioGroup
- name = 'serverName'
- prompt = 'Server name: '
- value = 'Example|Simple|Test'
- columns = '1' # Optional. Defaults to '1'. Use a string, not a digit
- /></pre>
-<p></p>
-<li></li>
-textField
-<pre>
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- /></pre>
-<p></p></ul>
-<p>Over time, more functions will be added.</p>
-<li></li>
-A textField with the name 'password' is treated as a password field. Also,
-the entity 'script' defines a Unix- or DOS-type batch file
-<p></p>
-<li></li>
-These entities produce on-screen fields, or, in the case of the scripts, a
-vertical array of radio buttons
-<p></p>
-<li></li>
-So, to run a script you fill in whatever fields the script uses and then select
-that script
-<p></p>
-<li></li>
-Macros in the scripts, eg %fileName% are expanded with the current value of the
-field whose name appears between the % signs
-<p></p>
-<li></li>
-A script whose last line is 'ftp <strong>-n</strong> <strong>-v</strong>' is recognized and handled specially.
-Your form must contain textFields called 'host', 'username' and 'password' and
-'fileName'. A binary 'get' is performed. This will be made more flexible one day
-<p></p>
-<li></li>
-Scripts have an attribute 'type', which can be 'local' or 'remote'.
-<p>Remote scripts are passed to Net::Telnet, on the assumption that you know what
-you are doing. Your form must contain textFields called 'host', 'username' and
-'password'</p>
-<p></p></ul>
-<p>
-</p>
-<hr />
-<h1><a name="navigation">NAVIGATION</a></h1>
-<p>Forms are linked with 'Previous form', 'Next form' buttons.</p>
-<p>Any previously-entered textFields, except those whose name is 'password', are
-remembered when you return to a form. This is very convenient.</p>
-<p>The password values are zapped by CGI.pm, not by me. This is a security feature.
-It means you can walk away from your system and not have someone gain automatic
-access to a remote system.</p>
-<p>
-</p>
-<hr />
-<h1><a name="cascading_style_sheets">CASCADING STYLE SHEETS</a></h1>
-<p>Each form entity may have a 'css' attribute, giving the name of the CSS file for
-that form. These attribute values are like '/CGI-Formalware.css', which, under
-Apache, means this value is prefixed with DocumentRoot. That is, the path to the
-CSS is a URI, and will not be seen if in cgi-bin/.</p>
-<p>The compulsory elements are: H1, H2 and P.TOC.</p>
-<p>Herewith a sample:</p>
-<pre>
- H1
- {
- font-size: 20pt;
- alignment: center;
- color: teal;
- }</pre>
-<pre>
- H2
- {
- font-size: 16pt;
- font-style: italic;
- color: maroon;
- }</pre>
-<pre>
- P.TOC
- {
- font-size: 12pt;
- color: white;
- background-color: blue;
- }</pre>
-<p>
-</p>
-<hr />
-<h1><a name="environment_variables">ENVIRONMENT VARIABLES</a></h1>
-<p>None.</p>
-<p>
-</p>
-<hr />
-<h1><a name="input_data_validation">INPUT DATA VALIDATION</a></h1>
-<p>These checks are performed:</p>
-<ul>
-<li></li>
-Each forms entity may have a 'tocEntry' attribute. If present, and if
-the tocVisible attribute is 'true', then a Table of Contents is put on
-each form, headed by this text. The default is 'Contents'
-<p></p>
-<li></li>
-Each forms entity may have a 'tocVisible' attribute. If its value is 'True',
-then a Table of Contents is put on each form, headed by the value of
-'tocEntry'. The default is 'True'
-<p></p>
-<li></li>
-Each form entity must have 'heading' and 'tocEntry' attributes
-<p></p>
-<li></li>
-Each form entity must have a unique 'heading' attribute
-<p></p>
-<li></li>
-Each form entity may have a unique 'formFileName' attribute. If present, then
-this file name is used to output the form to a file if the constructor option
-new({form2file => 1}) is used
-<p></p>
-<li></li>
-Each fileField entity must have 'name', 'prompt', 'value' and 'size' attributes
-<p></p>
-<li></li>
-Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes
-<p></p>
-<li></li>
-Each scripts entity must have a 'heading' attribute
-<p></p>
-<li></li>
-Each script entity must have 'heading', 'type' and 'line' attributes
-<p></p>
-<li></li>
-Each script entity must have a unique 'heading' attribute
-<p></p>
-<li></li>
-Each script entity's 'type' attribute must be 'local' or 'remote'
-<p></p></ul>
-<p>
-</p>
-<hr />
-<h1><a name="xml_dtd">XML DTD</a></h1>
-<p>TBA.</p>
-<p>
-</p>
-<hr />
-<h1><a name="xml_file_format">XML FILE FORMAT</a></h1>
-<p>Herewith a sample:</p>
-<pre>
- <forms
- tocEntry = 'Forms'
- tocVisible = 'True'
- >
- <form
- heading = 'Unix Command Menu'
- tocEntry = 'Unix menu'
- css = '/CGI-Formalware.css'
- formFileName = '1.html'
- >
- <horizontalRule /></pre>
-<pre>
- <radioGroup
- name = 'host'
- prompt = 'Host: '
- value = 'bigBox|littleBox'
- /></pre>
-<pre>
- <paragraph /></pre>
-<pre>
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- /></pre>
-<pre>
- <textField
- name = 'password'
- prompt = ' Password: '
- value = ''
- size = '15'
- override = '0'
- /></pre>
-<pre>
- <horizontalRule /></pre>
-<pre>
- <scripts
- heading = 'Unix Scripts'
- numberScripts = 'Yes'
- >
- <script
- heading = 'Files in home directory'
- type = 'remote'
- line1 = 'dir'
- />
- <script
- heading = 'Tags in repository'
- type = 'remote'
- line1 = 'cd $M'
- line2 = 'getTags'
- />
- </scripts>
- </form></pre>
-<pre>
- <form
- heading = 'DOS Command Menu'
- tocEntry = 'DOS menu'
- ></pre>
-<pre>
- <horizontalRule /></pre>
-<pre>
- <radioGroup
- name = 'host'
- prompt = 'Host: '
- value = 'bigBox|littleBox'
- /></pre>
-<pre>
- <paragraph text = 'Enter a username and a password.' /></pre>
-<pre>
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- /></pre>
-<pre>
- <textField
- name = 'password'
- prompt = ' Password: '
- value = ''
- size = '15'
- override = '0'
- /></pre>
-<pre>
- <horizontalRule /></pre>
-<pre>
- <fileField
- name = 'fileName'
- prompt = 'Filename: '
- size = '60'
- override = '0'
- /></pre>
-<pre>
- <horizontalRule /></pre>
-<pre>
- <scripts
- heading = 'PC Scripts'
- ></pre>
-<pre>
- <script
- heading = 'Files in root directory'
- type = 'local'
- line1 = 'cd \'
- line2 = 'dir'
- />
- <script
- heading = 'FTP something somewhere'
- type = 'local'
- line1 = 'ftp -n -v'
- />
- <script
- heading = 'Untar a file'
- type = 'local'
- line1 = 'cd \'
- line2 = 'tar mxvzf %fileName%'
- />
- </scripts>
- </form>
- </forms></pre>
-<p>
-</p>
-<hr />
-<h1><a name="nested_forms">NESTED FORMS</a></h1>
-<p>Nope, I don't recognize them. Maybe one day...</p>
-<p>
-</p>
-<hr />
-<h1><a name="required_modules">REQUIRED MODULES</a></h1>
-<ul>
-<li></li>
-CGI
-<p></p>
-<li></li>
-Net::Telnet
-<p></p>
-<li></li>
-XML::DOM
-<p></p></ul>
-<p>
-</p>
-<hr />
-<h1><a name="author">AUTHOR</a></h1>
-<p><code>CGI::Formalware</code> was written by Ron Savage <em><<a href="mailto:ron at savage.net.au">ron at savage.net.au</a>></em>
-in 1999.</p>
-<p>Available from <a href="http://savage.net.au/Perl.html.">http://savage.net.au/Perl.html.</a></p>
-<p>
-</p>
-<hr />
-<h1><a name="licence">LICENCE</a></h1>
-<p>Australian copyright (c) 1999 Ron Savage.</p>
-<pre>
- All Programs of mine are 'OSI Certified Open Source Software';
- you can redistribute them and/or modify them under the terms of
- The Artistic License, a copy of which is available at:
- <a href="http://www.opensource.org/licenses/index.html">http://www.opensource.org/licenses/index.html</a></pre>
-
-</body>
-
-</html>
Deleted: packages/libcgi-formalware-perl/trunk/Formalware.pm
===================================================================
--- packages/libcgi-formalware-perl/trunk/Formalware.pm 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/Formalware.pm 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,1333 +0,0 @@
-package CGI::Formalware;
-
-# Name:
-# CGI::Formalware.
-#
-# Documentation:
-# POD-style documentation is at the end. Extract it with pod2html.*.
-#
-#
-# Test environment:
-# Apache V 1.3.4, 1.3.6, 1.3.9, 1.3.12 for Windows.
-#
-# Note:
-# tab = 4 spaces || die.
-#
-# Author:
-# Ron Savage <ron at savage.net.au>
-# Home page: http://savage.net.au/index.html
-#
-# Licence:
-# Australian copyright (c) 1999-2002 Ron Savage.
-#
-# All Programs of mine are 'OSI Certified Open Source Software';
-# you can redistribute them and/or modify them under the terms of
-# The Artistic License, a copy of which is available at:
-# http://www.opensource.org/licenses/index.html
-
-use strict;
-
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-
-require Exporter;
-
- at ISA = qw(Exporter);
-
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-
- at EXPORT = qw();
-
-$VERSION = '1.11';
-
-# Preloaded methods go here.
-# -----------------------------------------------------------------
-
-use constant CURRENT_FORM_STRING => 'currentForm';
-use constant DEBUG_FILE_NAME_STRING => 'CGI-Formalware.log';
-use constant FILE_NAME_STRING => 'fileName';
-use constant NEXT_FORM_STRING => 'Next form';
-use constant PREVIOUS_FORM_STRING => 'Previous form';
-use constant SCRIPT_HEADING_STRING => 'scriptHeading';
-use constant SUBMIT_STRING => 'Submit';
-use constant XML_FILE_NAME_STRING => 'xmlFileName';
-
-use vars qw($attributes $text);
-use vars qw(@attribute @element);
-use vars qw(%fieldName);
-use vars qw(%fieldNameSeen);
-use vars qw($formCountPhase1);
-use vars qw($formCountPhase2);
-use vars qw(%formFileNameSeen);
-use vars qw(%formHeadingSeen);
-use vars qw($html);
-use vars qw($indentLevel $indentPrefix);;
-use vars qw($myself); # An alias for use in non-object subs.
-use vars qw(%numberScripts);
-use vars qw(%script);
-use vars qw(%scriptCount);
-use vars qw(%scriptHeadingMenu);
-use vars qw(%scriptHeadingSeen);
-use vars qw(%scriptType);
-use vars qw(@tableOfContents);
-use vars qw(%tableOfContents);
-use vars qw($xmlFileName);
-
-use CGI ':standard';
-use CGI::Carp qw(carpout fatalsToBrowser);
-use Net::Telnet;
-use XML::DOM;
-
-# -----------------------------------------------------------------
-
-($attributes, $text) = ('', '');
-($html) = {};
-($indentLevel, $indentPrefix) = (0, '');
-($formCountPhase1) = 0;
-($formCountPhase2) = 0;
-
-# -----------------------------------------------------------------
-
-sub charHandlerPhase1
-{
- my($expat, $string) = @_;
-
- # Trim whitespace.
- $string =~ s/^\s+//;
- $string =~ s/\s+$//;
-
- $text .= "$indentPrefix$string" if ($string);
-
-} # End of charHandlerPhase1.
-
-# -----------------------------------------------------------------
-
-sub charHandlerPhase2
-{
- my($expat, $string) = @_;
-
- # Trim whitespace.
- $string =~ s/^\s+//;
- $string =~ s/\s+$//;
-
- $text .= "$indentPrefix$string" if ($string);
-
-} # End of charHandlerPhase2.
-
-# -----------------------------------------------------------------
-
-sub endHandlerPhase1
-{
- my($expat, $element) = @_;
-
- &popIndent();
-
- # Trim whitespace.
- $text =~ s/^\s+//;
- $text =~ s/\s+$//;
-
- # Gain access to the attributes of the current element, and
- # via the top-of-stacks, to the parent's element and attributes.
- pop(@element);
- my($attribute) = pop(@attribute);
-
- $text = '';
-
-} # End of endHandlerPhase1.
-
-# -----------------------------------------------------------------
-
-sub endHandlerPhase2
-{
- my($expat, $element) = @_;
-
- &popIndent();
-
- # Trim whitespace.
- $text =~ s/^\s+//;
- $text =~ s/\s+$//;
-
- # Gain access to the attributes of the current element, and
- # via the top-of-stacks, to the parent's element and attributes.
- pop(@element);
- my($attribute) = pop(@attribute);
-
- if ($element =~ /^form$/i)
- {
- # Due to bugs in CGI.pm (around V 2.56), the override and default
- # options must appear before the value option.
- # Also, the override and default options must be used
- # when there is only 1 radio button. If not, then the
- # one and only button is not selected.
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- radio_group({name => SCRIPT_HEADING_STRING, cols => 1,
- override => 1,
- default => ${$scriptHeadingMenu{$formCountPhase2} }[0],
- value => \@{$scriptHeadingMenu{$formCountPhase2} } }),
- '</TD>', '</TR>');
-
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>', hr(), p(),
- submit({name => SUBMIT_STRING, value => SUBMIT_STRING}), reset() );
-
- # After the first form...
- if ($formCountPhase2 > 1)
- {
- # Add previousForm button.
- push(@{$$html{$formCountPhase2} },
- submit({name => SUBMIT_STRING, value => PREVIOUS_FORM_STRING}) );
- }
-
- # Before the last form...
- if ($formCountPhase2 < $formCountPhase1)
- {
- push(@{$$html{$formCountPhase2} },
- submit({name => SUBMIT_STRING, value => NEXT_FORM_STRING}) );
- }
-
- push(@{$$html{$formCountPhase2} }, '</TD>', '</TR>', '</TBODY>',
- '</TABLE>', '</TD>', '</TR>', '</TABLE>');
- push(@{$$html{$formCountPhase2} },
- hidden({name => XML_FILE_NAME_STRING, value => $xmlFileName, override => 1}),
- hidden({name => CURRENT_FORM_STRING, value => $formCountPhase2, override => 1}) );
-
- # End outputting HTML.
- push(@{$$html{$formCountPhase2} }, end_form(), end_html() );
-
- $myself -> writeFile($$attribute{'formFileName'}, $$html{$formCountPhase2})
- if ($myself -> {'form2file'});
- }
-
- # horizontalRule.
- if ($element =~ /^horizontalRule$/i)
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- hr(), '</TD>', '</TR>');
- }
-
- # paragraph.
- if ($element =~ /^paragraph$/i)
- {
- my($text) = defined($$attribute{'text'}) ? $$attribute{'text'} : '';
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- p($text), '</TD>', '</TR>');
- }
-
- # radioGroup.
- if ($element =~ /^radioGroup$/i)
- {
- my($columns) = defined($$attribute{'columns'}) ? $$attribute{'columns'} : '1';
- my(@value) = split(/\|/, $$attribute{'value'});
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- $$attribute{'prompt'},
- radio_group({name => $$attribute{'name'}, cols => $columns, value => \@value}),
- '</TD>', '</TR>');
- }
-
- # textField.
- if ($element =~ /^textField$/i)
- {
- if ($$attribute{'name'} =~ /^password$/i)
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- $$attribute{'prompt'},
- password_field({name => $$attribute{'name'},
- value => $$attribute{'value'}, size => $$attribute{'size'} }),
- '</TD>', '</TR>');
- }
- else
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- $$attribute{'prompt'},
- textfield({name => $$attribute{'name'},
- value => $$attribute{'value'}, size => $$attribute{'size'} }),
- '</TD>', '</TR>');
- }
- }
-
- # fileField.
- if ($element =~ /^fileField$/i)
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- $$attribute{'prompt'},
- filefield({name => $$attribute{'name'}, size => $$attribute{'size'} }),
- '</TD>', '</TR>');
- }
-
- # scripts.
- if ($element =~ /^scripts$/i)
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
- h2($$attribute{'heading'}), '</TD>', '</TR>');
- }
-
- # script.
- if ($element =~ /^script$/i)
- {
- my($script) = [];
-
- for (sort keys %$attribute)
- {
- push(@$script, $$attribute{$_}) if (/^line\d{1,2}$/i);
- }
-
- $scriptCount{$formCountPhase2}++;
- my($number) = '';
- $number = sprintf("%2i: ", $scriptCount{$formCountPhase2})
- if ($numberScripts{$formCountPhase2});
- $number = "$number$$attribute{'heading'}";
- push(@{$scriptHeadingMenu{$formCountPhase2} }, $number);
- ${$script{$formCountPhase2} }{$number} = $script;
- ${$scriptType{$formCountPhase2} }{$number} = $$attribute{'type'};
- }
-
- # Gather field names for substitution into scripts.
- if ( ($element =~ /^(fileField|radioGroup|textField)$/i) )
- {
- ${$fieldName{$formCountPhase2} }{$$attribute{'name'} } = $1;
- }
-
- $text = '';
-
-} # End of endHandlerPhase2.
-
-# -----------------------------------------------------------------
-
-sub expandMacros
-{
- my($self, $script, $fieldName) = @_;
-
- for (@$script)
- {
- s/\t/ /g;
- s/^\s+//;
- s/\s+$//;
-
- next if (! $_);
-
- my($name);
-
- for $name (keys(%$fieldName) )
- {
- my($value) = param($name) || '';
- s/%$name%/$value/g;
- }
- }
-
- # Discard null lines.
- @$script = grep(length, @$script);
-
- @$script;
-
-} # End of expandMacros.
-
-# -----------------------------------------------------------------
-
-sub getXMLFileName
-{
- my($self) = @_;
-
- my($heading) = 'Generate CGI Forms';
-
- # Use "SUBMIT_STRING ", not just SUBMIT_STRING, so the if test in the main line,
- # if ($submission eq SUBMIT_STRING), returns false.
-
- print header(), start_html(title => $heading),
- start_form(), h1($heading), hr(),
- 'Please enter the name of the XML file which will be used to generate the CGI forms. ',
- p(),
- 'This can be any DOS file path, eg D:\Temp\menu.xml. Also, .\menu.xml uses cgi-bin\: ',
- hidden({name => CURRENT_FORM_STRING, value => 1, override => 1}),
- p(), textfield({name => XML_FILE_NAME_STRING, value => '', size => 50, override => 1}),
- hr(), submit({name => SUBMIT_STRING, value => (SUBMIT_STRING . ' ')}),
- end_form(), end_html();
-
-# <FORM ENCTYPE="multipart/form-data" ACTION="/cgi-bin/upload.cgi" METHOD="POST">
-# <INPUT TYPE="FILE" NAME="file-to-upload-01" SIZE="35">
-
-} # End of getXMLFileName.
-
-#-------------------------------------------------------------------
-
-sub new
-{
- my($class, $optionRef) = @_;
- $class = ref($class) || $class;
- my($self) = (ref($optionRef) eq 'HASH') ? $optionRef : {};
- $self -> {'debug'} = '' if (! defined($self -> {'debug'}) );
- $self -> {'form2file'} = '' if (! defined($self -> {'form2file'}) );
- $self -> {'timeScripts'} = '' if (! defined($self -> {'timeScripts'}) );
- $myself = $self; # An alias for use in non-object subs.
-
- return bless $self, $class;
-
-} # End of new.
-
-# -----------------------------------------------------------------
-
-sub phase1
-{
- my($self, $xmlFileName) = @_;
-
- # Declare the parser.
- my($parser) = new XML::DOM::Parser;
-
- $parser -> setHandlers
- (
- Start => \&startHandlerPhase1,
- End => \&endHandlerPhase1,
- Char => \&charHandlerPhase1,
- );
-
- # Parse the document and call the handlers.
- my($doc) = $parser -> parsefile($xmlFileName);
-
-} # End of phase1.
-
-# -----------------------------------------------------------------
-
-sub phase2
-{
- my($self, $xmlFileName) = @_;
-
- # Declare the parser.
- my($parser) = new XML::DOM::Parser;
-
- $parser -> setHandlers
- (
- Start => \&startHandlerPhase2,
- End => \&endHandlerPhase2,
- Char => \&charHandlerPhase2,
- );
-
- # Parse the document and call the handlers.
- my($doc) = $parser -> parsefile($xmlFileName);
-
-} # End of phase2.
-
-# -----------------------------------------------------------------
-
-sub popIndent
-{
- $indentLevel--;
- $indentPrefix = "\t" x $indentLevel;
-
-} # End of popIndent.
-
-# -----------------------------------------------------------------
-
-sub process
-{
- my($self) = @_;
-
- if ($self -> {'debug'})
- {
- open(DEBUG, '>> ' . DEBUG_FILE_NAME_STRING) || croak("Can't open(> " . DEBUG_FILE_NAME_STRING . "): $!\n");
- carpout(\*DEBUG);
- }
-
- if (param() )
- {
- $xmlFileName = param(XML_FILE_NAME_STRING);
-
- croak("Can't find XML file: $xmlFileName\n") if (! -e $xmlFileName);
-
- # Parse once to count things.
- $self -> phase1($xmlFileName);
-
- # Parse again to do things.
- $self -> phase2($xmlFileName);
-
- my($submission) = param(SUBMIT_STRING) || '';
-
- # Run a script and send the output to the browser, or...
- if ($submission eq SUBMIT_STRING)
- {
- my($scriptHeading) = param(SCRIPT_HEADING_STRING);
- my($formCount) = param(CURRENT_FORM_STRING);
- my($scriptType) = ${$scriptType{$formCount} }{$scriptHeading};
- $self -> runLocalScript($scriptHeading, $formCount) if ($scriptType =~ /^local$/i);
- $self -> runRemoteScript($scriptHeading, $formCount) if ($scriptType =~ /^remote$/i);
- }
- else
- {
- # Send a stored form to the browser.
- # This is the non-TOC code.
- my($next) = param(CURRENT_FORM_STRING);
- $next -= 1 if ($submission eq PREVIOUS_FORM_STRING);
- $next += 1 if ($submission eq NEXT_FORM_STRING);
-
- # This is the TOC code.
- my($page);
-
- for ($page = 1; $page <= ($#tableOfContents + 1); $page++)
- {
- $next = $page if (param($page) );
- }
-
- for (@{$$html{$next} })
- {
- print "$_\n";
- }
- }
- }
- else
- {
- $self -> getXMLFileName();
- }
-
- close(DEBUG) if ($self -> {'debug'});
-
-} # End of process.
-
-# -----------------------------------------------------------------
-
-sub pushIndent
-{
- $indentLevel++;
- $indentPrefix = "\t" x $indentLevel;
-
-} # End of pushIndent;
-
-# -----------------------------------------------------------------
-# Read a file. Pass in $chomp == 0 to stop chomping.
-
-sub readFile
-{
- my($self, $fileName, $chomp) = @_;
- $chomp = 1 if ($#_ == 0);
-
- open(INX, $fileName) || croak("Can't open($fileName): $!\n");
- my(@line) = <INX>;
- close(INX);
- chomp(@line) if ($chomp != 0);
-
- \@line;
-
-} # End of readFile.
-
-# -----------------------------------------------------------------
-
-sub runLocalScript
-{
- my($self, $heading, $formCount) = @_;
-
- my($script) = ${$script{$formCount} }{$heading};
- my($fieldName) = $fieldName{$formCount};
- @$script = $self -> expandMacros($script, $fieldName);
- my($scriptFileName) = 'script.bat';
-
- $self -> writeFile($scriptFileName, $script);
-
- # Handle FTP here.
- if ($$script[$#{$script}] =~ /^ftp\s+(-n\s+-v|-v\s+-n)$/i)
- {
- # Create a text file to input to FTP.
- open(OUT, "> $scriptFileName.txt") || croak("Can't open(> $scriptFileName.txt): $!\n");
- print OUT 'open ', param('host'), "\n";
- print OUT 'user ', param('username'), ' ', param('password'), "\n";
- print OUT "bin\n";
- print OUT 'get ', param(FILE_NAME_STRING), "\n";
- print OUT "quit\n";
- close(OUT);
-
- # Patch batch file to run FTP.
- my($cmd) = $self -> readFile($scriptFileName, 1);
- $$cmd[$#{$cmd}] = "type $scriptFileName.txt | $$script[$#{$script}]\n";
- $self -> writeFile($scriptFileName, $cmd);
- }
-
- my($startTime) = time();
- my(@log) = `$scriptFileName`;
- unlink($scriptFileName);
- unlink("$scriptFileName.txt");
- my($time) = time() - $startTime;
-
- print header(), start_html($heading), start_form(), h1($heading), hr(), '<PRE>';
-
- for (@log)
- {
- # Convert anything which looks like an HTML tag to something else.
- # In particular, XML, & DOS dir listings containing 'cgi-bin <DIR>'.
- s/<(.+?)>/<$1>/g;
- print $_;
- }
-
- 1 while ($time =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/);
-
- if ($self -> {'timeScripts'})
- {
- print '</PRE>', hr(), "That took $time second",
- ($time == 1) ? '' : 's', '. ', end_form(), end_html();
- }
- else
- {
- print '</PRE>', hr(), end_form(), end_html();
- }
-
-} # End of runLocalScript.
-
-# -----------------------------------------------------------------
-
-sub runRemoteScript
-{
- my($self, $heading, $formCount) = @_;
-
- my($script) = ${$script{$formCount} }{$heading};
- my($fieldName) = $fieldName{$formCount};
- @$script = $self -> expandMacros($script, $fieldName);
- my($scriptLogName) = "script.log";
- my($prompt) = '/\[\d+\] /';
- my($actualCommand) = '';
- my($startTime) = time();
-
- unlink($scriptLogName);
-
- # When we leave this block we kill off $session.
- # Then, unlink($scriptLogName) works.
- {
- my($session) = new Net::Telnet
- (
- Timeout => 3600,
- Prompt => $prompt,
- );
-
- $session -> input_log($scriptLogName);
- $session -> open(param('host') );
- $session -> login(param('username'), param('password') );
-
- # Warning: Use spaces and not tabs to separated fields within these strings.
- # Net::Telnet V 3.01 strips the tabs and does not replace them with a space.
-
- for (@$script)
- {
- $actualCommand = $_ if (! $actualCommand);
- $session -> cmd($_);
- }
-
- $session -> close();
- }
-
- my($time) = time() - $startTime;
- my($log) = $self -> readFile($scriptLogName, 1);
-
- unlink($scriptLogName);
-
- print header(), start_html($heading), start_form(), h1($heading), hr(),
- hidden({name => SUBMIT_STRING, value => SUBMIT_STRING, override => 1}),
- '<PRE>';
-
- # Print nothing until we find the command we sent.
- my($foundCommand) = 0;
- $actualCommand = quotemeta($actualCommand);
-
- for (@$log)
- {
- # Convert anything which looks like an HTML tag to something else.
- # In particular, XML, & DOS dir listings containing 'cgi-bin <DIR>'.
- s/<(.+?)>/<$1>/g;
-
- $foundCommand = 1 if (/$actualCommand\s*$/);
- print "$_\n" if ($actualCommand);
- }
-
- 1 while ($time =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/);
-
- if ($self -> {'timeScripts'})
- {
- print '</PRE>', hr(), "That took $time second",
- ($time == 1) ? '' : 's', '. ', end_form(), end_html();
- }
- else
- {
- print '</PRE>', hr(), end_form(), end_html();
- }
-
-} # End of runRemoteScript.
-
-# -----------------------------------------------------------------
-
-sub startHandlerPhase1
-{
- my($expat, $element, %attribute) = @_;
-
- # Gain access to the attributes of the current element, and
- # via the top-of-stacks, to the parent's element and attributes.
- push(@element, $element);
- push(@attribute, \%attribute);
-
- if ($element =~ /^form$/i)
- {
- croak("Each form entity must have 'heading' and 'tocEntry' attributes\n")
- if (! defined($attribute{'heading'}) ||
- ! defined($attribute{'tocEntry'}) );
-
- croak("Each form entity must have a unique 'formFileName' attribute\n")
- if (defined($formFileNameSeen{$attribute{'formFileName'} }) );
-
- croak("Each form entity must have a unique 'heading' attribute\n")
- if (defined($formHeadingSeen{$attribute{'heading'} }) );
-
- $formCountPhase1++;
-
- $formFileNameSeen{$attribute{'formFileName'} } = $formCountPhase1;
- $formHeadingSeen{$attribute{'heading'} } = $formCountPhase1;
-
- push(@tableOfContents, $attribute{'tocEntry'});
- }
-
- if ($element =~ /^radioGroup$/i)
- {
- croak("Each radioGroup entity must have 'name', 'prompt', and 'value' attributes\n")
- if (! defined($attribute{'name'}) ||
- ! defined($attribute{'prompt'}) ||
- ! defined($attribute{'value'}) );
- }
-
- if ($element =~ /^textField$/i)
- {
- croak("Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes\n")
- if (! defined($attribute{'name'}) ||
- ! defined($attribute{'prompt'}) ||
- ! defined($attribute{'value'}) ||
- ! defined($attribute{'size'}) );
- }
-
- if ($element =~ /^fileField$/i)
- {
- croak("Each fileField entity must have 'name', 'prompt' and 'size' attributes\n")
- if (! defined($attribute{'name'}) ||
- ! defined($attribute{'prompt'}) ||
- ! defined($attribute{'size'}) );
- }
-
- if ($element =~ /^(fileField|radioGroup|textField)$/i)
- {
- croak("Each fieldField, radioGroup & textField entity must have a unique 'name' attribute (per form)\n")
- if (defined($fieldNameSeen{$formCountPhase1}{$attribute{'name'} }) );
-
- $fieldNameSeen{$formCountPhase1}{$attribute{'name'} } = $formCountPhase1;
- }
-
- if ($element =~ /^scripts$/i)
- {
- croak("Each scripts entity must have a 'heading' attribute\n")
- if (! defined($attribute{'heading'}) );
- }
-
- if ($element =~ /^script$/i)
- {
- croak("Each script entity must have 'heading', 'type' and 'line' attributes\n")
- if (! defined($attribute{'heading'}) ||
- ! defined($attribute{'type'}) ||
- ! defined($attribute{'line1'}) );
-
- croak("Each script entity must have a unique 'heading' attribute (per form)\n")
- if (defined($scriptHeadingSeen{$formCountPhase1}{$attribute{'heading'} }) );
-
- croak("Each script entity's 'type' attribute must be 'local' or 'remote'\n")
- if ($attribute{'type'} !~ /^(local|remote)$/i);
-
- $scriptHeadingSeen{$formCountPhase1}{$attribute{'heading'} } = $formCountPhase1;
- }
-
- &pushIndent();
-
-} # End of startHandlerPhase1.
-
-# -----------------------------------------------------------------
-
-sub startHandlerPhase2
-{
- my($expat, $element, %attribute) = @_;
-
- # Gain access to the attributes of the current element, and
- # via the top-of-stacks, to the parent's element and attributes.
- push(@element, $element);
- push(@attribute, \%attribute);
-
- if ($element =~ /^forms$/i)
- {
- $tableOfContents{'tocEntry'} = (defined($attribute{'tocEntry'}) ? $attribute{'tocEntry'} : 'Contents');
- $tableOfContents{'tocVisible'} = (defined($attribute{'tocVisible'}) ? $attribute{'tocVisible'} : 'True');
- }
-
- if ($element =~ /^form$/i)
- {
- $formCountPhase2++;
-
- my($author) = (defined($attribute{'author'}) ? $attribute{'author'} : 'ron at savage.net.au');
- my($heading) = $attribute{'heading'};
-
- $fieldName{$formCountPhase2} = {};
- $$html{$formCountPhase2} = [];
- $numberScripts{$formCountPhase2} = 0;
- $script{$formCountPhase2} = {};
- $scriptCount{$formCountPhase2} = 0;
- $scriptHeadingMenu{$formCountPhase2} = [];
- $scriptType{$formCountPhase2} = {};
-
- my($startHtml) =
- start_html({title => $heading, author => $author} );
- $startHtml =
- start_html({title => $heading, author => $author,
- style => {src => $attribute{'css'} } } ) if (defined($attribute{'css'}) );
-
- # Output the Table of Contents.
- push(@{$$html{$formCountPhase2} }, header(), $startHtml, start_multipart_form(),
- '<TABLE WIDTH = "100%">');
-
- if ($tableOfContents{'tocVisible'} =~ /True/i)
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD VALIGN = "Top">',
- '<TABLE>', '<THEAD>', '<TR>', '<TD>');
-
- if (defined($attribute{'css'}) )
- {
- push(@{$$html{$formCountPhase2} },
- p({class => 'TOC'}, $tableOfContents{'tocEntry'}) );
- }
- else
- {
- push(@{$$html{$formCountPhase2} }, $tableOfContents{'tocEntry'});
- }
-
- push(@{$$html{$formCountPhase2} }, '</TD>', '</TR>', '</THEAD>', '<TBODY>');
-
- my($page) = 0;
-
- for (@tableOfContents)
- {
- $page++;
-
- if (defined($attribute{'css'}) )
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
-# p({class => 'TOC'}, $_),
- submit({class => 'TOC', name => $page, value => $_}),
- '</TD>', '</TR>');
- }
- else
- {
- push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
-# $_,
- submit({name => $page, value => $_}),
- '</TD>', '</TR>');
- }
- }
-
- push(@{$$html{$formCountPhase2} }, '</TBODY>', '</TABLE>',
- '</TD>', '<TD>');
- }
-
- push(@{$$html{$formCountPhase2} }, '<TABLE>', '<THEAD>', '<TR>', '<TD>',
- h1($heading), '</TD>', '</TR>', '</THEAD>', '<TBODY>');
- }
-
- if ($element =~ /^scripts$/i)
- {
- $numberScripts{$formCountPhase2} = 1 if (defined($attribute{'numberScripts'}) &&
- ($attribute{'numberScripts'} =~ /Yes/i) );
- }
-
- &pushIndent();
-
-} # End of startHandlerPhase2.
-
-# -----------------------------------------------------------------
-
-sub writeFile
-{
- my($self, $fileName, $data) = @_;
-
- open(OUT, "> $fileName") || croak("Can't open($fileName): $!\n");
- print OUT join("\n", @{$data}), "\n";
- close(OUT);
-
-} # End of writeFile.
-
-# -----------------------------------------------------------------
-
-# Autoload methods go after =cut, and are processed by the autosplit program.
-
-1;
-
-__END__
-
-=head1 NAME
-
-C<CGI::Formalware> - Convert an XML file into a suite of CGI forms.
-
-=head1 SYNOPSIS
-
-In your browser, type: localhost/cgi-bin/x.pl
-
-where x.pl contains nothing more than:
-
- #!perl -w
- use strict;
- use lib 'C:/Perl';
- use lib 'C:/Perl/Scripts/General'; # Ie $PERL5LIB.
- use CGI::Formalware;
- my($form) = CGI::Formalware -> new({form2file => 1, debug => 1});
- $form -> process();
- exit(0);
-
-Upon starting, C<CGI::Formalware> asks for the name of your XML file, which
-is assumed to be in cgi-bin/.
-
-=head1 DESCRIPTION
-
-To provide a type of repository for frequently used scripts, which can then be executed
-locally or remotely (via Net::Telnet), by just entering a password (for remote scripts),
-and clicking.
-
-=head1 INSTALLATION
-
-You install C<CGI::Formalware>, as you would install any perl module library,
-by running these commands:
-
- perl Makefile.PL
- make
- make test
- make install
-
-If you want to install a private copy of C<CGI::Formalware> in your home
-directory, then you should try to produce the initial Makefile with
-something like this command:
-
- perl Makefile.PL LIB=~/perl
- or
- perl Makefile.PL LIB=C:/Perl/Site/Lib
-
-If, like me, you don't have permission to write man pages into unix system
-directories, use:
-
- make pure_install
-
-instead of make install. This option is secreted in the middle of p 414 of the
-second edition of the dromedary book.
-
-=head1 AUDIENCE
-
-Webmasters.
-
-=head1 SECURITY
-
-None. Even worse, C<CGI::Formalware> is designed to circumvent a web server's
-concept of what Apache calls DocumentRoot.
-
-=head1 CONSTRUCTOR new
-
-new takes either no parameters, or an anonymous hash. See the example above.
-Keys and values recognized are:
-
-=over 4
-
-=item *
-
-debug => 1 means turn on debugging. At the moment this opens and closes the
-file CGI-Formalware.log, but does not write anything to it
-
-=item *
-
-form2file => 1 means output each form to a file, using the name given
-by the form's formFileName attribute. The forms are written to cgi-bin/.
-If the form has no such attribute, this option is ignored. See example below
-
-=item *
-
-timeScripts => 1 means report elapsed time at the end of each script's output
-
-=back
-
-=head1 HIGHLIGHTS
-
-=over 4
-
-=item *
-
-Read an XML file, whose format is fixed, and generate a suite of CGI forms
-
-=item *
-
-A cascading style sheet can be specified for each form individually
-
-=item *
-
-A Table of Contents may appear on each form
-
-=item *
-
-Each form is more-or-less assumed to contain a list of scripts
-
-=item *
-
-Tokens in the XML correspond to a few functions available in Lincoln Stein's
-CGI.pm. Available tokens are:
-
-=over 4
-
-=item *
-
-fileField
-
- <fileField
- name = 'fileName'
- prompt = 'Filename: '
- size = '60'
- override = '0'
- />
-
-=item *
-
-horizontalRule
-
- <horizontalRule />
-
-=item *
-
-paragraph
-
- <paragraph />
-
- <paragraph text = 'Output a comment' />
-
-=item *
-
-radioGroup
-
- <radioGroup
- name = 'serverName'
- prompt = 'Server name: '
- value = 'Example|Simple|Test'
- columns = '1' # Optional. Defaults to '1'. Use a string, not a digit
- />
-
-=item *
-
-textField
-
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- />
-
-=back
-
-Over time, more functions will be added.
-
-=item *
-
-A textField with the name 'password' is treated as a password field. Also,
-the entity 'script' defines a Unix- or DOS-type batch file
-
-=item *
-
-These entities produce on-screen fields, or, in the case of the scripts, a
-vertical array of radio buttons
-
-=item *
-
-So, to run a script you fill in whatever fields the script uses and then select
-that script
-
-=item *
-
-Macros in the scripts, eg %fileName% are expanded with the current value of the
-field whose name appears between the % signs
-
-=item *
-
-A script whose last line is 'ftp B<-n> B<-v>' is recognized and handled specially.
-Your form must contain textFields called 'host', 'username' and 'password' and
-'fileName'. A binary 'get' is performed. This will be made more flexible one day
-
-=item *
-
-Scripts have an attribute 'type', which can be 'local' or 'remote'.
-
-Remote scripts are passed to Net::Telnet, on the assumption that you know what
-you are doing. Your form must contain textFields called 'host', 'username' and
-'password'
-
-=back
-
-=head1 NAVIGATION
-
-Forms are linked with 'Previous form', 'Next form' buttons.
-
-Any previously-entered textFields, except those whose name is 'password', are
-remembered when you return to a form. This is very convenient.
-
-The password values are zapped by CGI.pm, not by me. This is a security feature.
-It means you can walk away from your system and not have someone gain automatic
-access to a remote system.
-
-=head1 CASCADING STYLE SHEETS
-
-Each form entity may have a 'css' attribute, giving the name of the CSS file for
-that form. These attribute values are like '/CGI-Formalware.css', which, under
-Apache, means this value is prefixed with DocumentRoot. That is, the path to the
-CSS is a URI, and will not be seen if in cgi-bin/.
-
-The compulsory elements are: H1, H2 and P.TOC.
-
-Herewith a sample:
-
- H1
- {
- font-size: 20pt;
- alignment: center;
- color: teal;
- }
-
- H2
- {
- font-size: 16pt;
- font-style: italic;
- color: maroon;
- }
-
- P.TOC
- {
- font-size: 12pt;
- color: white;
- background-color: blue;
- }
-
-=head1 ENVIRONMENT VARIABLES
-
-None.
-
-=head1 INPUT DATA VALIDATION
-
-These checks are performed:
-
-=over 4
-
-=item *
-
-Each forms entity may have a 'tocEntry' attribute. If present, and if
-the tocVisible attribute is 'true', then a Table of Contents is put on
-each form, headed by this text. The default is 'Contents'
-
-=item *
-
-Each forms entity may have a 'tocVisible' attribute. If its value is 'True',
-then a Table of Contents is put on each form, headed by the value of
-'tocEntry'. The default is 'True'
-
-=item *
-
-Each form entity must have 'heading' and 'tocEntry' attributes
-
-=item *
-
-Each form entity must have a unique 'heading' attribute
-
-=item *
-
-Each form entity may have a unique 'formFileName' attribute. If present, then
-this file name is used to output the form to a file if the constructor option
-new({form2file => 1}) is used
-
-=item *
-
-Each fileField entity must have 'name', 'prompt', 'value' and 'size' attributes
-
-=item *
-
-Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes
-
-=item *
-
-Each scripts entity must have a 'heading' attribute
-
-=item *
-
-Each script entity must have 'heading', 'type' and 'line' attributes
-
-=item *
-
-Each script entity must have a unique 'heading' attribute
-
-=item *
-
-Each script entity's 'type' attribute must be 'local' or 'remote'
-
-=back
-
-=head1 XML DTD
-
-TBA.
-
-=head1 XML FILE FORMAT
-
-Herewith a sample:
-
- <forms
- tocEntry = 'Forms'
- tocVisible = 'True'
- >
- <form
- heading = 'Unix Command Menu'
- tocEntry = 'Unix menu'
- css = '/CGI-Formalware.css'
- formFileName = '1.html'
- >
- <horizontalRule />
-
- <radioGroup
- name = 'host'
- prompt = 'Host: '
- value = 'bigBox|littleBox'
- />
-
- <paragraph />
-
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <textField
- name = 'password'
- prompt = ' Password: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <horizontalRule />
-
- <scripts
- heading = 'Unix Scripts'
- numberScripts = 'Yes'
- >
- <script
- heading = 'Files in home directory'
- type = 'remote'
- line1 = 'dir'
- />
- <script
- heading = 'Tags in repository'
- type = 'remote'
- line1 = 'cd $M'
- line2 = 'getTags'
- />
- </scripts>
- </form>
-
- <form
- heading = 'DOS Command Menu'
- tocEntry = 'DOS menu'
- >
-
- <horizontalRule />
-
- <radioGroup
- name = 'host'
- prompt = 'Host: '
- value = 'bigBox|littleBox'
- />
-
- <paragraph text = 'Enter a username and a password.' />
-
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <textField
- name = 'password'
- prompt = ' Password: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <horizontalRule />
-
- <fileField
- name = 'fileName'
- prompt = 'Filename: '
- size = '60'
- override = '0'
- />
-
- <horizontalRule />
-
- <scripts
- heading = 'PC Scripts'
- >
-
- <script
- heading = 'Files in root directory'
- type = 'local'
- line1 = 'cd \'
- line2 = 'dir'
- />
- <script
- heading = 'FTP something somewhere'
- type = 'local'
- line1 = 'ftp -n -v'
- />
- <script
- heading = 'Untar a file'
- type = 'local'
- line1 = 'cd \'
- line2 = 'tar mxvzf %fileName%'
- />
- </scripts>
- </form>
- </forms>
-
-=head1 NESTED FORMS
-
-Nope, I don't recognize them. Maybe one day...
-
-=head1 REQUIRED MODULES
-
-=over 4
-
-=item *
-
-CGI
-
-=item *
-
-Net::Telnet
-
-=item *
-
-XML::DOM
-
-=back
-
-=head1 AUTHOR
-
-C<CGI::Formalware> was written by Ron Savage I<E<lt>ron at savage.net.auE<gt>>
-in 1999.
-
-Available from http://savage.net.au/Perl.html.
-
-=head1 LICENCE
-
-Australian copyright (c) 1999 Ron Savage.
-
- All Programs of mine are 'OSI Certified Open Source Software';
- you can redistribute them and/or modify them under the terms of
- The Artistic License, a copy of which is available at:
- http://www.opensource.org/licenses/index.html
-
-=cut
Modified: packages/libcgi-formalware-perl/trunk/MANIFEST
===================================================================
--- packages/libcgi-formalware-perl/trunk/MANIFEST 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/MANIFEST 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,9 +1,12 @@
+Build.PL
Changes.txt
-Formalware.pm
+examples/test.css
+examples/test.xml
+lib/CGI/Formalware.pm
Makefile.PL
-test.pl
-Formalware.html
-MANIFEST
+MANIFEST This list of files
+MANIFEST.SKIP
README
-examples/test.xml
-examples/test.css
+t/pod.t
+t/test.t
+META.yml
Added: packages/libcgi-formalware-perl/trunk/MANIFEST.SKIP
===================================================================
--- packages/libcgi-formalware-perl/trunk/MANIFEST.SKIP 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/MANIFEST.SKIP 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,4 @@
+^Build$
+^blib
+^_build
+\.tmp$
Added: packages/libcgi-formalware-perl/trunk/META.yml
===================================================================
--- packages/libcgi-formalware-perl/trunk/META.yml 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/META.yml 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,19 @@
+--- #YAML:1.0
+name: CGI-Formalware
+version: 1.13
+author:
+ - Ron Savage <ron at savage.net.au>
+abstract: Convert an XML file into a suite of CGI forms.
+license: artistic
+requires:
+ CGI: 2.45
+ Net::Telnet: 3.01
+ XML::DOM: 1.14
+build_requires:
+ Test::More: 0
+ Test::Pod: 0
+provides:
+ CGI::Formalware:
+ file: lib/CGI/Formalware.pm
+ version: 1.13
+generated_by: Module::Build version 0.2611
Modified: packages/libcgi-formalware-perl/trunk/Makefile.PL
===================================================================
--- packages/libcgi-formalware-perl/trunk/Makefile.PL 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/Makefile.PL 2006-01-10 22:01:49 UTC (rev 1889)
@@ -9,26 +9,25 @@
'AUTHOR' => 'Ron Savage (ron at savage.net.au)',
'ABSTRACT' => 'Convert an XML file into a suite of CGI forms',
) : (),
-'clean' =>
+ clean =>
{
- 'FILES' => 'blib/* Makefile MANIFEST CGI-Formalware-*'
+ FILES => 'blib/* Makefile MANIFEST CGI-Formalware-*'
},
-'dist' =>
+ dist =>
{
- 'COMPRESS' => 'gzip',
- 'SUFFIX' => 'gz'
+ COMPRESS => 'gzip',
+ SUFFIX => 'gz'
},
-'DISTNAME' => 'CGI-Formalware',
-'NAME' => 'CGI::Formalware',
-'PM' =>
+ DISTNAME => 'CGI-Formalware',
+ NAME => 'CGI::Formalware',
+ PL_FILES => {},
+ PREREQ_PM =>
{
- 'Formalware.pm' => '$(INST_LIBDIR)/Formalware.pm',
- },
-'PREREQ_PM' =>
- {
CGI => '2.45',
Net::Telnet => '3.01',
+ Test::More => 0,
+ Test::Pod => 0,
XML::DOM => '1.14',
},
-'VERSION_FROM' => 'Formalware.pm'
+ VERSION_FROM => 'lib/CGI/Formalware.pm'
);
Modified: packages/libcgi-formalware-perl/trunk/README
===================================================================
--- packages/libcgi-formalware-perl/trunk/README 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/README 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,381 +1,56 @@
-NAME
- "CGI::Formalware" - Convert an XML file into a suite of CGI forms.
+README file for CGI::Formalware.
-SYNOPSIS
- In your browser, type: localhost/cgi-bin/x.pl
+Warning: WinZip 8.1 and 9.0 both contain an 'accidental' bug which stops
+them recognizing POSIX-style directory structures in valid tar files.
+You are better off using a reliable tool such as InfoZip:
+ftp://ftp.info-zip.org/pub/infozip/
- where x.pl contains nothing more than:
+1 Installing from a Unix-like distro
+------------------------------------
+shell>gunzip CGI-Formalware-1.12.tgz
+shell>tar mxvf CGI-Formalware-1.12.tar
- #!perl -w
- use strict;
- use lib 'C:/Perl';
- use lib 'C:/Perl/Scripts/General'; # Ie $PERL5LIB.
- use CGI::Formalware;
- my($form) = CGI::Formalware -> new({form2file => 1, debug => 1});
- $form -> process();
- exit(0);
+On Unix-like systems, assuming you have installed Module::Build V 0.25+:
- Upon starting, "CGI::Formalware" asks for the name of your XML file,
- which is assumed to be in cgi-bin/.
+shell>perl Build.PL
+shell>./Build
+shell>./Build test
+shell>./Build install
-DESCRIPTION
- To provide a type of repository for frequently used scripts, which can
- then be executed locally or remotely (via Net::Telnet), by just entering
- a password (for remote scripts), and clicking.
+On MS Windows-like systems, assuming you have installed Module::Build V 0.25+:
-INSTALLATION
- You install "CGI::Formalware", as you would install any perl module
- library, by running these commands:
+shell>perl Build.PL
+shell>perl Build
+shell>perl Build test
+shell>perl Build install
- perl Makefile.PL
- make
- make test
- make install
+Alternately, without Module::Build, you do this:
- If you want to install a private copy of "CGI::Formalware" in your home
- directory, then you should try to produce the initial Makefile with
- something like this command:
+Note: 'make' on MS Windows-like systems may be called 'nmake' or 'dmake'.
- perl Makefile.PL LIB=~/perl
- or
- perl Makefile.PL LIB=C:/Perl/Site/Lib
+shell>perl Makefile.PL
+shell>make
+shell>make test
+shell>su (for Unix-like systems)
+shell>make install
+shell>exit (for Unix-like systems)
- If, like me, you don't have permission to write man pages into unix
- system directories, use:
+On all systems:
- make pure_install
+Run Formalware.pm through you favourite pod2html translator.
- instead of make install. This option is secreted in the middle of p 414
- of the second edition of the dromedary book.
+If you are using my fancy-pom2.pl, with its 'default.css' file installed in
+/apache2/htdocs/css/, you'd do:
-AUDIENCE
- Webmasters.
+shell>perl fancy-pom2.pl html -css Formalware.pm > /apache2/htdocs/Formalware.html
-SECURITY
- None. Even worse, "CGI::Formalware" is designed to circumvent a web
- server's concept of what Apache calls DocumentRoot.
+or perhaps something like:
-CONSTRUCTOR new
- new takes either no parameters, or an anonymous hash. See the example
- above. Keys and values recognized are:
+shell>perl fancy-pom2.pl html -css Formalware.pm > /perl/html/site/lib/CGI/Formalware.html
- * debug => 1 means turn on debugging. At the moment this opens and
- closes the file CGI-Formalware.log, but does not write anything to
- it
-
- * form2file => 1 means output each form to a file, using the name
- given by the form's formFileName attribute. The forms are written to
- cgi-bin/. If the form has no such attribute, this option is ignored.
- See example below
-
- * timeScripts => 1 means report elapsed time at the end of each
- script's output
-
-HIGHLIGHTS
- * Read an XML file, whose format is fixed, and generate a suite of CGI
- forms
-
- * A cascading style sheet can be specified for each form individually
-
- * A Table of Contents may appear on each form
-
- * Each form is more-or-less assumed to contain a list of scripts
-
- * Tokens in the XML correspond to a few functions available in Lincoln
- Stein's CGI.pm. Available tokens are:
-
- * fileField
-
- <fileField
- name = 'fileName'
- prompt = 'Filename: '
- size = '60'
- override = '0'
- />
-
- * horizontalRule
-
- <horizontalRule />
-
- * paragraph
-
- <paragraph />
-
- <paragraph text = 'Output a comment' />
-
- * radioGroup
-
- <radioGroup
- name = 'serverName'
- prompt = 'Server name: '
- value = 'Example|Simple|Test'
- columns = '1' # Optional. Defaults to '1'. Use a string, not a digit
- />
-
- * textField
-
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- />
-
- Over time, more functions will be added.
-
- * A textField with the name 'password' is treated as a password field.
- Also, the entity 'script' defines a Unix- or DOS-type batch file
-
- * These entities produce on-screen fields, or, in the case of the
- scripts, a vertical array of radio buttons
-
- * So, to run a script you fill in whatever fields the script uses and
- then select that script
-
- * Macros in the scripts, eg %fileName% are expanded with the current
- value of the field whose name appears between the % signs
-
- * A script whose last line is 'ftp -n -v' is recognized and handled
- specially. Your form must contain textFields called 'host',
- 'username' and 'password' and 'fileName'. A binary 'get' is
- performed. This will be made more flexible one day
-
- * Scripts have an attribute 'type', which can be 'local' or 'remote'.
-
- Remote scripts are passed to Net::Telnet, on the assumption that you
- know what you are doing. Your form must contain textFields called
- 'host', 'username' and 'password'
-
-NAVIGATION
- Forms are linked with 'Previous form', 'Next form' buttons.
-
- Any previously-entered textFields, except those whose name is
- 'password', are remembered when you return to a form. This is very
- convenient.
-
- The password values are zapped by CGI.pm, not by me. This is a security
- feature. It means you can walk away from your system and not have
- someone gain automatic access to a remote system.
-
-CASCADING STYLE SHEETS
- Each form entity may have a 'css' attribute, giving the name of the CSS
- file for that form. These attribute values are like
- '/CGI-Formalware.css', which, under Apache, means this value is prefixed
- with DocumentRoot. That is, the path to the CSS is a URI, and will not
- be seen if in cgi-bin/.
-
- The compulsory elements are: H1, H2 and P.TOC.
-
- Herewith a sample:
-
- H1
- {
- font-size: 20pt;
- alignment: center;
- color: teal;
- }
-
- H2
- {
- font-size: 16pt;
- font-style: italic;
- color: maroon;
- }
-
- P.TOC
- {
- font-size: 12pt;
- color: white;
- background-color: blue;
- }
-
-ENVIRONMENT VARIABLES
- None.
-
-INPUT DATA VALIDATION
- These checks are performed:
-
- * Each forms entity may have a 'tocEntry' attribute. If present, and
- if the tocVisible attribute is 'true', then a Table of Contents is
- put on each form, headed by this text. The default is 'Contents'
-
- * Each forms entity may have a 'tocVisible' attribute. If its value is
- 'True', then a Table of Contents is put on each form, headed by the
- value of 'tocEntry'. The default is 'True'
-
- * Each form entity must have 'heading' and 'tocEntry' attributes
-
- * Each form entity must have a unique 'heading' attribute
-
- * Each form entity may have a unique 'formFileName' attribute. If
- present, then this file name is used to output the form to a file if
- the constructor option new({form2file => 1}) is used
-
- * Each fileField entity must have 'name', 'prompt', 'value' and 'size'
- attributes
-
- * Each textField entity must have 'name', 'prompt', 'value' and 'size'
- attributes
-
- * Each scripts entity must have a 'heading' attribute
-
- * Each script entity must have 'heading', 'type' and 'line' attributes
-
- * Each script entity must have a unique 'heading' attribute
-
- * Each script entity's 'type' attribute must be 'local' or 'remote'
-
-XML DTD
- TBA.
-
-XML FILE FORMAT
- Herewith a sample:
-
- <forms
- tocEntry = 'Forms'
- tocVisible = 'True'
- >
- <form
- heading = 'Unix Command Menu'
- tocEntry = 'Unix menu'
- css = '/CGI-Formalware.css'
- formFileName = '1.html'
- >
- <horizontalRule />
-
- <radioGroup
- name = 'host'
- prompt = 'Host: '
- value = 'bigBox|littleBox'
- />
-
- <paragraph />
-
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <textField
- name = 'password'
- prompt = ' Password: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <horizontalRule />
-
- <scripts
- heading = 'Unix Scripts'
- numberScripts = 'Yes'
- >
- <script
- heading = 'Files in home directory'
- type = 'remote'
- line1 = 'dir'
- />
- <script
- heading = 'Tags in repository'
- type = 'remote'
- line1 = 'cd $M'
- line2 = 'getTags'
- />
- </scripts>
- </form>
-
- <form
- heading = 'DOS Command Menu'
- tocEntry = 'DOS menu'
- >
-
- <horizontalRule />
-
- <radioGroup
- name = 'host'
- prompt = 'Host: '
- value = 'bigBox|littleBox'
- />
-
- <paragraph text = 'Enter a username and a password.' />
-
- <textField
- name = 'username'
- prompt = 'Username: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <textField
- name = 'password'
- prompt = ' Password: '
- value = ''
- size = '15'
- override = '0'
- />
-
- <horizontalRule />
-
- <fileField
- name = 'fileName'
- prompt = 'Filename: '
- size = '60'
- override = '0'
- />
-
- <horizontalRule />
-
- <scripts
- heading = 'PC Scripts'
- >
-
- <script
- heading = 'Files in root directory'
- type = 'local'
- line1 = 'cd \'
- line2 = 'dir'
- />
- <script
- heading = 'FTP something somewhere'
- type = 'local'
- line1 = 'ftp -n -v'
- />
- <script
- heading = 'Untar a file'
- type = 'local'
- line1 = 'cd \'
- line2 = 'tar mxvzf %fileName%'
- />
- </scripts>
- </form>
- </forms>
-
-NESTED FORMS
- Nope, I don't recognize them. Maybe one day...
-
-REQUIRED MODULES
- * CGI
-
- * Net::Telnet
-
- * XML::DOM
-
-AUTHOR
- "CGI::Formalware" was written by Ron Savage *<ron at savage.net.au>* in
- 1999.
-
- Available from http://savage.net.au/Perl.html.
-
-LICENCE
- Australian copyright (c) 1999 Ron Savage.
-
- All Programs of mine are 'OSI Certified Open Source Software';
- you can redistribute them and/or modify them under the terms of
- The Artistic License, a copy of which is available at:
- http://www.opensource.org/licenses/index.html
-
+2 Installing from an ActiveState distro
+---------------------------------------
+shell>unzip CGI-Formalware-1.12.zip
+shell>ppm install --location=. CGI-Formalware
+shell>del CGI-Formalware-1.12.ppd
+shell>del PPM-CGI-Formalware-1.12.tar.gz
\ No newline at end of file
Modified: packages/libcgi-formalware-perl/trunk/debian/changelog
===================================================================
--- packages/libcgi-formalware-perl/trunk/debian/changelog 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/debian/changelog 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,3 +1,10 @@
+libcgi-formalware-perl (1.13-1) unstable; urgency=low
+
+ * New Upstream Release (Closes: #329500)
+ * Including watch file
+
+ -- Daniel Ruoso <daniel at ruoso.com> Tue, 10 Jan 2006 18:40:05 -0300
+
libcgi-formalware-perl (1.11-4) unstable; urgency=low
* New maintainer (Closes: #210206)
Added: packages/libcgi-formalware-perl/trunk/debian/watch
===================================================================
--- packages/libcgi-formalware-perl/trunk/debian/watch 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/debian/watch 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,2 @@
+version=3
+http://www.cpan.org/modules/by-module/CGI/CGI-Formalware-(.*)\.tgz
Copied: packages/libcgi-formalware-perl/trunk/lib/CGI/Formalware.pm (from rev 1888, packages/libcgi-formalware-perl/trunk/Formalware.pm)
===================================================================
--- packages/libcgi-formalware-perl/trunk/Formalware.pm 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/lib/CGI/Formalware.pm 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,1333 @@
+package CGI::Formalware;
+
+# Name:
+# CGI::Formalware.
+#
+# Documentation:
+# POD-style documentation is at the end. Extract it with pod2html.*.
+#
+#
+# Test environment:
+# Apache V 1.3.4, 1.3.6, 1.3.9, 1.3.12 for Windows.
+#
+# Note:
+# tab = 4 spaces || die.
+#
+# Author:
+# Ron Savage <ron at savage.net.au>
+# Home page: http://savage.net.au/index.html
+#
+# Licence:
+# Australian copyright (c) 1999-2002 Ron Savage.
+#
+# All Programs of mine are 'OSI Certified Open Source Software';
+# you can redistribute them and/or modify them under the terms of
+# The Artistic License, a copy of which is available at:
+# http://www.opensource.org/licenses/index.html
+
+use strict;
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+require Exporter;
+
+ at ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+ at EXPORT = qw();
+
+$VERSION = '1.13';
+
+# Preloaded methods go here.
+# -----------------------------------------------------------------
+
+use constant CURRENT_FORM_STRING => 'currentForm';
+use constant DEBUG_FILE_NAME_STRING => 'CGI-Formalware.log';
+use constant FILE_NAME_STRING => 'fileName';
+use constant NEXT_FORM_STRING => 'Next form';
+use constant PREVIOUS_FORM_STRING => 'Previous form';
+use constant SCRIPT_HEADING_STRING => 'scriptHeading';
+use constant SUBMIT_STRING => 'Submit';
+use constant XML_FILE_NAME_STRING => 'xmlFileName';
+
+use vars qw($attributes $text);
+use vars qw(@attribute @element);
+use vars qw(%fieldName);
+use vars qw(%fieldNameSeen);
+use vars qw($formCountPhase1);
+use vars qw($formCountPhase2);
+use vars qw(%formFileNameSeen);
+use vars qw(%formHeadingSeen);
+use vars qw($html);
+use vars qw($indentLevel $indentPrefix);;
+use vars qw($myself); # An alias for use in non-object subs.
+use vars qw(%numberScripts);
+use vars qw(%script);
+use vars qw(%scriptCount);
+use vars qw(%scriptHeadingMenu);
+use vars qw(%scriptHeadingSeen);
+use vars qw(%scriptType);
+use vars qw(@tableOfContents);
+use vars qw(%tableOfContents);
+use vars qw($xmlFileName);
+
+use CGI ':standard';
+use CGI::Carp qw(carpout fatalsToBrowser);
+use Net::Telnet;
+use XML::DOM;
+
+# -----------------------------------------------------------------
+
+($attributes, $text) = ('', '');
+($html) = {};
+($indentLevel, $indentPrefix) = (0, '');
+($formCountPhase1) = 0;
+($formCountPhase2) = 0;
+
+# -----------------------------------------------------------------
+
+sub charHandlerPhase1
+{
+ my($expat, $string) = @_;
+
+ # Trim whitespace.
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+
+ $text .= "$indentPrefix$string" if ($string);
+
+} # End of charHandlerPhase1.
+
+# -----------------------------------------------------------------
+
+sub charHandlerPhase2
+{
+ my($expat, $string) = @_;
+
+ # Trim whitespace.
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+
+ $text .= "$indentPrefix$string" if ($string);
+
+} # End of charHandlerPhase2.
+
+# -----------------------------------------------------------------
+
+sub endHandlerPhase1
+{
+ my($expat, $element) = @_;
+
+ &popIndent();
+
+ # Trim whitespace.
+ $text =~ s/^\s+//;
+ $text =~ s/\s+$//;
+
+ # Gain access to the attributes of the current element, and
+ # via the top-of-stacks, to the parent's element and attributes.
+ pop(@element);
+ my($attribute) = pop(@attribute);
+
+ $text = '';
+
+} # End of endHandlerPhase1.
+
+# -----------------------------------------------------------------
+
+sub endHandlerPhase2
+{
+ my($expat, $element) = @_;
+
+ &popIndent();
+
+ # Trim whitespace.
+ $text =~ s/^\s+//;
+ $text =~ s/\s+$//;
+
+ # Gain access to the attributes of the current element, and
+ # via the top-of-stacks, to the parent's element and attributes.
+ pop(@element);
+ my($attribute) = pop(@attribute);
+
+ if ($element =~ /^form$/i)
+ {
+ # Due to bugs in CGI.pm (around V 2.56), the override and default
+ # options must appear before the value option.
+ # Also, the override and default options must be used
+ # when there is only 1 radio button. If not, then the
+ # one and only button is not selected.
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ radio_group({name => SCRIPT_HEADING_STRING, cols => 1,
+ override => 1,
+ default => ${$scriptHeadingMenu{$formCountPhase2} }[0],
+ value => \@{$scriptHeadingMenu{$formCountPhase2} } }),
+ '</TD>', '</TR>');
+
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>', hr(), p(),
+ submit({name => SUBMIT_STRING, value => SUBMIT_STRING}), reset() );
+
+ # After the first form...
+ if ($formCountPhase2 > 1)
+ {
+ # Add previousForm button.
+ push(@{$$html{$formCountPhase2} },
+ submit({name => SUBMIT_STRING, value => PREVIOUS_FORM_STRING}) );
+ }
+
+ # Before the last form...
+ if ($formCountPhase2 < $formCountPhase1)
+ {
+ push(@{$$html{$formCountPhase2} },
+ submit({name => SUBMIT_STRING, value => NEXT_FORM_STRING}) );
+ }
+
+ push(@{$$html{$formCountPhase2} }, '</TD>', '</TR>', '</TBODY>',
+ '</TABLE>', '</TD>', '</TR>', '</TABLE>');
+ push(@{$$html{$formCountPhase2} },
+ hidden({name => XML_FILE_NAME_STRING, value => $xmlFileName, override => 1}),
+ hidden({name => CURRENT_FORM_STRING, value => $formCountPhase2, override => 1}) );
+
+ # End outputting HTML.
+ push(@{$$html{$formCountPhase2} }, end_form(), end_html() );
+
+ $myself -> writeFile($$attribute{'formFileName'}, $$html{$formCountPhase2})
+ if ($myself -> {'form2file'});
+ }
+
+ # horizontalRule.
+ if ($element =~ /^horizontalRule$/i)
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ hr(), '</TD>', '</TR>');
+ }
+
+ # paragraph.
+ if ($element =~ /^paragraph$/i)
+ {
+ my($text) = defined($$attribute{'text'}) ? $$attribute{'text'} : '';
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ p($text), '</TD>', '</TR>');
+ }
+
+ # radioGroup.
+ if ($element =~ /^radioGroup$/i)
+ {
+ my($columns) = defined($$attribute{'columns'}) ? $$attribute{'columns'} : '1';
+ my(@value) = split(/\|/, $$attribute{'value'});
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ $$attribute{'prompt'},
+ radio_group({name => $$attribute{'name'}, cols => $columns, value => \@value}),
+ '</TD>', '</TR>');
+ }
+
+ # textField.
+ if ($element =~ /^textField$/i)
+ {
+ if ($$attribute{'name'} =~ /^password$/i)
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ $$attribute{'prompt'},
+ password_field({name => $$attribute{'name'},
+ value => $$attribute{'value'}, size => $$attribute{'size'} }),
+ '</TD>', '</TR>');
+ }
+ else
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ $$attribute{'prompt'},
+ textfield({name => $$attribute{'name'},
+ value => $$attribute{'value'}, size => $$attribute{'size'} }),
+ '</TD>', '</TR>');
+ }
+ }
+
+ # fileField.
+ if ($element =~ /^fileField$/i)
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ $$attribute{'prompt'},
+ filefield({name => $$attribute{'name'}, size => $$attribute{'size'} }),
+ '</TD>', '</TR>');
+ }
+
+ # scripts.
+ if ($element =~ /^scripts$/i)
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+ h2($$attribute{'heading'}), '</TD>', '</TR>');
+ }
+
+ # script.
+ if ($element =~ /^script$/i)
+ {
+ my($script) = [];
+
+ for (sort keys %$attribute)
+ {
+ push(@$script, $$attribute{$_}) if (/^line\d{1,2}$/i);
+ }
+
+ $scriptCount{$formCountPhase2}++;
+ my($number) = '';
+ $number = sprintf("%2i: ", $scriptCount{$formCountPhase2})
+ if ($numberScripts{$formCountPhase2});
+ $number = "$number$$attribute{'heading'}";
+ push(@{$scriptHeadingMenu{$formCountPhase2} }, $number);
+ ${$script{$formCountPhase2} }{$number} = $script;
+ ${$scriptType{$formCountPhase2} }{$number} = $$attribute{'type'};
+ }
+
+ # Gather field names for substitution into scripts.
+ if ( ($element =~ /^(fileField|radioGroup|textField)$/i) )
+ {
+ ${$fieldName{$formCountPhase2} }{$$attribute{'name'} } = $1;
+ }
+
+ $text = '';
+
+} # End of endHandlerPhase2.
+
+# -----------------------------------------------------------------
+
+sub expandMacros
+{
+ my($self, $script, $fieldName) = @_;
+
+ for (@$script)
+ {
+ s/\t/ /g;
+ s/^\s+//;
+ s/\s+$//;
+
+ next if (! $_);
+
+ my($name);
+
+ for $name (keys(%$fieldName) )
+ {
+ my($value) = param($name) || '';
+ s/%$name%/$value/g;
+ }
+ }
+
+ # Discard null lines.
+ @$script = grep(length, @$script);
+
+ @$script;
+
+} # End of expandMacros.
+
+# -----------------------------------------------------------------
+
+sub getXMLFileName
+{
+ my($self) = @_;
+
+ my($heading) = 'Generate CGI Forms';
+
+ # Use "SUBMIT_STRING ", not just SUBMIT_STRING, so the if test in the main line,
+ # if ($submission eq SUBMIT_STRING), returns false.
+
+ print header(), start_html(title => $heading),
+ start_form(), h1($heading), hr(),
+ 'Please enter the name of the XML file which will be used to generate the CGI forms. ',
+ p(),
+ 'This can be any DOS file path, eg D:\Temp\menu.xml. Also, .\menu.xml uses cgi-bin\: ',
+ hidden({name => CURRENT_FORM_STRING, value => 1, override => 1}),
+ p(), textfield({name => XML_FILE_NAME_STRING, value => '', size => 50, override => 1}),
+ hr(), submit({name => SUBMIT_STRING, value => (SUBMIT_STRING . ' ')}),
+ end_form(), end_html();
+
+# <FORM ENCTYPE="multipart/form-data" ACTION="/cgi-bin/upload.cgi" METHOD="POST">
+# <INPUT TYPE="FILE" NAME="file-to-upload-01" SIZE="35">
+
+} # End of getXMLFileName.
+
+#-------------------------------------------------------------------
+
+sub new
+{
+ my($class, $optionRef) = @_;
+ $class = ref($class) || $class;
+ my($self) = (ref($optionRef) eq 'HASH') ? $optionRef : {};
+ $self -> {'debug'} = '' if (! defined($self -> {'debug'}) );
+ $self -> {'form2file'} = '' if (! defined($self -> {'form2file'}) );
+ $self -> {'timeScripts'} = '' if (! defined($self -> {'timeScripts'}) );
+ $myself = $self; # An alias for use in non-object subs.
+
+ return bless $self, $class;
+
+} # End of new.
+
+# -----------------------------------------------------------------
+
+sub phase1
+{
+ my($self, $xmlFileName) = @_;
+
+ # Declare the parser.
+ my($parser) = new XML::DOM::Parser;
+
+ $parser -> setHandlers
+ (
+ Start => \&startHandlerPhase1,
+ End => \&endHandlerPhase1,
+ Char => \&charHandlerPhase1,
+ );
+
+ # Parse the document and call the handlers.
+ my($doc) = $parser -> parsefile($xmlFileName);
+
+} # End of phase1.
+
+# -----------------------------------------------------------------
+
+sub phase2
+{
+ my($self, $xmlFileName) = @_;
+
+ # Declare the parser.
+ my($parser) = new XML::DOM::Parser;
+
+ $parser -> setHandlers
+ (
+ Start => \&startHandlerPhase2,
+ End => \&endHandlerPhase2,
+ Char => \&charHandlerPhase2,
+ );
+
+ # Parse the document and call the handlers.
+ my($doc) = $parser -> parsefile($xmlFileName);
+
+} # End of phase2.
+
+# -----------------------------------------------------------------
+
+sub popIndent
+{
+ $indentLevel--;
+ $indentPrefix = "\t" x $indentLevel;
+
+} # End of popIndent.
+
+# -----------------------------------------------------------------
+
+sub process
+{
+ my($self) = @_;
+
+ if ($self -> {'debug'})
+ {
+ open(DEBUG, '>> ' . DEBUG_FILE_NAME_STRING) || croak("Can't open(> " . DEBUG_FILE_NAME_STRING . "): $!\n");
+ carpout(\*DEBUG);
+ }
+
+ if (param() )
+ {
+ $xmlFileName = param(XML_FILE_NAME_STRING);
+
+ croak("Can't find XML file: $xmlFileName\n") if (! -e $xmlFileName);
+
+ # Parse once to count things.
+ $self -> phase1($xmlFileName);
+
+ # Parse again to do things.
+ $self -> phase2($xmlFileName);
+
+ my($submission) = param(SUBMIT_STRING) || '';
+
+ # Run a script and send the output to the browser, or...
+ if ($submission eq SUBMIT_STRING)
+ {
+ my($scriptHeading) = param(SCRIPT_HEADING_STRING);
+ my($formCount) = param(CURRENT_FORM_STRING);
+ my($scriptType) = ${$scriptType{$formCount} }{$scriptHeading};
+ $self -> runLocalScript($scriptHeading, $formCount) if ($scriptType =~ /^local$/i);
+ $self -> runRemoteScript($scriptHeading, $formCount) if ($scriptType =~ /^remote$/i);
+ }
+ else
+ {
+ # Send a stored form to the browser.
+ # This is the non-TOC code.
+ my($next) = param(CURRENT_FORM_STRING);
+ $next -= 1 if ($submission eq PREVIOUS_FORM_STRING);
+ $next += 1 if ($submission eq NEXT_FORM_STRING);
+
+ # This is the TOC code.
+ my($page);
+
+ for ($page = 1; $page <= ($#tableOfContents + 1); $page++)
+ {
+ $next = $page if (param($page) );
+ }
+
+ for (@{$$html{$next} })
+ {
+ print "$_\n";
+ }
+ }
+ }
+ else
+ {
+ $self -> getXMLFileName();
+ }
+
+ close(DEBUG) if ($self -> {'debug'});
+
+} # End of process.
+
+# -----------------------------------------------------------------
+
+sub pushIndent
+{
+ $indentLevel++;
+ $indentPrefix = "\t" x $indentLevel;
+
+} # End of pushIndent;
+
+# -----------------------------------------------------------------
+# Read a file. Pass in $chomp == 0 to stop chomping.
+
+sub readFile
+{
+ my($self, $fileName, $chomp) = @_;
+ $chomp = 1 if ($#_ == 0);
+
+ open(INX, $fileName) || croak("Can't open($fileName): $!\n");
+ my(@line) = <INX>;
+ close(INX);
+ chomp(@line) if ($chomp != 0);
+
+ \@line;
+
+} # End of readFile.
+
+# -----------------------------------------------------------------
+
+sub runLocalScript
+{
+ my($self, $heading, $formCount) = @_;
+
+ my($script) = ${$script{$formCount} }{$heading};
+ my($fieldName) = $fieldName{$formCount};
+ @$script = $self -> expandMacros($script, $fieldName);
+ my($scriptFileName) = 'script.bat';
+
+ $self -> writeFile($scriptFileName, $script);
+
+ # Handle FTP here.
+ if ($$script[$#{$script}] =~ /^ftp\s+(-n\s+-v|-v\s+-n)$/i)
+ {
+ # Create a text file to input to FTP.
+ open(OUT, "> $scriptFileName.txt") || croak("Can't open(> $scriptFileName.txt): $!\n");
+ print OUT 'open ', param('host'), "\n";
+ print OUT 'user ', param('username'), ' ', param('password'), "\n";
+ print OUT "bin\n";
+ print OUT 'get ', param(FILE_NAME_STRING), "\n";
+ print OUT "quit\n";
+ close(OUT);
+
+ # Patch batch file to run FTP.
+ my($cmd) = $self -> readFile($scriptFileName, 1);
+ $$cmd[$#{$cmd}] = "type $scriptFileName.txt | $$script[$#{$script}]\n";
+ $self -> writeFile($scriptFileName, $cmd);
+ }
+
+ my($startTime) = time();
+ my(@log) = `$scriptFileName`;
+ unlink($scriptFileName);
+ unlink("$scriptFileName.txt");
+ my($time) = time() - $startTime;
+
+ print header(), start_html($heading), start_form(), h1($heading), hr(), '<PRE>';
+
+ for (@log)
+ {
+ # Convert anything which looks like an HTML tag to something else.
+ # In particular, XML, & DOS dir listings containing 'cgi-bin <DIR>'.
+ s/<(.+?)>/<$1>/g;
+ print $_;
+ }
+
+ 1 while ($time =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/);
+
+ if ($self -> {'timeScripts'})
+ {
+ print '</PRE>', hr(), "That took $time second",
+ ($time == 1) ? '' : 's', '. ', end_form(), end_html();
+ }
+ else
+ {
+ print '</PRE>', hr(), end_form(), end_html();
+ }
+
+} # End of runLocalScript.
+
+# -----------------------------------------------------------------
+
+sub runRemoteScript
+{
+ my($self, $heading, $formCount) = @_;
+
+ my($script) = ${$script{$formCount} }{$heading};
+ my($fieldName) = $fieldName{$formCount};
+ @$script = $self -> expandMacros($script, $fieldName);
+ my($scriptLogName) = "script.log";
+ my($prompt) = '/\[\d+\] /';
+ my($actualCommand) = '';
+ my($startTime) = time();
+
+ unlink($scriptLogName);
+
+ # When we leave this block we kill off $session.
+ # Then, unlink($scriptLogName) works.
+ {
+ my($session) = new Net::Telnet
+ (
+ Timeout => 3600,
+ Prompt => $prompt,
+ );
+
+ $session -> input_log($scriptLogName);
+ $session -> open(param('host') );
+ $session -> login(param('username'), param('password') );
+
+ # Warning: Use spaces and not tabs to separated fields within these strings.
+ # Net::Telnet V 3.01 strips the tabs and does not replace them with a space.
+
+ for (@$script)
+ {
+ $actualCommand = $_ if (! $actualCommand);
+ $session -> cmd($_);
+ }
+
+ $session -> close();
+ }
+
+ my($time) = time() - $startTime;
+ my($log) = $self -> readFile($scriptLogName, 1);
+
+ unlink($scriptLogName);
+
+ print header(), start_html($heading), start_form(), h1($heading), hr(),
+ hidden({name => SUBMIT_STRING, value => SUBMIT_STRING, override => 1}),
+ '<PRE>';
+
+ # Print nothing until we find the command we sent.
+ my($foundCommand) = 0;
+ $actualCommand = quotemeta($actualCommand);
+
+ for (@$log)
+ {
+ # Convert anything which looks like an HTML tag to something else.
+ # In particular, XML, & DOS dir listings containing 'cgi-bin <DIR>'.
+ s/<(.+?)>/<$1>/g;
+
+ $foundCommand = 1 if (/$actualCommand\s*$/);
+ print "$_\n" if ($actualCommand);
+ }
+
+ 1 while ($time =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/);
+
+ if ($self -> {'timeScripts'})
+ {
+ print '</PRE>', hr(), "That took $time second",
+ ($time == 1) ? '' : 's', '. ', end_form(), end_html();
+ }
+ else
+ {
+ print '</PRE>', hr(), end_form(), end_html();
+ }
+
+} # End of runRemoteScript.
+
+# -----------------------------------------------------------------
+
+sub startHandlerPhase1
+{
+ my($expat, $element, %attribute) = @_;
+
+ # Gain access to the attributes of the current element, and
+ # via the top-of-stacks, to the parent's element and attributes.
+ push(@element, $element);
+ push(@attribute, \%attribute);
+
+ if ($element =~ /^form$/i)
+ {
+ croak("Each form entity must have 'heading' and 'tocEntry' attributes\n")
+ if (! defined($attribute{'heading'}) ||
+ ! defined($attribute{'tocEntry'}) );
+
+ croak("Each form entity must have a unique 'formFileName' attribute\n")
+ if (defined($formFileNameSeen{$attribute{'formFileName'} }) );
+
+ croak("Each form entity must have a unique 'heading' attribute\n")
+ if (defined($formHeadingSeen{$attribute{'heading'} }) );
+
+ $formCountPhase1++;
+
+ $formFileNameSeen{$attribute{'formFileName'} } = $formCountPhase1;
+ $formHeadingSeen{$attribute{'heading'} } = $formCountPhase1;
+
+ push(@tableOfContents, $attribute{'tocEntry'});
+ }
+
+ if ($element =~ /^radioGroup$/i)
+ {
+ croak("Each radioGroup entity must have 'name', 'prompt', and 'value' attributes\n")
+ if (! defined($attribute{'name'}) ||
+ ! defined($attribute{'prompt'}) ||
+ ! defined($attribute{'value'}) );
+ }
+
+ if ($element =~ /^textField$/i)
+ {
+ croak("Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes\n")
+ if (! defined($attribute{'name'}) ||
+ ! defined($attribute{'prompt'}) ||
+ ! defined($attribute{'value'}) ||
+ ! defined($attribute{'size'}) );
+ }
+
+ if ($element =~ /^fileField$/i)
+ {
+ croak("Each fileField entity must have 'name', 'prompt' and 'size' attributes\n")
+ if (! defined($attribute{'name'}) ||
+ ! defined($attribute{'prompt'}) ||
+ ! defined($attribute{'size'}) );
+ }
+
+ if ($element =~ /^(fileField|radioGroup|textField)$/i)
+ {
+ croak("Each fieldField, radioGroup & textField entity must have a unique 'name' attribute (per form)\n")
+ if (defined($fieldNameSeen{$formCountPhase1}{$attribute{'name'} }) );
+
+ $fieldNameSeen{$formCountPhase1}{$attribute{'name'} } = $formCountPhase1;
+ }
+
+ if ($element =~ /^scripts$/i)
+ {
+ croak("Each scripts entity must have a 'heading' attribute\n")
+ if (! defined($attribute{'heading'}) );
+ }
+
+ if ($element =~ /^script$/i)
+ {
+ croak("Each script entity must have 'heading', 'type' and 'line' attributes\n")
+ if (! defined($attribute{'heading'}) ||
+ ! defined($attribute{'type'}) ||
+ ! defined($attribute{'line1'}) );
+
+ croak("Each script entity must have a unique 'heading' attribute (per form)\n")
+ if (defined($scriptHeadingSeen{$formCountPhase1}{$attribute{'heading'} }) );
+
+ croak("Each script entity's 'type' attribute must be 'local' or 'remote'\n")
+ if ($attribute{'type'} !~ /^(local|remote)$/i);
+
+ $scriptHeadingSeen{$formCountPhase1}{$attribute{'heading'} } = $formCountPhase1;
+ }
+
+ &pushIndent();
+
+} # End of startHandlerPhase1.
+
+# -----------------------------------------------------------------
+
+sub startHandlerPhase2
+{
+ my($expat, $element, %attribute) = @_;
+
+ # Gain access to the attributes of the current element, and
+ # via the top-of-stacks, to the parent's element and attributes.
+ push(@element, $element);
+ push(@attribute, \%attribute);
+
+ if ($element =~ /^forms$/i)
+ {
+ $tableOfContents{'tocEntry'} = (defined($attribute{'tocEntry'}) ? $attribute{'tocEntry'} : 'Contents');
+ $tableOfContents{'tocVisible'} = (defined($attribute{'tocVisible'}) ? $attribute{'tocVisible'} : 'True');
+ }
+
+ if ($element =~ /^form$/i)
+ {
+ $formCountPhase2++;
+
+ my($author) = (defined($attribute{'author'}) ? $attribute{'author'} : 'ron at savage.net.au');
+ my($heading) = $attribute{'heading'};
+
+ $fieldName{$formCountPhase2} = {};
+ $$html{$formCountPhase2} = [];
+ $numberScripts{$formCountPhase2} = 0;
+ $script{$formCountPhase2} = {};
+ $scriptCount{$formCountPhase2} = 0;
+ $scriptHeadingMenu{$formCountPhase2} = [];
+ $scriptType{$formCountPhase2} = {};
+
+ my($startHtml) =
+ start_html({title => $heading, author => $author} );
+ $startHtml =
+ start_html({title => $heading, author => $author,
+ style => {src => $attribute{'css'} } } ) if (defined($attribute{'css'}) );
+
+ # Output the Table of Contents.
+ push(@{$$html{$formCountPhase2} }, header(), $startHtml, start_multipart_form(),
+ '<TABLE WIDTH = "100%">');
+
+ if ($tableOfContents{'tocVisible'} =~ /True/i)
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD VALIGN = "Top">',
+ '<TABLE>', '<THEAD>', '<TR>', '<TD>');
+
+ if (defined($attribute{'css'}) )
+ {
+ push(@{$$html{$formCountPhase2} },
+ p({class => 'TOC'}, $tableOfContents{'tocEntry'}) );
+ }
+ else
+ {
+ push(@{$$html{$formCountPhase2} }, $tableOfContents{'tocEntry'});
+ }
+
+ push(@{$$html{$formCountPhase2} }, '</TD>', '</TR>', '</THEAD>', '<TBODY>');
+
+ my($page) = 0;
+
+ for (@tableOfContents)
+ {
+ $page++;
+
+ if (defined($attribute{'css'}) )
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+# p({class => 'TOC'}, $_),
+ submit({class => 'TOC', name => $page, value => $_}),
+ '</TD>', '</TR>');
+ }
+ else
+ {
+ push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
+# $_,
+ submit({name => $page, value => $_}),
+ '</TD>', '</TR>');
+ }
+ }
+
+ push(@{$$html{$formCountPhase2} }, '</TBODY>', '</TABLE>',
+ '</TD>', '<TD>');
+ }
+
+ push(@{$$html{$formCountPhase2} }, '<TABLE>', '<THEAD>', '<TR>', '<TD>',
+ h1($heading), '</TD>', '</TR>', '</THEAD>', '<TBODY>');
+ }
+
+ if ($element =~ /^scripts$/i)
+ {
+ $numberScripts{$formCountPhase2} = 1 if (defined($attribute{'numberScripts'}) &&
+ ($attribute{'numberScripts'} =~ /Yes/i) );
+ }
+
+ &pushIndent();
+
+} # End of startHandlerPhase2.
+
+# -----------------------------------------------------------------
+
+sub writeFile
+{
+ my($self, $fileName, $data) = @_;
+
+ open(OUT, "> $fileName") || croak("Can't open($fileName): $!\n");
+ print OUT join("\n", @{$data}), "\n";
+ close(OUT);
+
+} # End of writeFile.
+
+# -----------------------------------------------------------------
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+
+__END__
+
+=head1 NAME
+
+C<CGI::Formalware> - Convert an XML file into a suite of CGI forms.
+
+=head1 SYNOPSIS
+
+In your browser, type: localhost/cgi-bin/x.pl
+
+where x.pl contains nothing more than:
+
+ #!perl -w
+ use strict;
+ use lib 'C:/Perl';
+ use lib 'C:/Perl/Scripts/General'; # Ie $PERL5LIB.
+ use CGI::Formalware;
+ my($form) = CGI::Formalware -> new({form2file => 1, debug => 1});
+ $form -> process();
+ exit(0);
+
+Upon starting, C<CGI::Formalware> asks for the name of your XML file, which
+is assumed to be in cgi-bin/.
+
+=head1 DESCRIPTION
+
+To provide a type of repository for frequently used scripts, which can then be executed
+locally or remotely (via Net::Telnet), by just entering a password (for remote scripts),
+and clicking.
+
+=head1 INSTALLATION
+
+You install C<CGI::Formalware>, as you would install any perl module library,
+by running these commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+If you want to install a private copy of C<CGI::Formalware> in your home
+directory, then you should try to produce the initial Makefile with
+something like this command:
+
+ perl Makefile.PL LIB=~/perl
+ or
+ perl Makefile.PL LIB=C:/Perl/Site/Lib
+
+If, like me, you don't have permission to write man pages into unix system
+directories, use:
+
+ make pure_install
+
+instead of make install. This option is secreted in the middle of p 414 of the
+second edition of the dromedary book.
+
+=head1 AUDIENCE
+
+Webmasters.
+
+=head1 SECURITY
+
+None. Even worse, C<CGI::Formalware> is designed to circumvent a web server's
+concept of what Apache calls DocumentRoot.
+
+=head1 CONSTRUCTOR new
+
+new takes either no parameters, or an anonymous hash. See the example above.
+Keys and values recognized are:
+
+=over 4
+
+=item *
+
+debug => 1 means turn on debugging. At the moment this opens and closes the
+file CGI-Formalware.log, but does not write anything to it
+
+=item *
+
+form2file => 1 means output each form to a file, using the name given
+by the form's formFileName attribute. The forms are written to cgi-bin/.
+If the form has no such attribute, this option is ignored. See example below
+
+=item *
+
+timeScripts => 1 means report elapsed time at the end of each script's output
+
+=back
+
+=head1 HIGHLIGHTS
+
+=over 4
+
+=item *
+
+Read an XML file, whose format is fixed, and generate a suite of CGI forms
+
+=item *
+
+A cascading style sheet can be specified for each form individually
+
+=item *
+
+A Table of Contents may appear on each form
+
+=item *
+
+Each form is more-or-less assumed to contain a list of scripts
+
+=item *
+
+Tokens in the XML correspond to a few functions available in Lincoln Stein's
+CGI.pm. Available tokens are:
+
+=over 4
+
+=item *
+
+fileField
+
+ <fileField
+ name = 'fileName'
+ prompt = 'Filename: '
+ size = '60'
+ override = '0'
+ />
+
+=item *
+
+horizontalRule
+
+ <horizontalRule />
+
+=item *
+
+paragraph
+
+ <paragraph />
+
+ <paragraph text = 'Output a comment' />
+
+=item *
+
+radioGroup
+
+ <radioGroup
+ name = 'serverName'
+ prompt = 'Server name: '
+ value = 'Example|Simple|Test'
+ columns = '1' # Optional. Defaults to '1'. Use a string, not a digit
+ />
+
+=item *
+
+textField
+
+ <textField
+ name = 'username'
+ prompt = 'Username: '
+ value = ''
+ size = '15'
+ override = '0'
+ />
+
+=back
+
+Over time, more functions will be added.
+
+=item *
+
+A textField with the name 'password' is treated as a password field. Also,
+the entity 'script' defines a Unix- or DOS-type batch file
+
+=item *
+
+These entities produce on-screen fields, or, in the case of the scripts, a
+vertical array of radio buttons
+
+=item *
+
+So, to run a script you fill in whatever fields the script uses and then select
+that script
+
+=item *
+
+Macros in the scripts, eg %fileName% are expanded with the current value of the
+field whose name appears between the % signs
+
+=item *
+
+A script whose last line is 'ftp B<-n> B<-v>' is recognized and handled specially.
+Your form must contain textFields called 'host', 'username' and 'password' and
+'fileName'. A binary 'get' is performed. This will be made more flexible one day
+
+=item *
+
+Scripts have an attribute 'type', which can be 'local' or 'remote'.
+
+Remote scripts are passed to Net::Telnet, on the assumption that you know what
+you are doing. Your form must contain textFields called 'host', 'username' and
+'password'
+
+=back
+
+=head1 NAVIGATION
+
+Forms are linked with 'Previous form', 'Next form' buttons.
+
+Any previously-entered textFields, except those whose name is 'password', are
+remembered when you return to a form. This is very convenient.
+
+The password values are zapped by CGI.pm, not by me. This is a security feature.
+It means you can walk away from your system and not have someone gain automatic
+access to a remote system.
+
+=head1 CASCADING STYLE SHEETS
+
+Each form entity may have a 'css' attribute, giving the name of the CSS file for
+that form. These attribute values are like '/CGI-Formalware.css', which, under
+Apache, means this value is prefixed with DocumentRoot. That is, the path to the
+CSS is a URI, and will not be seen if in cgi-bin/.
+
+The compulsory elements are: H1, H2 and P.TOC.
+
+Herewith a sample:
+
+ H1
+ {
+ font-size: 20pt;
+ alignment: center;
+ color: teal;
+ }
+
+ H2
+ {
+ font-size: 16pt;
+ font-style: italic;
+ color: maroon;
+ }
+
+ P.TOC
+ {
+ font-size: 12pt;
+ color: white;
+ background-color: blue;
+ }
+
+=head1 ENVIRONMENT VARIABLES
+
+None.
+
+=head1 INPUT DATA VALIDATION
+
+These checks are performed:
+
+=over 4
+
+=item *
+
+Each forms entity may have a 'tocEntry' attribute. If present, and if
+the tocVisible attribute is 'true', then a Table of Contents is put on
+each form, headed by this text. The default is 'Contents'
+
+=item *
+
+Each forms entity may have a 'tocVisible' attribute. If its value is 'True',
+then a Table of Contents is put on each form, headed by the value of
+'tocEntry'. The default is 'True'
+
+=item *
+
+Each form entity must have 'heading' and 'tocEntry' attributes
+
+=item *
+
+Each form entity must have a unique 'heading' attribute
+
+=item *
+
+Each form entity may have a unique 'formFileName' attribute. If present, then
+this file name is used to output the form to a file if the constructor option
+new({form2file => 1}) is used
+
+=item *
+
+Each fileField entity must have 'name', 'prompt', 'value' and 'size' attributes
+
+=item *
+
+Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes
+
+=item *
+
+Each scripts entity must have a 'heading' attribute
+
+=item *
+
+Each script entity must have 'heading', 'type' and 'line' attributes
+
+=item *
+
+Each script entity must have a unique 'heading' attribute
+
+=item *
+
+Each script entity's 'type' attribute must be 'local' or 'remote'
+
+=back
+
+=head1 XML DTD
+
+TBA.
+
+=head1 XML FILE FORMAT
+
+Herewith a sample:
+
+ <forms
+ tocEntry = 'Forms'
+ tocVisible = 'True'
+ >
+ <form
+ heading = 'Unix Command Menu'
+ tocEntry = 'Unix menu'
+ css = '/CGI-Formalware.css'
+ formFileName = '1.html'
+ >
+ <horizontalRule />
+
+ <radioGroup
+ name = 'host'
+ prompt = 'Host: '
+ value = 'bigBox|littleBox'
+ />
+
+ <paragraph />
+
+ <textField
+ name = 'username'
+ prompt = 'Username: '
+ value = ''
+ size = '15'
+ override = '0'
+ />
+
+ <textField
+ name = 'password'
+ prompt = ' Password: '
+ value = ''
+ size = '15'
+ override = '0'
+ />
+
+ <horizontalRule />
+
+ <scripts
+ heading = 'Unix Scripts'
+ numberScripts = 'Yes'
+ >
+ <script
+ heading = 'Files in home directory'
+ type = 'remote'
+ line1 = 'dir'
+ />
+ <script
+ heading = 'Tags in repository'
+ type = 'remote'
+ line1 = 'cd $M'
+ line2 = 'getTags'
+ />
+ </scripts>
+ </form>
+
+ <form
+ heading = 'DOS Command Menu'
+ tocEntry = 'DOS menu'
+ >
+
+ <horizontalRule />
+
+ <radioGroup
+ name = 'host'
+ prompt = 'Host: '
+ value = 'bigBox|littleBox'
+ />
+
+ <paragraph text = 'Enter a username and a password.' />
+
+ <textField
+ name = 'username'
+ prompt = 'Username: '
+ value = ''
+ size = '15'
+ override = '0'
+ />
+
+ <textField
+ name = 'password'
+ prompt = ' Password: '
+ value = ''
+ size = '15'
+ override = '0'
+ />
+
+ <horizontalRule />
+
+ <fileField
+ name = 'fileName'
+ prompt = 'Filename: '
+ size = '60'
+ override = '0'
+ />
+
+ <horizontalRule />
+
+ <scripts
+ heading = 'PC Scripts'
+ >
+
+ <script
+ heading = 'Files in root directory'
+ type = 'local'
+ line1 = 'cd \'
+ line2 = 'dir'
+ />
+ <script
+ heading = 'FTP something somewhere'
+ type = 'local'
+ line1 = 'ftp -n -v'
+ />
+ <script
+ heading = 'Untar a file'
+ type = 'local'
+ line1 = 'cd \'
+ line2 = 'tar mxvzf %fileName%'
+ />
+ </scripts>
+ </form>
+ </forms>
+
+=head1 NESTED FORMS
+
+Nope, I don't recognize them. Maybe one day...
+
+=head1 REQUIRED MODULES
+
+=over 4
+
+=item *
+
+CGI
+
+=item *
+
+Net::Telnet
+
+=item *
+
+XML::DOM
+
+=back
+
+=head1 AUTHOR
+
+C<CGI::Formalware> was written by Ron Savage I<E<lt>ron at savage.net.auE<gt>>
+in 1999.
+
+Available from http://savage.net.au/Perl.html.
+
+=head1 LICENCE
+
+Australian copyright (c) 1999 Ron Savage.
+
+ All Programs of mine are 'OSI Certified Open Source Software';
+ you can redistribute them and/or modify them under the terms of
+ The Artistic License, a copy of which is available at:
+ http://www.opensource.org/licenses/index.html
+
+=cut
Added: packages/libcgi-formalware-perl/trunk/t/pod.t
===================================================================
--- packages/libcgi-formalware-perl/trunk/t/pod.t 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/t/pod.t 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,7 @@
+use Test::More;
+
+eval "use Test::Pod 1.00";
+
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok();
\ No newline at end of file
Added: packages/libcgi-formalware-perl/trunk/t/test.t
===================================================================
--- packages/libcgi-formalware-perl/trunk/t/test.t 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/t/test.t 2006-01-10 22:01:49 UTC (rev 1889)
@@ -0,0 +1,5 @@
+use Test::More tests => 1;
+
+# ------------------------
+
+BEGIN{ use_ok('CGI::Formalware'); }
Deleted: packages/libcgi-formalware-perl/trunk/test.pl
===================================================================
--- packages/libcgi-formalware-perl/trunk/test.pl 2006-01-10 11:10:56 UTC (rev 1888)
+++ packages/libcgi-formalware-perl/trunk/test.pl 2006-01-10 22:01:49 UTC (rev 1889)
@@ -1,20 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..1\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use CGI::Formalware;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
More information about the Pkg-perl-cvs-commits
mailing list