Re: Eliminating required fields in perl script for iis 6.0 server

birdfludeathclock@xxxxxxxxx <birdfludeathclock@xxxxxxxxx> wrote:

--<snip>--

You should
use strict;
use warnings;

at the beginning of your script, so that perl will help you find your
problems.


#read standard input (HTTP server CGI)
read (STDIN, $input, $ENV{'CONTENT_LENGTH'}) or death("Can't read STDIN
from WWW server!",3,20);
@parse = split(/&/,$input);

#Find FormDb Number to use
foreach $item (@parse)
{
#Split pairs, remove URL formatting
($name, $data) = split(/=/,$item,2);
$data =~ tr/+/ /;
$data =~ s/%(..)/pack("c",hex($1))/ge;
$name =~ tr/+/ /;
$name =~ s/%(..)/pack("c",hex($1))/ge;

If this is (as it appears to be) a CGI script, then don't roll your
own parsing code - use the proper tools:
use CGI;


if($formdb eq undef) { death("Couldn't get FormDb Number!!",3,40); }

That's not how you check for an undefined value:
if (not defined $formdb) ...


#Clean up memory used to read from STDIN
undef $input;

If you want your variables to go away, use proper scoping:

{
my $input;
# ... do something with $input
}
# $input no longer exists

See: http://perl.plover.com/FAQs/Namespaces.html


#Is it a required field? (marked !...)
if(index($name,"!") eq 0)

The operators 'ne', 'eq', 'gt', and 'lt' are for textual comparisons
Use '==', '!=', '>', and '<' etc for numeric comparisons

if ( index($name, '!') == 0 ) ...

#Remove CR and LF from $data
$data =~ tr/\x0A/ /;
$data =~ tr/\x0D/ /;

That doesn't remove those characters - it changes them to spaces.

$data =~ s/[\x0a\x0d]//g;


#Check for missing data
if(%DBFIELD eq undef) { death("No DB Field Data!!! How did that
happen??",3,1040); }

What do you think this is doing?
To see if a hash is empty you could do:
if (keys %DBFIELD == 0) ...
or even:
if (%DBFIELD == 0) ...


open(DBREF, $refdb) or death("Could not open REF DBF during DB
create!",2,1130);

Better to use lexical filehandles, use the 3-argument form of open and
to include the failure reason ($!) in the error message:

open my $dbref, '<', $refdb or die("open failed : $!");


$dbrcount++;
$dbrcount++;
$dbrcount++;
$dbrcount++;

$dbrcount += 4

#Strip out any none numeric values, replace with "0", leave dashs
"-" and decimals "."
$DBFIELD{$fname} =~ tr/\x00-\x2C/\x30/;
$DBFIELD{$fname} =~ tr/\x2F/\x30/;
$DBFIELD{$fname} =~ tr/\x3A-\xFF/\x30/;


$DBFIELD{$fname} =~ s/[^0-9.-]/0/g


$dstack = join("",$dstack,$whole,".",$frac);

What's this obsession with join() ? Have you heard of the string
concatenation operator, "." ?

$dstack = $dbstack . $whole . "." . $frac";

or better:

$dstack .= "$whole.$frac";

#Get current date/time info for file names and reporting
($lsec,$lmin,$lhour,$lmday,$lmon,$lyear,$lwday,$lyday,$lisdst) =
localtime;
$lmon++;
$nowlocal = localtime;
$nowgmt = gmtime;
#Pad single digit numbers with a zero
if(length($lsec) eq 1) { $lsec = join("","0",$lsec); }
if(length($lmin) eq 1) { $lmin = join("","0",$lmin); }
if(length($lhour) eq 1) { $lhour = join("","0",$lhour); }
if(length($lmday) eq 1) { $lmday = join("","0",$lmday); }
if(length($lmon) eq 1) { $lmon = join("","0",$lmon); }
#Creat DB drop dir name
$dump_dir = join("","IMPORT DB DATE ",($lyear +
1900),"-",$lmon,"-",$lmday," TIME ",$lhour,"-",$lmin,"-",$lsec);

Ouch! Replace all that with:
use POSIX;
my $dump_dir = strftime "IMPORT DB DATE %Y-%m-%d TIME %H-%M-%S",
localtime;


#Could not make drop dir, idle for a bit then try again.
if($doit < 5)
{
$tryout++;
$idle = time;
do { $wastecpu = time; } until $wastecpu ne $idle;
}
$doit++;

To wait for a second:
sleep 1;

#Write out 490 bytes of 0x00 padding to close out header, total 512
byte header
$hloop = 0;
$pad = "";
do
{
$pad = join ("",$pad,"\x00");
$hloop++;
} until $hloop eq 490;

Again, Ouch!
$pad = "\x00" x 490;


# &sendmail($from, $reply, $to, $smtp, $subject, $message );
#

sub sendmail {

Yuk!
If you're going to send mail, use one of the many existing modules
that are freely available on CPAN.



There are many things wrong with your code. I have only pointed out a
few of them. I hope my comments above will help you fix it (I'm glad I
don't have to do it!).


.

Relevant Pages