POPsearch.pl

#!/usr/bin/perl -w
use strict;

=NOTES

   This code shows how to perform a Dial-Up phone number search from the WWW
   using a tab deliminated text file in the format-
      Area Code, Phone Number, City, State.

   Searches are based on a three digit area code taken from the form input
   that gets passed to this program when a visitor uses it from the web.

      Tommy Butler - 2/7/03, for "Randy"

   This program is free software, you may redistribute and/or modify it under
   the terms of the GNU GPL. <URL: http://www.gnu.org/licenses/gpl.txt>

=cut

# Type in the name of the file which holds the dial-up number database.
# That's all you need to do.
my($dialup_DB) = './data/nationwidedial_up2003_2.txt';

use CGI qw/ header /;
my($cgi) = CGI->new();

# generate inital search form
print header, &search_form
   and exit unless $cgi->param('X-been-here');

# handle incorrect input
print header, &search_form(
   '"' . $cgi->param('Area Code') . '"' .
   qq[ isn't a valid three digit area code.]
)
   and exit unless
      $cgi->param('Area Code')
         &&
      $cgi->param('Area Code') =~ /^\d{3}$/;

# perform lookup
my($areacode,$number,$city,$state) = &lookup_number();

# handle searches that yield no results
print header, &search_form(
   qq[No results found for area code ] .
   '"' . $cgi->param('Area Code') . '"'
)
   and exit unless $number;

# output results of successful search
print header, &results($areacode,$number,$city,$state);

exit;

# subroutine which performs dial-up number lookup
sub lookup_number {

   open(FH,$dialup_DB)
      or die(qq[Problem while trying to open "$dialup_DB" $!]);

   while (<FH>) {

      my($areacode,$number,$city,$state) = split(/(?o)\t/,$_);

      close(FH) and return($areacode,$number,$city,$state)
         if $areacode eq $cgi->param('Area Code');
   }

   close(FH) and return undef
}

sub search_form { <<__FORM__ }
<?xml version="1.0" encoding='ISO-8859-1'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html
xmlns="http://www.w3.org/1999/xhtml"
xml:lang="en"
lang="en">
   <head>
      <title>Dial-Up Phone Number Lookup</title>
      <meta
       http-equiv="Content-Type"
       content="text/html; charset=iso-8859-1" />
   </head>
   <body>
      <p> </p>

      <h2>Dial-Up Phone Number Lookup</h2>

      <p>
         Enter your three digit area code to find the Dial-Up
         phone number in your area.
      </p>

      ${\ (@_ ? q[
         <p
          style="
          color: #AA0000;
          font-weight: bold;">] . join('',@_) . q[</p>] : '')
       }

      <form
       name="page 1"
       method="get"
       action="${\ ($cgi->self_url('query_string' => 0) || '') }">
      <input
       type="hidden"
       name="X-been-here"
       value="1" />

      <table>
         <tr>
            <td> Enter Your Telephone Area Code: </td>
            <td>
               <input
                type="text"
                size="3"
                name="Area Code"
                maxlength="3" /> </td>
         </tr>
         <tr>
            <td colspan="2">
               <input
                type="submit"
                name="submit"
                value="Get Dial-Up Number" />
            </td>
         </tr>
      </table>

      </form>

      <p> </p>
   </body>
</html>
__FORM__

sub results { my($areacode,$number,$city,$state) = @_; <<__RESULT__ }
<?xml version="1.0" encoding='ISO-8859-1'?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html
xmlns="http://www.w3.org/1999/xhtml"
xml:lang="en"
lang="en">
   <head>
      <title>Dial-Up Phone Number Lookup Results</title>
      <meta
       http-equiv="Content-Type"
       content="text/html; charset=iso-8859-1" />
   </head>
   <body>
      <p> </p>

      <h2>Dial-Up Phone Number Lookup Results</h2>

      <table>
         <tr>
            <td> Dial-Up Number for $city, $state: </td>
            <td
             style="
             padding-left: 25px;
             font-weight: bold;">
                  ($areacode) -
                  ${\ substr($number,0,3) } -
                  ${\ substr($number,3) }
            </td>
         </tr>
      </table>

      <p><a
       href="${\ ($cgi->self_url('query_string' => 0) || '') }"
       title="New Search">New Search</a></p>

      <p> </p>
   </body>
</html>
__RESULT__

# this section merely enables error logging for the script.  should you
# encounter errors with this CGI program, look for a log file in the
# directory which contains this program.  It will be named:
#  "[ Name of this program ]-error.log"
BEGIN { ++$| } BEGIN {
   local(*ERR);
   open(ERR,'>>./' . [( split(/\/|\\|\:/,__FILE__) )]->[-1] . '-error.log');
   open(STDERR,'>&ERR')
}
BEGIN {
   $SIG{'__WARN__'} = sub {
   $SIG{'__WARN__'} = sub { warn @_  };
   warn substr(<<__WARN__, 0, -1) } }

WARNINGS found in @{[ __FILE__ ]} at ${\ scalar localtime }\012@_
__WARN__

1;