form processing

jasmine has asked for the wisdom of the Perl Monks concerning the following question:

#!C:\Perl\bin\Perl.exe "%1" %*

print "Content-type: text/html\n\n";

use DBI;

require ('C:\WINNT\Profiles\Administrator\Desktop\screens\cgi-lib.pl')
+;
&ReadParse;

$modContactNumber = 'modContactNumber';
$modContactFName = 'modContactFName';
$modContactLName = 'modContactLName';
$modContactTitle = 'modContactTitle';
$modContactDeskPH1 = 'modContactDeskPH1';
$modContactDeskPH2 = 'modContactDeskPH2';
$modContactDeskPH3 = 'modContactDeskPH3';
$modContactDeskPH = $in{$modContactDeskPH1} . $in{modContactDeskPH2} .
+ $in{$modContactDeskPH3};
$modContactMobile = 'modContactMobile';
$modContactPager = 'modContactPager';
$modContactPagerSPName = 'modContactPagerSPName';
$modContactPagerSP = 'modContactPagerSP';
$modContactFax1 = 'modContactFax1';
$modContactFax2 = 'modContactFax2';
$modContactFax3 = 'modContactFax3';
$modContactFax = $in{$modContactFax1} . $in{modContactFax2} . $in{$mod
+ContactFax3};
$modContactEmail = 'modContactEmail';
$modSite = 'modSite';
$error = 0;
$sites = $in{sites};


print "<body bgcolor=\"#FFFFCC\">";

while ($in{$modContactTitle} =~ /[\s]+$/)
{
chop($in{$modContactTitle});
}

if (length ($in{$modContactTitle}) < 2)
{
print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Title</b></font
+></font><b><font face=\"Arial\">
must be at least 2 characters</font></b>";
print "<br>";
$error = ++$error;
}
elsif ($in{$modContactTitle} !~ /^[A-Za-z0-9\s\-]+$/)
{
print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Title
$in{$modContactTitle} invalid - </font></font><b></b><font face=\"Aria
+l\">can only contain letters, numbers, spaces and hyphens</font></b>"
+;
print "<br>";
$error = ++$error;
}

while ($in{$modContactDeskPH1} =~ /[\s]+$/)
{
chop($in{$modContactDeskPH1});
}

while ($in{$modContactDeskPH2} =~ /[\s]+$/)
{
chop($in{$modContactDeskPH2});
}

while ($in{$modContactDeskPH3} =~ /[\s]+$/)
{
chop($in{$modContactDeskPH3});
}

if ((length($in{$modContactDeskPH1}) > 0)
   or (length($in{$modContactDeskPH2}) > 0)
   or (length($in{$modContactDeskPH3}) > 0 ))
{
      if (length($in{$modContactDeskPH1}) < 2)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Desk PH N
+umber Part One
      $in{$modContactDeskPH1} </font></font><b></b><font face=\"Arial\
+">must be at least 2 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactDeskPH1}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Desk PH N
+umber Part One
      $in{$modContactDeskPH1} invalid - </font></font><b></b><font fac
+e=\"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
      if (length($in{$modContactDeskPH2}) < 2)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Desk PH N
+umber Part Two
      $in{$modContactDeskPH2} </font></font><b></b><font face=\"Arial\
+">must be at least 2 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactDeskPH2}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Desk PH N
+umber Part Two
      $in{$modContactDeskPH2} invalid - </font></font><b></b><font fac
+e=\"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
      if (length($in{$modContactDeskPH3}) < 5)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Desk PH N
+umber Part Three
      $in{$modContactDeskPH3} </font></font><b></b><font face=\"Arial\
+">must be at least 5 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactDeskPH3}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Desk PH N
+umber Part Three
      $in{$modContactDeskPH3} invalid - </font></font><b></b><font fac
+e=\"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
}

while ($in{$modContactMobile} =~ /[\s]+$/)
{
chop($in{$modContactMobile});
}

if (length($in{$modContactMobile}) > 0)
{
    if (length($in{$modContactMobile}) < 8)
    {
    print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Mobile Phon
+e Number</b></font></font><b><font face=\"Arial\">
    must be at least 8 digits</font></b>";
    print "<br>";
    $error = ++$error;
    }
    elsif ( $in{$modContactMobile} !~ /^[0-9\s]+$/)
    {
    print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Mobile Phon
+e Number
    $in{$modContactMobile} invalid - </font></font><b></b><font face=\
+"Arial\">can only contain numbers and spaces</font></b>";
    print "<br>";
    $error = ++$error;
    }
}

