############################# ### COMMON CGI FUNCTIONS ### ############################# use Time::Local; sub check_all_fields { my ($opshash) = shift || {}; #ADDED 20000301. local ($key); foreach $key (keys %DB) { #if ($DB{$key} =~ /[`\!;\|\*\$&<>]/) #if ($DB{$key} =~ /[`\!;\$<>]/) #{ # return &return_error (500, 'Field Input Error', # "Invalid characters (! ; \$ < or >)in the [$key] field."); #} unless ($opshash->{DontQuoteQuotes}) #TEST ADDED 20000301. { $DB{$key} =~ s/(^|[^\\\'])\'([^\']|$)/$1''$2/g; #FIX SINGLE QUOTES #FOR ORACLE! } $DB{$key} =~ s/[,\s]//g if ($DB{$key} =~ /^\s*[\d\.\,]+\s*$/); #STRIP COMMAS FROM NUMBERS. #CHANGE ' TO '' UNLESS PRECEEDED BY \ (i.e. \') #NOTE: PERL CONVERTS \' TO ', SO USER NEEDS TWO SLASHES FOR SLASH! #THEREFORE TO ENTER "\'", USER SHOULD TYPE "\\'". } return 1; #ADDED 20000822; } sub parse_form_data { local (*FORM_DATA) = @_; my (@myparms) = CGI::param; my (@values, $value); foreach (@myparms) { @values = CGI::param($_); if ($#values > 0) { #$FORM_DATA{$key} = join ("\0", $FORM_DATA{$key}, $value); $FORM_DATA{$_} = join("\0", @values); } else { $value = CGI::param($_); $FORM_DATA{$_} = $value; } } } sub return_warning { my $wmsg = shift; my $printHeader = 1; my $buttonName = 'Back'; my $buttonAction = 'history.back()'; $printHeader = shift if (scalar(@_) > 0 && $_[0] =~ /^\d$/); if (scalar(@_) > 0) { $buttonName = shift; $buttonAction = "javascript:document.location='".shift(@_)."'" if (scalar(@_) > 0); } my $otherButtons = shift || ''; print "Content-type: text/html", "\n\n" if ($printHeader); print <

$wmsg

$msg

    $otherButtons
If you have comments or suggestions, contact $webpoc.
END_HTML print STDERR "CGI warning: $wmsg.\n"; return undef; } sub return_error { # local ($status, $keyword, $message) = @_; my $status = shift; my $keyword = shift; my $message = shift; my $printHeader = 1; my $buttonName = 'Back'; my $buttonAction = 'history.back()'; $printHeader = shift if (scalar (@_) > 0 && $_[0] =~ /^\d$/); if (scalar(@_) > 0) { $buttonName = shift; $buttonAction = "javascript:document.location='".shift(@_)."'" if (scalar(@_) > 0); } my $otherButtons = shift || ''; print "Content-type: text/html", "\n" if ($printHeader); print "Status: ", $status, " ", $keyword, "\n\n"; print < CGI Program - Unexpected Error

$keyword

$message

    $otherButtons
Please contact $webpoc for more information.
End_of_Error print STDERR "CGI error: ($status) $keyword: $message.\n" if ($status); return undef; } sub chkdate #CONVER USER-ENTERED DATES TO "yyyymmdd". { #### Y2K COMPLIANT UNTIL 2050. my ($dt) = shift; my ($res); return $dt unless ($dt =~ /\S/); my ($century) = 19; if ($dt =~ m#(\d+)[\/\-\.](\d+)[\/\-\.](\d+)#) { if ($3 < 1000) #user entered: "mm/dd/yy"|"mm-dd-yy"|"mm.dd.yy" { $century = 20 if ($3 < 50); $dt = sprintf "%-2.2d%-2.2d%-2.2d%-2.2d",$century,$3,$1,$2 } else #user entered: "mm/dd/yyyy"|"mm-dd-yyyy"|"mm.dd.yyyy" { $dt = sprintf "%-2.2d%-2.2d%-2.2d",$3,$1,$2; #print "
?????? dt=$dt= 1=$1= 2=$2= 3=$3=\n"; } eval { $then = &timelocal(0,0,0,substr($dt,6,2), (substr($dt,4,2)-1),substr($dt,0,4),0,0,0); }; #print "
??? dt=$dt= then=$then=\n"; $dt = '' unless ($then > 0); #INVALID DATE, BLANK OUT! return $dt; } elsif ($dt =~ /^\d\d\d\d\d\d+$/) { $dt = '0' . $dt if (length($dt) % 2); #user entered: "mddyy" if (length($dt) < 8) #user entered: "mmddyy" { $century = 20 if (substr($dt,4,2) < 50); $dt = $century . substr($dt,4,2) . substr($dt,0,4); } else #user entered: "mmddyyyy" { my ($leftpart) = substr($dt,0,4); if ($leftpart < 1300) #user entered: "mmddyyyy" { $dt = substr($dt,4,4) . $leftpart; } } eval { $then = &timelocal(0,0,0,substr($dt,6,2), (substr($dt,4,2)-1),substr($dt,0,4),0,0,0); }; $dt = '' unless ($then > 0); #INVALID DATE, BLANK OUT! return $dt; } else { return ''; #INVALID DATE, BLANK OUT! } } sub xchkdate #CONVER USER-ENTERED DATES TO "yyyymmdd". { #### Y2K COMPLIANT UNTIL 2050. my ($dt) = shift; my ($res); return $dt unless ($dt =~ /\S/); my ($century) = 19; if ($dt =~ m#(\d+)[\/\-\.](\d+)[\/\-\.](\d+)#) { if ($3 < 1000) #user entered: "mm/dd/yy"|"mm-dd-yy"|"mm.dd.yy" { $century = 20 if ($3 < 50); $dt = sprintf "%-2.2d%-2.2d%-2.2d%-2.2d",$century,$3,$1,$2 } else #user entered: "mm/dd/yyyy"|"mm-dd-yyyy"|"mm.dd.yyyy" { $dt = sprintf "%-2.2d%-2.2d%-2.2d",$3,$1,$2; } eval { $then = &timelocal(0,0,0,substr($dt,6,2), (substr($dt,4,2)-1),substr($dt,0,4),0,0,0); }; $dt = '' unless ($then > 0); #INVALID DATE, BLANK OUT! return $dt; } elsif ($dt =~ /^\d\d\d\d\d\d+$/) { $dt = '0' . $dt if (length($dt) % 2); #user entered: "mddyy" if (length($dt) < 8) #user entered: "mmddyy" { $century = 20 if (substr($dt,4,2) < 50); $dt = $century . substr($dt,4,2) . substr($dt,0,4); } else #user entered: "mmddyyyy" { my ($leftpart) = substr($dt,0,4); if ($leftpart < 1300) #user entered: "mmddyyyy" { $dt = substr($dt,4,4) . $leftpart; } } eval { $then = &timelocal(0,0,0,substr($dt,6,2), (substr($dt,4,2)-1),substr($dt,0,4),0,0,0); }; $dt = '' unless ($then > 0); #INVALID DATE, BLANK OUT! return $dt; } else { return ''; #INVALID DATE, BLANK OUT! } } sub prettydate { my ($dt) = shift; $dt =~ s/\n//g; #SPECIAL TO HANDLE A DATABASE GLITCH ;-) my ($result) = (substr($dt,4,2) . '/' . substr($dt,6,2) . '/' . substr($dt,0,4)); #print "
prettydate: dt=$dt= res=$result=\n"; $result = '' unless ($result =~ /\d/); return $result; } 1;