View source for Rs-Form.Pl

HomePage>>SourceCode>>[[PerlSource]]

This script is referenced from a web page form, marshalls all the parameters and passes them thru a named pipe to CGI.MASTER.

<pre>
sunset /usr/local/apache/share/cgi-bin> cat rs-form.cgi 
#!/usr/local/bin/perl
use CGI qw(:standard);

print header();

$acc=param("account");
if ($acc eq "") {
   print "<H1>Internal cgi error - must specify an account!</H1>\n";
   exit 0;
}

# Use process id for temp file
$rr = $$;
# This is the named pipe that the basic program is monitoring
$infile = "/samba_share/web/in/$acc/in_from_perl";
open(INFO, ">$infile") or die "Cannot open $infile";

# Make the named pipe to read from, later
$outfile = "/samba_share/web/out/$acc/$rr";
if (system('mknod', $outfile, 'p')) {
   die "mknod $outfile failed";
}
chmod 0777, $outfile;

# Delimiter to seperate rows is @AM
$rec_delim=chr(254);
# Delimiter to seperate fields is @VM
$fld_delim=chr(253);

# First, tell CGI.MASTER the place to write its output - the named pipe
# we just created.  as soon as we send everything, we'll wait for some
# output from the named pipe
print INFO $outfile,$rec_delim;

foreach $key (param()) {
   # This join is a little obscure - if the field being returned is
   # single valued it does nothing.  only for select lists with multiple
   # items does it produce a dynamic array
   $value = join($fld_delim, param($key));
   
   # Likewise, this next line usually does nothing, except when a multi-line
   # text box is being retrieved.  it too produces a dynamic array
   $value =~ s/\r\n/$fld_delim/og;
   
   # Send the data thru the named pipe to CGI.MASTER
   print INFO "$key=",$value,$rec_delim;
}
# Send the IP address of the remote host
print INFO "ip=",$ENV{[[REMOTE_ADDR]]},$rec_delim;

close(INFO) or die "Cannot close $infile";

# This next line will block until something is sent to the named pipe
open(OUTF, "<$outfile") or die "Cannot open $outfile";

# Ok, now we've got some data, send it to stdout, which the web server
# will pass on to the browser... oh, the tangled webs we weave!
while (<OUTF>) {
   # We undo the messing around with field delims on the way back
   s/$rec_delim/\n/og;
   s/$fld_delim/\n/og;
   print;
}
print end_html;

# Finally, get rid of the temporary named pipe
unlink($outfile);
</pre>