while ($in{$modContactPagerSPName} =~ /[\s]+$/)
{
chop($in{$modContactPagerSPName});
}

while ($in{$modContactPagerSP} =~ /[\s]+$/)
{
chop($in{$modContactPagerSP});
}

if ((length($in{$modContactPagerSPName}) > 0)
   or (length($in{$modContactPagerSP}) > 0))
{
      if (length($in{$modContactPagerSPName}) < 3)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Pager Ser
+vice Name
      $in{$modContactPagerSPName} </font></font><b></b><font face=\"Ar
+ial\">must be at least 3 characters</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactPagerSPName} !~ /^[A-Za-z]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Pager Ser
+vice Name
      $in{$modContactPagerSPName} invalid - </font></font><b></b><font
+ face=\"Arial\">can only contain letters</font></b>";
      print "<br>";
      $error = ++$error;
      }
      if (length($in{$modContactPagerSP}) < 5)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Pager Ser
+vice Number
      $in{$modContactPagerSP} </font></font><b></b><font face=\"Arial\
+">must be at least 5 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactPagerSP}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Pager Ser
+vice Number
      $in{$modContactPagerSP} invalid - </font></font><b></b><font fac
+e=\"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
}

while ($in{$modContactFax1} =~ /[\s]+$/)
{
chop($in{$modContactFax1});
}

while ($in{$modContactFax2} =~ /[\s]+$/)
{
chop($in{$modContactFax2});
}

while ($in{$modContactFax3} =~ /[\s]+$/)
{
chop($in{$modContactFax3});
}

if ((length($in{$modContactFax1}) > 0)
   or (length($in{$modContactFax2}) > 0)
   or (length($in{$modContactFax3}) > 0 ))
{
      if (length($in{$modContactFax1}) < 2)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Fax Numbe
+r Part One
      $in{$modContactFax1} </font></font><b></b><font face=\"Arial\">m
+ust be at least 2 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactFax1}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Fax Numbe
+r Part One
      $in{$modContactFax1} invalid - </font></font><b></b><font face=\
+"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
      if (length($in{$modContactFax2}) < 2)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Fax Part 
+Number Two
      $in{$modContactFax2} </font></font><b></b><font face=\"Arial\">m
+ust be at least 2 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactFax2}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Fax Part 
+Number Two
      $in{$modContactFax2} invalid - </font></font><b></b><font face=\
+"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
      if (length($in{$modContactFax3}) < 5)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Fax Part 
+Number Three
      $in{$modContactFax3} </font></font><b></b><font face=\"Arial\">m
+ust be at least 5 digits</font></b>";
      print "<br>";
      $error = ++$error;
      }
      elsif ($in{$modContactFax3}!~ /^[0-9]+$/)
      {
      print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Fax Part 
+Number Three
      $in{$modContactFax3} invalid - </font></font><b></b><font face=\
+"Arial\">can only contain numbers</font></b>";
      print "<br>";
      $error = ++$error;
      }
}


while ($in{$modContactEmail} =~ /[\s]+$/)
{
chop($in{$modContactEmail});
}

if (length($in{$modContactEmail}) > 0)
{
   if (length($in{$modContactEmail}) < 7)
   {
   print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Email Addres
+s</b></font></font><b><font face=\"Arial\">
   must be at least 7 characters</font></b>";
   print "<br>";
   $error = ++$error;
   }
   elsif ($in{$modContactEmail} !~ /^[a-zA-Z0-9\-\.\_]*[a-zA-Z0-9\-\.\
+_]\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/)
   {
    print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Email Addre
+ss
    $in{$modContactEmail} invalid - </font></font><b></b><font face=\"
+Arial\">please check format (e.g.: joe\@email.com.au)</font></b>";
    print "<br>";
    $error = ++$error;
    }

}

while ($in{$modContactPager} =~ /[\s]+$/)
{
chop($in{$modContactPager});
}

