#!/usr/bin/perl
######################################################
# xmlform.tp - This is a perl template file, #
# meaning that it provides the frame- #
# work for an application which #
# converts HTML form data to XML. #
# #
# Here are the steps to turn this into a working #
# application: #
# #
# 1 Create an HTML form which captures the info #
# 2 Run form2sub.pl on your form to extract NAME #
# fields into variables you can manipulate. #
# 3 Create an template XML file with all the #
# elements in place but without content. You #
# should be able to do this easily using an XML #
# editor with your DTD, if you have a DTD and an #
# XML editor. #
# See the next step if you have optional elements #
# or attributes. #
# 4 Modify form2sub.pl where needed to support #
# programming logic related to optional elements #
# or attributes or to support any operation where #
# you don't map straight from the form field to #
# to element content. #
# 5 Wrap a print statement around the XML file from #
# step 3, putting the variables from step 4 in #
# place for element content. Implement any #
# programming logic in the print statement(s) #
# in conformity with step 4. Output should be #
# written to the file DOC. #
# 6 Insert the result of steps 4 and 5 into this #
# template or use require statements. #
# 7 Set the 3 user defined variables in this file #
# and make sure you followed the naming convention #
# explained below for the routine produced in step #
# 5 or change the subroutine variable. #
# 8 Buy Internet Design with SGML and XML if the 7 #
# steps above don't seem straightforward because #
# once you see how it is done it is EASY! #
# #
# Copyright Matthew Fuchs, Michael Leventhal, and #
# David Lewis, published in Internet Design with #
# SGML and XML, Prentice-Hall, 1997. Permission #
# for unrestricted use as long as the authors are #
# credited. #
######################################################
# Set the following three variables
$appName = "md3";
$userDir = "/Program Files/sambar41/docs/EvanoffWorld/Prototypes/XML/";
$myURL = "http://209.114.130.125/EvanoffWorld/Prototypes/XML";
# make sure that you name your XML output subroutine
# according the following pattern or modify the
# variable to agree with your subroutine name
$outputXML = $appName."2XML";
#-------------------------------------------------------------#
# This section of the code creates the file name which will
# be used in the format $appNameNUMBER.xml where NUMBER is
# the largest number appended to application name found in
# directory incremented by one.
#$largest = 0;
#opendir (dirhandle, $userDir);
#while ($_ = readdir (dirhandle))
#{
# if ($_ =~ m/^$appName(\d+)\.xml/)
# {
# if ($1 > $largest)
# { $largest = $1; }
# }
#}
#closedir (dirhandle);
#$largest++;
$largest = 323;
$fileName = $appName.$largest.".xml";
#-------------------------------------------------------------#
&ReadParse;
foreach $atype (sort (keys %in)) {
$atype =~ tr/A-Z/a-z/;
eval &$atype;
}
unless (open(DOC,">$userDir$fileName")) {
print "Failure to open $userDir$fileName\n"; }
&$outputXML;
close DOC;
&respond;
#----------------------------------------------------------#
# Insert output of form2sub.pl after modification containing
# subroutines which assign CGI form fields to variables or
# use require or use to include
# insert subroutines HERE:
########################################################
# #
# file generated by form2sub.pl, extracting HTML form #
# fields to create subroutines which assign CGI vari- #
# bles to variable names for inclusion in xmlforms.pl. #
# #
# Copyright Matthew Fuchs, Michael Leventhal, and #
# David Lewis, published in Internet Design with #
# SGML and XML, Prentice-Hall, 1997. Permission #
# for unrestricted use as long as the authors are #
# credited. #
########################################################
sub type {
$type = $in{"$atype"};
}
sub order_day {
$order_day = $in{"$atype"};
}
sub order_month {
$order_month = $in{"$atype"};
}
sub order_year {
$order_year = $in{"$atype"};
}
sub contract_no {
$contract_no = $in{"$atype"};
}
sub order_no {
$order_no = $in{"$atype"};
}
sub io_name1 {
$io_name1 = $in{"$atype"};
}
sub io_name2 {
$io_name2 = $in{"$atype"};
}
sub io_comm1 {
$io_comm1 = $in{"$atype"};
}
sub io_comm2 {
$io_comm2 = $in{"$atype"};
}
sub shipto_name {
$shipto_name = $in{"$atype"};
}
sub shipto_address1 {
$shipto_address1 = $in{"$atype"};
}
sub shipto_address2 {
$shipto_address2 = $in{"$atype"};
}
sub shipto_city {
$shipto_city = $in{"$atype"};
}
sub shipto_state {
$shipto_state = $in{"$atype"};
}
sub shipto_zip {
$shipto_zip = $in{"$atype"};
}
sub shipto_country {
$shipto_country = $in{"$atype"};
}
sub contractor_name {
$contractor_name = $in{"$atype"};
}
sub contractor_address1 {
$contractor_address1 = $in{"$atype"};
}
sub contractor_address2 {
$contractor_address2 = $in{"$atype"};
}
sub contractor_city {
$contractor_city = $in{"$atype"};
}
sub contractor_state {
$contractor_state = $in{"$atype"};
}
sub contractor_zip {
$contractor_zip = $in{"$atype"};
}
sub contractor_country {
$contractor_country = $in{"$atype"};
}
sub discountterms {
$discountterms = $in{"$atype"};
}
sub line_no1 {
$line_no1 = $in{"$atype"};
}
sub line_no2 {
$line_no2 = $in{"$atype"};
}
sub line_no3 {
$line_no3 = $in{"$atype"};
}
sub line_no4 {
$line_no4 = $in{"$atype"};
}
sub line_no5 {
$line_no5 = $in{"$atype"};
}
sub prod_id1 {
$prod_id1 = $in{"$atype"};
}
sub prod_id2 {
$prod_id2 = $in{"$atype"};
}
sub prod_id3 {
$prod_id3 = $in{"$atype"};
}
sub prod_id4 {
$prod_id4 = $in{"$atype"};
}
sub prod_id5 {
$prod_id5 = $in{"$atype"};
}
sub descript1 {
$descript1 = $in{"$atype"};
}
sub descript2 {
$descript2 = $in{"$atype"};
}
sub descript3 {
$descript3 = $in{"$atype"};
}
sub descript4 {
$descript4 = $in{"$atype"};
}
sub descript5 {
$descript5 = $in{"$atype"};
}
sub qty_ord1 {
$qty_ord1 = $in{"$atype"};
}
sub qty_ord2 {
$qty_ord2 = $in{"$atype"};
}
sub qty_ord3 {
$qty_ord3 = $in{"$atype"};
}
sub qty_ord4 {
$qty_ord4 = $in{"$atype"};
}
sub qty_ord5 {
$qty_ord5 = $in{"$atype"};
}
sub unit1 {
$unit1 = $in{"$atype"};
}
sub unit2 {
$unit2 = $in{"$atype"};
}
sub unit3 {
$unit3 = $in{"$atype"};
}
sub unit4 {
$unit4 = $in{"$atype"};
}
sub unit5 {
$unit5 = $in{"$atype"};
}
sub unit_price1 {
$unit_price1 = $in{"$atype"};
}
sub unit_price2 {
$unit_price2 = $in{"$atype"};
}
sub unit_price3 {
$unit_price3 = $in{"$atype"};
}
sub unit_price4 {
$unit_price4 = $in{"$atype"};
}
sub unit_price5 {
$unit_price5 = $in{"$atype"};
}
#----------------------------------------------------------#
# Insert $outputXML.pl routine which you have written to
# output XML statements using variables as content from
# form2sub.pl subroutines or use require or use to include
# insert subroutine HERE:
######################################################
# contact2xml.pl - This subroutine writes out an XML #
# file conformant with the #
# ContactRec DTD using variables #
# from the contact HTML form #
# extracted by xmlform.pl CGI code #
# and the output of form2sub.pl run #
# on the contact HTML form. #
# #
# Copyright Matthew Fuchs, Michael Leventhal, and #
# David Lewis, published in Internet Design with #
# SGML and XML, Prentice-Hall, 1997. Permission #
# for unrestricted use as long as the authors are #
# credited. #
######################################################
sub md32XML {
print DOC "<?xml version=\"1.0\" ?>\n<OF347>\n";
print DOC "<Order OrderType=\"$type\"/>\n";
print DOC "<OrderDate>\n";
print DOC "\t<Order_Day>$order_day</Order_Day>\n";
print DOC "\t<Order_Month>$order_month</Order_Month>\n";
print DOC "\t<Order_Year>$order_year</Order_Year>\n";
print DOC "</OrderDate>\n";
print DOC "<ContractNo>$contract_no</ContractNo>\n";
print DOC "<OrderNo>$order_no</OrderNo>\n";
print DOC "<IssuingOfficeContact>\n<IO_Name1>$io_name1</IO_Name1>\n";
print DOC "\t<IO_Name2>$io_name2</IO_Name2>\n";
print DOC "\t<IO_Comm1>$io_comm1</IO_Comm1>\n";
print DOC "\t<IO_Comm2>$io_comm2</IO_Comm2>\n";
print DOC "</IssuingOfficeContact>\n";
print DOC "<ShipTo>\n";
print DOC "\t<ShipTo_Name>$shipto_name</ShipTo_Name>\n";
print DOC "\t<ShipTo_Street1>$shipto_address1</ShipTo_Street1>\n";
print DOC "\t<ShipTo_Street2>$shipto_address2</ShipTo_Street2>\n";
print DOC "\t<ShipTo_City>$shipto_city</ShipTo_City>\n";
print DOC "\t<ShipTo_State>$shipto_state</ShipTo_State>\n";
print DOC "\t<ShipTo_Zip>$shipto_zip</ShipTo_Zip>\n";
print DOC "\t<ShipTo_Country>$shipto_country</ShipTo_Country>\n";
print DOC "</ShipTo>\n";
print DOC "<Contractor>\n";
print DOC "\t<Contractor_Name>$contractor_name</Contractor_Name>\n";
print DOC "\t<Contractor_Street1>$contractor_address1</Contractor_Street1>\n";
print DOC "\t<Contractor_Street2>$contractor_address2</Contractor_Street2>\n";
print DOC "\t<Contractor_City>$contractor_city</Contractor_City>\n";
print DOC "\t<Contractor_State>$contractor_state</Contractor_State>\n";
print DOC "\t<Contractor_Zip>$contractor_zip</Contractor_Zip>\n";
print DOC "\t<Contractor_Country>$contractor_country</Contractor_Country>\n";
print DOC "</Contractor>\n";
print DOC "<DiscountTerms>$discountterms</DiscountTerms>\n";
print DOC "<Line_Item_Info>\n";
print DOC "<Item_No Line=\"$line_no1\"/>\n";
print DOC "\t<Prod_ID>$prod_id1</Prod_ID>\n";
print DOC "\t<Description>$descript1</Description>\n";
print DOC "\t<Qty_Ord>$qty_ord1</Qty_Ord>\n";
print DOC "\t<Unit_Measure>$unit1</Unit_Measure>\n";
print DOC "\t<Unit_Price>$unit_price1</Unit_Price>\n";
if ($line_no2 eq "2") {
print DOC "<Item_No Line=\"$line_no2\"/>\n";
print DOC "\t<Prod_ID>$prod_id2</Prod_ID>\n";
print DOC "\t<Description>$descript2</Description>\n";
print DOC "\t<Qty_Ord>$qty_ord2</Qty_Ord>\n";
print DOC "\t<Unit_Measure>$unit2</Unit_Measure>\n";
print DOC "\t<Unit_Price>$unit_price2</Unit_Price>\n";
}
if ($line_no3 eq "3") {
print DOC "<Item_No Line=\"$line_no3\"/>\n";
print DOC "\t<Prod_ID>$prod_id3</Prod_ID>\n";
print DOC "\t<Description>$descript3</Description>\n";
print DOC "\t<Qty_Ord>$qty_ord3</Qty_Ord>\n";
print DOC "\t<Unit_Measure>$unit3</Unit_Measure>\n";
print DOC "\t<Unit_Price>$unit_price3</Unit_Price>\n";
}
if ($line_no4 eq "4") {
print DOC "<Item_No Line=\"$line_no4\"/>\n";
print DOC "\t<Prod_ID>$prod_id4</Prod_ID>\n";
print DOC "\t<Description>$descript4</Description>\n";
print DOC "\t<Qty_Ord>$qty_ord4</Qty_Ord>\n";
print DOC "\t<Unit_Measure>$unit4</Unit_Measure>\n";
print DOC "\t<Unit_Price>$unit_price4</Unit_Price>\n";
}
if ($line_no5 eq "5") {
print DOC "<Item_No Line=\"$line_no5\"/>\n";
print DOC "\t<Prod_ID>$prod_id5</Prod_ID>\n";
print DOC "\t<Description>$descript5</Description>\n";
print DOC "\t<Qty_Ord>$qty_ord5</Qty_Ord>\n";
print DOC "\t<Unit_Measure>$unit5</Unit_Measure>\n";
print DOC "\t<Unit_Price>$unit_price5</Unit_Price>\n";
}
print DOC "</Line_Item_Info>\n";
print DOC "</OF347>\n";
}
#----------------------------------------------------------#
# This routine sends something back to the user and could
# be replaced with whatever is desired.
sub respond {
print "content-type: text/html\n
<HTML><HEAD><TITLE>OF-347 FORM TRANSLATED TO XML: FUNCTIONAL RESPONSE</TITLE>
</HEAD><BODY>
<H1>FUNCTIONAL RESPONSE: <br> OF347 FORM TRANSLATED TO XML</H1>
<TABLE BORDER=1><TR><TD>
<H3>Your Data was transformed to pure XML and written successfully to<A HREF=\"$myURL/$fileName\"> $fileName.</P>
<H3><A HREF=\"$myURL/$appName.html\">Click here to enter a new order.</A></P>
<H3><A HREF=\"$myURL/Loop-Style1.html\">Click here to Parse XML and view reconstituted XML with style.</A></P>
</TD></TR></TABLE></BODY></HTML>";
}
#----------------------------------------------------------#
# Keep the following CGI utility subroutines
# Note that these are officially out of date and may be
# replaced with a more current version
#
# Perl Routines to Manipulate CGI input
# S.E.Brenner@bioc.cam.ac.uk
# $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $
#
# Copyright 1993 Steven E. Brenner
# Unpublished work.
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.
# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# one key=value in each member of the list "@in"
# Also creates key/value pairs in %in, using '\0' to separate multiple
# selections
# If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
# information is stored there, rather than in $in, @in, and %in.
sub ReadParse {
if (@_) {
local (*in) = @_;
}
local ($i, $loc, $key, $val);
# Read in text
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
$in .= getc;
}
}
@in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Convert %XX from hex numbers to alphanumeric
$in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
# Split into key and value.
$loc = index($in[$i],"=");
$key = substr($in[$i],0,$loc);
$val = substr($in[$i],$loc+1);
$in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
return 1; # just for fun
}
# END OF FILE
#----------------------------------------------------------#
