#!/usr/local/bin/perl $| = 1; # output NOT buffered print "Content-Type:text/html\n\n\n"; chop($date = `/bin/date`); # for the 'this page created' line at the bottom $debug = 0; $host = $ENV{SERVER_NAME}; $ENV{SCRIPT_NAME} =~ s/([a-zA-Z0-9\.\-_]+)$//; $program = $1; $scriptpath = $ENV{SCRIPT_NAME}; $readablepath = "/www/httpdocs/"; $datapath = "formgen/"; $compress = "/usr/local/bin/gzip"; $mail = "/usr/bin/mailx -s 'Form Generation Delivery' "; ## formlib stuff. if ($ENV{REQUEST_METHOD} eq "POST") { require "./formlib.pl" || print "

Can't find formlib:$!"; &GetFormArgs(); # parse arguments passed from FORM (now in %in) $ENV{PATH_INFO} ne '' && &GetPathArgs($ENV{PATH_INFO}); if ($debug) { require "./debugforms.pl"; &debug; } $build_doc = $in{BUILD_DOC}; if ($in{BUILD} eq "Begin Document") { $build_doc =~ s/( |&|\+|\/|\\|,|'|"|!|\$|\*|\(|\))/_/g; # strip possible danger characters $build_doc =~ s/\.(html|htm|pl)$//i; # take html or perl suffix off $counter = ""; while (-e "$datapath$build_doc$counter.HEAD") { $counter++; } $build_doc .= $counter; open (DOC, ">$datapath$build_doc.HEAD") || &liedowndie; print DOC "", "\n\n$in{TITLE}\n", "\n\n\n\n", "\n"; close DOC; open (LOG, ">>${datapath}${program}.log"); print LOG "$date : $in{EMAIL}\n"; close LOG; $step = 0; $table[1] = " CHECKED"; $table = 0; &toolbar; } elsif ($in{BUILD} eq "Choose Next Element") { $table[$in{TABLE_STATUS}] = " CHECKED"; $step = $in{STEP}; $table = $in{TABLE_STATUS}; &toolbar; } elsif ($in{BUILD} eq "Remove last element") { # undo last document element created $in{STEP} -= 1; open (TARGET, "$datapath$build_doc.$in{STEP}"); print "Removed the following source:

\n"; while () { s//>/g; s/\n$/
/; print } unlink ("$datapath$build_doc.$in{STEP}"); open (LAST, "$datapath$build_doc".$in{STEP}-1); while () { $element = $_ } close LAST; if ($element =~ //) { $in{TABLE_STATUS} = 1 } else { $in{TABLE_STATUS} = 0 } &next_element; } elsif ($in{BUILD} eq "Create Element") { print "\n", "Set Element Options\n", "\n", "\n", "

Working document: $in{BUILD_DOC}

\n", "
\n", "\n", "\n", "\n", "\n", "\n"; if ($in{ELEMENT_TYPE} eq "FORM") { if ($in{FORM_ELEMENT} eq "Text or Numeric Input") { print "

HTML Form Input Options

\n", "\n\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n"; } elsif ($in{FORM_ELEMENT} eq "Large Text Area") { print "

HTML Form Textarea Options

\n", "
Label", " text:
Name:
Type:
Value:(if ", "desired)
Size: (if ", "desired)
Maxlength: (if ", "desired)
\n\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n"; } elsif ($in{FORM_ELEMENT} eq "Hidden Field") { print "

HTML Form Hidden Field ", "Options

\n", "
Label ", "text:
Name:
Value:(if ", "desired)
Rows: (if ", "desired)
Columns: (if ", "desired)
\n\n", "\n", "\n", "\n"; } elsif ($in{FORM_ELEMENT} eq "Radio Button") { print "

Radio Button Options

\n", "
Name:", "
Value:
\n\n", "\n", "\n", "\n"; } elsif ($in{FORM_ELEMENT} eq "Checkbox") { print "

Check Box Options

\n", "
Name: ", "", "
Number of buttons: ", "
Enter Labels for buttons:", "(One per row) ", "If you wish a button to have a value ", "when checked,", "add a comma and the value to the ", "button's label. i.e.
", "
Label for a button,value for ",
				"button\nAnother label,",
				"another value for the second ",
				"button
If you do not specify a ", "value, the button's label will be ", "provided as a value.		", "
Number of button to be ", "checked
(zero for none ", "checked)
\n\n", "\n", "\n", "\n"; } elsif ($in{FORM_ELEMENT} eq "Select") { print "

Select Options

\n", "
Name: ", "
Number of checkboxes: ", "
Enter Labels for checkboxes:", "(One per row) If you wish a ", "checkbox to have a value when checked,", "add a comma and the value to the ", "checkbox's label. i.e.
", "
Label for a checkbox,value for ",
				"checkbox\nAnother label,",
				"another value for the second ",
				"checkbox
", "
Number of checkbox to be ", "checked
(zero for none ", "checked)
\n", "\n", "\n", "\n\n", "", "", "", "\n"; } elsif ($in{FORM_ELEMENT} eq "Submit") { print "

Submit Options

\n", "
Label: ", "
Name: ", "
Number of options: ", "", "
Enter options:", "(One per row)", "
Number of option to be selected", "
(zero for no selection)", "
Check to allow multiple ", "selections:", "
How large should the selection ", "area", " be? ", "
\n\n", "\n", "\n\n\n"; } print ""; } elsif ($in{ELEMENT_TYPE} eq "HTML") { if ($in{HTML_ELEMENT} eq "Horizontal Rule") { print "

Horizontal Rule Options

", "
Name:
Value: ", "
", "Submit", " Button
Reset Button
", "", "", "", "", "", "", "", "", "", "", "", "", ""; } elsif ($in{HTML_ELEMENT} eq "Line Break") { print "

Break Options

\n", "
Thickness:
Width:PercentagePixels
Alignment
Shaded line:
\n", "\n", ""; } elsif ($in{HTML_ELEMENT} eq "Heading") { print "

Heading Options

\n", "
Choose type of ", "break
\n", "\n", "\n", "\n", "\n", "", "\n\n"; } elsif ($in{HTML_ELEMENT} eq "Comment") { print "

Comment Options

\n", "
Level (1-6): Alignment:
Heading ", "Text:
\n", "\n", "", "\n"; } elsif ($in{HTML_ELEMENT} eq "Image") { print "

Image Options

\n", "
Comment text:\n
\n", "\n", "", "\n"; } elsif ($in{HTML_ELEMENT} eq "Link") { print "

Link Options

\n", "
Image URL: ", "\n
\n", "\n", "", "\n\n", "", ""; } elsif ($in{HTML_ELEMENT} eq "Text") { print "

Text Options

", "
Link URL:\n
Link Text:\n
", "", "", "", "", ""; } print ""; } print "
Enter Text:
Choose text style:

\n", "\n
\n\n"; &footer; } elsif ($in{BUILD} eq "Set Options") { # create actual HTML object in working doc open (DOC, "> $datapath$build_doc.$in{STEP}"); $step = $in{STEP} + 1; if ($in{TABLE_STATUS} != $in{TABLE}) { if ($debug) { print "table status has changed

"; } if ($in{TABLE}) { print DOC "\n\n"; } else { print DOC "
"; } close DOC; $in{STEP}++; open (DOC, "> $datapath$build_doc.$in{STEP}"); $step = $in{STEP} + 1; } if ($in{TABLE}) { $td=""; $endtd=""; } if ($in{ELEMENT} eq "Text or Numeric Input") { if ($in{LABEL}) { print DOC "$td$in{LABEL}$endtd\n"; } print DOC "$td$endtd\n"; &line_break; } elsif ($in{ELEMENT} eq "Large Text Area") { if ($in{LABEL}) { print DOC "$td$in{LABEL}$endtd\n"; } print DOC "$td$endtd\n"; &line_break; } elsif ($in{ELEMENT} eq "Hidden Field") { print DOC ""; &line_break; } elsif ($in{ELEMENT} eq "Radio Button") { $in{LABELS} =~ s/\r//g; # strip carriage returns and line feeds @buttons = split(/\n/, $in{LABELS}); for ($i = 0; $i <= $#buttons; $i++) { if ($debug) { print "Loop index $i

"; } if ($td eq "") { $td1 = "" } @butt = split (',', $buttons[$i]); print DOC "$td1$endtd\n"; print DOC "$td$butt[0]$endtd\n"; if ($in{LINE_BREAK}) { if ($in{TABLE}) { print DOC "\n"; } else { print DOC "
"; } } } } elsif ($in{ELEMENT} eq "Checkbox") { if ($td eq "") { $td1 = "" } $in{LABELS} =~ s/\r//g; # strip line feeds @boxes = split(/\n/, $in{LABELS}); for ($i = 0; $i <= $#boxes; $i++) { @box = split (',', $boxes[$i]); print DOC "$td1$endtd\n"; print DOC "$td$box[0]$endtd\n"; if ($in{LINE_BREAK}) { if ($in{TABLE}) { print DOC "\n"; } else { print DOC "
"; } } } } elsif ($in{ELEMENT} eq "Select") { print DOC "$td$in{LABEL}$endtd\n"; print DOC "$td$endtd"; &line_break; } elsif ($in{ELEMENT} eq "Submit") { print DOC "$td$endtd"; &line_break; } elsif ($in{ELEMENT} eq "Horizontal Rule") { if ($in{TABLE}) { print DOC "\n\n"; } print DOC "\n"; if ($in{TABLE}) { print DOC "\n\n"; } } elsif ($in{ELEMENT} eq "Line Break") { print DOC "$td"; if ($in{NAME} eq "Line Break") { print DOC "
" } elsif ($in{NAME} eq "Paragraph Break") { print DOC "

" } elsif ($in{NAME} eq "Word Break") { print DOC "" } print DOC "$endtd"; &line_break } elsif ($in{ELEMENT} eq "Heading") { print DOC "$td$in{TEXT}", "$endtd\n"; &line_break } elsif ($in{ELEMENT} eq "Comment") { print DOC "$td$endtd"; &line_break } elsif ($in{ELEMENT} eq "Image") { print DOC "$td$endtd"; &line_break } elsif ($in{ELEMENT} eq "Link") { print DOC "$td", "$in{LINK}$endtd"; &line_break } elsif ($in{ELEMENT} eq "Text") { if ($in{STYLE} eq "Bold") { $style = "B"; } elsif ($in{STYLE} eq "Italic") { $style = "I"; } elsif ($in{STYLE} eq "Preformatted") { $style = "PRE"; } unless ($in{STYLE} eq "Plain") { print DOC "$td<$style>$in{TEXT}$endtd"; } else { print DOC "$td$in{TEXT}$endtd"; } &line_break } close DOC; print "Added $in{ELEMENT}\n

"; $table[$in{TABLE}] = " CHECKED"; $table = $in{TABLE}; &toolbar; } elsif ($in{BUILD} eq "View Source") { print "View $in{BUILD_DOC}", " Source\n"; print "

\n";
		
		open (HEAD, "$datapath$in{BUILD_DOC}.HEAD");
		
		while () {
			s//>/g;
			print
		}
		
		close HEAD;
		
		for ($loop = 0; $loop <= $in{STEP}; $loop++) {
			open (PART, "$datapath$in{BUILD_DOC}.$loop");
			while () {
				s//>/g;
				print 
			}
			close PART;
		}

		
		print "
\n"; &next_element; } elsif ($in{BUILD} eq "Preview Document") { open (HEAD, "$datapath$in{BUILD_DOC}.HEAD"); print while ; close HEAD; print "\n"; for ($loop = 0; $loop < $in{STEP}; $loop++) { open (PART, "$datapath$in{BUILD_DOC}.$loop"); print while ; close PART; } print "
\n\n"; &next_element; } elsif ($in{BUILD} eq "End Document") { print "Complete $in{BUILD_DOC} ", "Construction\n\n", "

\n", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "

Build Form", "

Supply name of host:
", "(If not $host)
Choose the desired method for", " delivering the form to you.
View form on your Web browser
Download form to your local machine
E-mail the form to you
Install the form on $host
Choose options for final building of", " form:
", "", "", "\n", "", "\n", "\n", "", "", "
Make self-contained Perl script
Supply path for perl:
", "(If other than /usr/local/bin/perl)
Validate HTML source
", "\n", "\n", ""; &footer; } elsif ($in{BUILD} eq "Deliver Completed Form") { $program =~ /(.*)\.pl/; $progname = $1; print "\n\nCompleted Form: $build_doc", "\n\n\n"; if ($in{OPTIONS} =~ /perl/){ $build_final = $build_doc . ".pl"; if ($in{PERL} eq "") { chop ($in{PERL} = `which perl`); } if ($in{HOST} eq "") { $in{HOST} = "$host/$scriptpath"; } $doc[0] = "#!$in{PERL}\n"; $doc[1] = "# perl script to both supply and support" . " the $build_doc HTML form\n"; $doc[2] = "# generated by http://$host$scriptpath" . "$program on $date\n"; $doc[3] = "\n\n"; $count = 4; open (PERL, "${datapath}$progname.perl") || print "ERROR Can't open ${datapath}", "$progname.perl : $!"; while () { $doc[$count] = $_; $count++ } close PERL; } else { $build_final = $build_doc . ".html"; $count = 0 } open (HEAD, "$datapath$build_doc.HEAD"); while () { if ($in{OPTIONS} =~ /perl/){ chomp; $_ =~ s/"/\\"/g; $doc[$count] = "\tprint \"" . $_ . "\\n\";\n"; } else { $doc[$count] = $_; } $count++; } close HEAD; #unlink ("$datapath$build_doc.HEAD"); if ($in{OPTIONS} =~ /perl/) { $doc[$count] = "\tprint \"\\n\";\n"; } else { $doc[$count] = "\n"; } $count++; for ($loop = 0; $loop <= $in{STEP}; $loop++) { open (PIECE, "$datapath$build_doc.$loop"); while () { if ($in{OPTIONS} =~ /perl/){ chomp; $_ =~ s/"/\\"/g; $_ =~ s/;/:/g; $doc[$count] = "\tprint \"" . $_ . "\\n\";\n"; } else { $doc[$count] = $_; } $count++; } #unlink ("$datapath$build_doc.$loop"); } if ($_ =~ //) { # very last line of form contains open row tag if ($in{OPTIONS} =~ /perl/){ $doc[$count] = "\tprint \"\\n\";\n"; } else { $doc[$count] = "\n"; } $count++ } open (END, "${datapath}$progname.end") || print "ERROR Can't open ${datapath}", "$progname.end : $!"; while () { if ($in{OPTIONS} =~ /perl/) { chomp; $_ =~ s/"/\\"/g; $doc[$count] = "\tprint \"" . $_ . "\\n\";\n"; } else { $doc[$count] = $_; } $count++; } close END; if ($in{OPTIONS} =~ /validate/) { open (VAL, "${datapath}validate.html"); while () { if ($in{OPTIONS} =~ /perl/) { chomp; $_ =~ s/"/\\"/g; $doc[$count] = "\tprint \"" . $_ . "\\n\";"; } else { $doc[$count] = $_; } $count++; } close VAL; } if ($in{OPTIONS} =~ /perl/) { $doc[$count] = "}"; $count++; } if ($in{METHOD} eq "view") { print "
\n";
						
			for ($loop = 0; $loop < $count; $loop++) {
			
				$doc[$loop] =~ s//>/g;
				print $doc[$loop];
			}
						
			print "
\n"; &footer; } elsif ($in{METHOD} eq "download") { open (FINAL, ">$readablepath" . "$in{BUILD_DOC}.html"); for ($loop = 0; $loop < $count; $loop++) { print FINAL $doc[$loop] } close FINAL; system ("$compress " . "$readablepath$in{BUILD_DOC}.html"); print "Download ", "$in{BUILD_DOC}.html.gz

"; &footer; } elsif ($in{METHOD} eq "email") { open (ADDRESS, "$datapath$build_doc.HEAD"); while (

) { /For:\s*(.*\@.*)\-\-/; $email = $1 } close ADDRESS; if (open (MAIL, "|$mail $email")){ for ($loop = 0; $loop < $count; $loop++) { print MAIL $doc[$loop] } close MAIL; print "

Mail sent successfully to $email", "

\n"; } else { print "

Error

Could not send mail to", " $email.
"; } &footer; } elsif ($in{METHOD} eq "install") { open (FINAL, ">$datapath$build_final"); for ($loop = 0; $loop < $count; $loop++) { print FINAL $doc[$loop] } close FINAL; print "\n<", "INPUT TYPE=\"hidden\" NAME=\"FORM\" ", "VALUE=\"$build_final\">\n", "\n\n", "\n", "\n", "
Specified desired target ", "directory:
"; &footer; } } } else { print "\n", "\n", "", "$program : Begin Creating Form", "\n", "\n", "\n", "\n", "

Form Generation Tool

\n", "

Start building your forms here

\n", "
\n", "If you wish to create an HTML form, enter the data ", "asked for below, then click the button labelled ", "'Begin Document.'

", "\n", "\n", "\n", "\n", "\n", "\n
Specify a file name
\n", "for the new document:
\n", "
\n", "HTML title for the document:\n", "", "

Please enter your e-mail address: \n", "
\n", "

\n", "\n", "\n"; &footer; } #################### END PROGRAM ##################### sub toolbar { print "\n", "Form Generation Tool\n", "\n", "\n", "Choose Next Element
", "

Working document: $build_doc

\n", "
\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n", "\n"; if ($in{STEP} > 0) { print ""; } print "\n", "\n", "\n", "", "\n", "
Choose next element for ", "document:
Form Element:\n", "HTML Element:
Document Creation Options
Table: On or Off Line break after ", "element


\n", "
\n"; &footer; } sub next_element { # mini-form to jump to next element creation form print "
\n", "\n", "\n", "\n", "", "
\n"; &footer; } sub footer { # the usual yatta-yatta print "
Start $program over again. Warning ", "the current form will be lost.
", "
$program written by singe\@outer.net

\n", "Page generated $date

", "\n"; } sub liedowndie { # error handler print "

Script is not functional.

", "check installation or notify administrator."; exit (1) } sub line_break { if ($in{LINE_BREAK}) { if ($in{TABLE}) { print DOC "\n"; } else { print DOC "
"; } } }