if (length($in{$modContactPager}) > 0)
{
    if (length($in{$modContactPager}) < 5)
    {
    print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Pager Numbe
+r</b></font></font><b><font face=\"Arial\">
    must be at least 5 digits</font></b>";
    print "<br>";
    $error = ++$error;
    }
    elsif ($in{$modContactPager} !~ /^[0-9]+$/)
    {
    print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Pager Numbe
+r
    $in{$modContactPager} invalid - </font></font><b></b><font face=\"
+Arial\">can only contain numbers</font></b>";
    print "<br>";
    $error = ++$error;
    }
}

if (($modContactDeskPH eq "") && ($modContactFax eq "")
   && ($in{$modContactMobile} eq "") && ($in{$modContactEmail} eq "")
   && ($in{$modContactPager} eq ""))
{
print"<font color=\"#FF0000\"> <font face=\"Arial\"><b>Contact
</font></font><b></b><font face=\"Arial\"> must include at least 1</fo
+nt></b>";
print "<br>";
$error = ++$error;
}

if ($error > 0)
{
print "<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp
+;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n
+bsp;&nbsp;&nbsp;&nbsp;<input type=\"BUTTON\" value=\"Re-enter\" onCli
+ck=\history.go(-1) name=\"Reenter\">";
}
else
{
my $dbh = DBI->connect("DBI:Sybase:CRAP", "sa", ""); #connects to
$sth4 = $dbh->prepare(qq{
            SELECT NSS.dbo.SITE.SITE_#, SITE_NAME
            FROM NSS.dbo.SITE, NSS.dbo.SITE_CONTACT, NSS.dbo.CONTACT
            WHERE NSS.dbo.SITE.SITE_# = NSS.dbo.SITE_CONTACT.SITE_#
            AND NSS.dbo.CONTACT.CONTACT_# = NSS.dbo.SITE_CONTACT.CONTA
+CT_#
            AND NSS.dbo.CONTACT.CONTACT_#  = $in{$modContactNumber}
           }) or die "Can't prepare SQL statement: $DBI::errstr\n";
$sth4->execute
        or die "Can't execute: $DBI::errstr\n";
      my ($newSiteNumber, $newSiteName);
$sth4->bind_columns (\$newSiteNumber, \$newSiteName);

@array = (split " ", $sites);

print $array[1];

if ($array[1] == 7)
{
print "matches ";
}
else
{
print "doesn't match ";
}

#my %sites_list;
#@sites_list {split(" ", $sites)} = ();        # hash slice for quicke
+r lookup

#while ($sth4->fetch()) {
 #   if (exists $sites_list{$newSiteNumber}) {
  #     print $newSiteNumber;
   #     print "modify!";
    #} else {
     #     print $newSiteNumber;
      #  print "delete!";
    #}
#}



$sth5 = $dbh->prepare(qq{
            select SITE_#, SITE_NAME
            FROM NSS.dbo.SITE
            WHERE SITE_# NOT IN
            (select NSS.dbo.SITE.SITE_#
                FROM NSS.dbo.SITE, NSS.dbo.SITE_CONTACT, NSS.dbo.CONTA
+CT
                WHERE NSS.dbo.SITE.SITE_# = NSS.dbo.SITE_CONTACT.SITE_
+#
                AND NSS.dbo.CONTACT.CONTACT_# = NSS.dbo.SITE_CONTACT.C
+ONTACT_#
                AND NSS.dbo.CONTACT.CONTACT_#  = $in{$modContactNumber
+})
           }) or die "Can't prepare SQL statement: $DBI::errstr\n";
$sth5->execute
        or die "Can't execute: $DBI::errstr\n";
my ($siteNumber, $siteName);
$sth5->bind_columns (undef, \$siteNumber, \$siteName);

$sth3 = $dbh->prepare(qq{
            select CONTACT_FNAME, CONTACT_LNAME
            from NSS.dbo.CONTACT
            WHERE CONTACT_# = $in{$modContactNumber}
        }) or die "Can't prepare SQL statement: $DBI::errstr\n";
    $sth3->execute
        or die "Can't execute: $DBI::errstr\n";
    
my ( $oldContactFName, $oldContactLName);
$sth3->bind_columns (undef, \$oldContactFName, \$oldContactLName);

while ( @row3 = $sth3->fetchrow() ) {}

