#!/usr/bin/perl ########## Initialise. ##### Need XML::Parser. use XML::Parser; ##### Need Fcntl. use Fcntl; ##### Assign Handlers to the XML Parser. $p = new XML::Parser(Handlers => {Start => \&fl_xmlcgistart, End => \&fl_xmlcgiend, Char => \&fl_xmlcgichar}); ##### Parse the file. $infile = ${ENV{'ONEGATE_INFILE'}}; die("Not run by OneGate!\n") unless defined(${infile}); $p->parsefile(${infile}); ##### Open output file. $outfile = ${ENV{'ONEGATE_OUTFILE'}}; die("Not run by OneGate!\n") unless defined(${outfile}); $file_err = 0; sysopen(OUTFILE,${outfile},O_CREAT|O_WRONLY,0600) or die("Unable to open file!\n"); ##### Output example. print OUTFILE <<'END_OF_HEAD'; OneGate QuickTest2 Results

Field Submission Results

The following table lists the data you submitted to the OneGate QuickTest2 application:

END_OF_HEAD foreach $field (sort(keys(%all_fields))) { print OUTFILE ("\n"); print OUTFILE (""); print OUTFILE ("\n"); foreach $one (fl_getcgifieldvals(${field})) { ${one} =~ s/.*\/(.*)$/...\/[secure_spool_path]\/$1/ if ${one} =~ /\.up\d+/; if (defined(${one}) and ${one} !~ /^[\r\n]*$/) { $one =~ s/&/&/g; $one =~ s//>/g; $one =~ s/"/"/g; $outvline .= ${one}; } else { $outvline .= ' 
'; } } $outvline .= ' ' unless defined(${outvline}) and ${outvline} !~ /^$/; $outvline =~ s/[\n\r]/
/g; print OUTFILE ('\n"); } print OUTFILE <<'END_OF_TAIL';
Field Name Attributes Values
${field}\n"); undef $outaline; undef $outvline; foreach $one (fl_getcgifieldattrs(${field})) { $one = join("=",split(/\001/,${one})); if (defined(${outaline}) and ${outaline} !~ /^$/) { $outaline .= "
${one}"; } else { $outaline = ${one}; } } $outaline = ' ' unless defined(${outaline}) and ${outaline} !~ /^$/; print OUTFILE (${outaline},"\n"); print OUTFILE ("		',${outvline},"
Back to Table of Contents
Copyright 2003-2007, Fairlight Consulting. All rights reserved. END_OF_TAIL exit; ########## Subroutines. ##### Return an array of all values for a field, separated by nulls. ##### Return only the first value that was found in scalar context. sub fl_getcgifieldvals { my($sp1,$sp2); if (exists(${all_fields{$_[0]}})) { if (defined(wantarray)) { return(split(/\0\0/,${all_vals{$_[0]}})); } else { ($sp1,$sp2) = split(/\0\0/,${all_vals{$_[0]}},2); return(${sp1}); } } else { return(undef); } } ##### Return an array of all attribtute pairs for a field, separated by nulls. ##### Attribute pairs are separated by \001. ##### Return only the first pair that was found in scalar context. sub fl_getcgifieldattrs { my($sp1,$sp2); if (exists(${all_fields{$_[0]}})) { if (defined(wantarray)) { return(split(/\0\0/,${all_atts{$_[0]}})); } else { ($sp1,$sp2) = split(/\0\0/,${all_atts{$_[0]}},2); return(${sp1}); } } else { return(undef); } } sub fl_xmlcgistart { my ($ex,$el,@attrs) = @_; if (${el} eq 'form_field') { $glob_infield = 1; while (scalar(@attrs)) { push(@fatts,shift(@attrs)); push(@fvals,shift(@attrs)); } } if (${el} eq 'field_name') { $glob_inname = 1; } if (${el} eq 'field_value') { $glob_inval = 1; } } sub fl_xmlcgiend { my ($ex,$el,@attrs) = @_; if (${el} eq 'form_field') { $glob_infield = 0; $attset = 0; $fieldname = ${totalvalue}; $totalvalue .= ' (', $attset=1 if defined(@fatts) and scalar(@fatts); while (scalar(@fatts)) { $newatt = join("\001",shift(@fatts),shift(@fvals)); push(@newatts,${newatt}); } $all_atts{${fieldname}} = join("\0\0",@newatts) if ${attset}; $all_vals{${fieldname}} = join("\0\0",@totaljoins); $all_fields{${fieldname}} = '1'; undef $fieldname; undef @totaljoins; undef @fatts; undef @fvals; undef @newatts; undef $newatt; } if (${el} eq 'field_name') { $glob_inname = 0; } if (${el} eq 'field_value') { $glob_inval = 0; } } sub fl_xmlcgichar { my($ex,$el,@attrs) = @_; if (${glob_infield} and ${glob_inname}) { $totalvalue = ${el}; } if (${glob_infield} and ${glob_inval}) { push(@totaljoins,${el}); } }