$sth = $dbh->prepare(qq{
            UPDATE NSS.dbo.CONTACT SET
            CONTACT_TITLE = "$in{$modContactTitle}",
            CONTACT_DESKPH# = "$in{$modContactDeskPH1}-$in{$modContact
+DeskPH2}-$in{$modContactDeskPH3}",
            CONTACT_MOBILE# = "$in{$modContactMobile}",
            CONTACT_PAGER# = "$in{$modContactPager}",
            CONTACT_PAGER_SP = "$in{$modContactPagerSPName}-$in{$modCo
+ntactPagerSP}",
            CONTACT_FAX# = "$in{$modContactFax1}-$in{$modContactFax2}-
+$in{$modContactFax3}",
            CONTACT_EMAIL = "$in{$modContactEmail}"
            
            WHERE CONTACT_# = $in{$modContactNumber}
        }) or die "Prepare of UPDATE: ", $dbh->errstr, "\n";
    $sth->execute or die "Execute of UPDATE: ", $dbh->errstr, "\n";

#$sth2 = $dbh->prepare(qq{
#             UPDATE NSS.dbo.SITE_CONTACT SET
#             SITE_# = $in{$modSite}
#
#             WHERE CONTACT_# = $in{$modContactNumber}
#         }) or die "Prepare of UPDATE: ", $dbh->errstr, "\n";
#     $sth2->execute or die "Execute of UPDATE: ", $dbh->errstr, "\n";
    
print <<"EOF";
<html>
<head>
<title>Contact Modified</title>
</head>
<body bgcolor="#FFFFFF">
<b><font face="Arial">Contact <font color="#FF0000">$oldContactFName $
+oldContactLName</font> has been modified</font></b>
<br>
<form method="post" action="">
  <input type="BUTTON" value="Modify/Delete another Contact" onClick="
+location.href = 'locateContact.cgi'" name="modifyAnotherContact">
  <input type="BUTTON" value="Home" onClick="location.href = 'main.cgi
+'" name="homeContact">
</form>
</body>
</html>



EOF
}
[download]

Comment on form processing Download Code

Replies are listed 'Best First'.
Re: form processing by chipmunk (Parson) on Dec 21, 2000 at 10:11 UTC
Yay! After two nights of chatterbox discussion, a few lengthy posts, and installing cgi-lib.pl on my machine (shudder), I've figured out why your code isn't working as you intended. :) It turns out that cgi-lib.pl handles multi-value params (as in ?sites=1&sites=2&sites=3) by joining the values with a null character, aka `"\0"` and `"\c@"`. The value you're getting from $in{sites} is actually `"1 \c@2 \c@3 "`. (The spaces are from your form, and the null characters are from cgi-lib.pl.) When you split on whitespace, the first value is okay, but the other values have a hidden null character. The solution (assuming that you want to continue using cgi-lib.pl, rather than switching to the CGI module), is to change `VALUE="$modSiteNumber "` to `VALUE="$modSiteNumber"` in your form generator, and create the array with `@sites = split /\0/, $in{sites};` in your form parser.	[reply] [d/l] [select]
Re: Re: form processing by chromatic (Archbishop) on Dec 21, 2000 at 10:33 UTC
That's precisely why people ought to be using CGI.pm instead of cgi-lib.pl. How much debugging time was spent on this issue? My instinct is that the time that it would take to port this over to CGI.pm is small, in comparison. What might happen in the future when someone else has to maintain this code? The alternative is a simple: `my @sites = $query->param('sites');`	[reply] [d/l]
Re: form processing by a (Friar) on Dec 21, 2000 at 11:27 UTC
Just to be the school marm w/ some suggestions (besides indenting) to make your code a bit more perlish: `while ($in{$modContactTitle} =~ /[\s]+$/) { chop($in{$modContactTitle}); }` [download] is really: `$in{$modContactTitle} =~ s/[\s]+$//;<br> # yes the '[]' aren't necessary, but are helpful` [download] and: $error = ++$error; is: $error++; and `[0-9]` [download] is \d, you can check for 5 digits: $modContactDeskPH3 =~ /\d{5}/ in one test (you check length and then digits but your first error msg say 'needs 5 digits'), often: if (length($in{$modContactEmail}) > 0) is: if ($in{$modContactEmail}) `and are you sure you want '1' and not $[ in: @array = (split " ", $sites); print $array[1]; if ($array[1] == 7) { ...` [download] Finally, this is odd while ( @row3 = $sth3->fetchrow() ) {} I know you're doing a lot of debugging w/ chipmunk on this so much may be an artifact of that so just take these as some hints (and not necessarily correct; TIMTOWTDI) for the future. a	[reply] [d/l] [select]