CGI and Perl                        

   Contact
   Search
   C
   C++
   Visual Basic
   Java
   JavaScript
   DHTML
   Style Sheets
   About
   Active X
   TDC Binding
   PHP
   Perl and CGI
   Flash
   XML
   SQL
   Messages
   Chat
   MCSE
   Linux
   Cabling   
   ActionScript
   Downloads
   E-Cards   
 
    
    

CGI = Common Gateway Inerface
PERL = Practical Extraction and Report Language

CGI-Perl together make a very robust web server-side scripting/programming language.

-------------------------------------------------------------------------------------------------------------------------------------------------------
print
#!/usr/bin/perl
# Displaying inforamtion


print( "Welcome to Perl!\n" );
----------------------------------------------------------------------------------------------
print qq ~

Displays information between the designated characters you choose.   Perl 5 or above only.  In the example below,
all the HTML in blue would be dynamically written once the perl script is executed:
#!/usr/bin/perl
# Displaying inforamtion
print qq ~
<html>
<head>
<title>The Last Days</title>
</head>
<body bgcolor="000000" text="ffffff">
<center>
It was the best of times.  The worst of times.
</center>
</body>
</html>
~;
----------------------------------------------------------------------------------------------
Variables and Expressions

Note: Variables are prefixed with a "$".
#!/usr/bin/perl
# Program to illustrate the use of scalar variables.
$number = 5;
print( "The value of variable \$number is: $number\n\n" );
$number += 5;
print( "Variable \$number after adding 5 is: $number\n" );
$number *= 2;
print( "Variable \$number after multiplying by 2 is: " );
print( "$number\n\n\n" );
# using an uninitialized variable in the context of a string
print( "Using a variable before initializing: $variable\n\n" );
# using an uninitialized variable in a numeric context
$test = $undefined + 5;
print( "Adding uninitialized variable \$undefined " );
print( "to 5 yields: $test\n" );
# using strings in numeric contexts
$string = "A string value";
$number += $string;
print( "Adding a string to an integer yields: $number\n" );
$string2 = "15charactersand1";
$number2 = $number + $string2;
print( "Adding $number to string \"$string2\" yields: " );
print( "$string2\n" );
----------------------------------------------------------------------------------------------
Arrays

Note: Arrays are prefixed with the @.
#!/usr/bin/perl
# Program to demonstrate arrays in Perl.
@array = ( "Bill", "Bobby", "Sue", "Michelle" );
print( "The array contains: @array\n" );
print( "Printing array outside of quotes: ", @array, "\n\n" );
print( "Third element: $array[ 2 ]\n" );
$number = 3;
print( "Fourth element: $array[ $number ]\n\n" );
@array2 = ( 'A' .. 'Z' );
print( "The range operator is used to create a list of\n" );
print( "all capital letters from A to Z:\n" );
print( "@array2 \n\n" );
$array3[ 3 ] = "4th";
print( "Array with just one element initialized: @array3 \n\n" );
print( 'Printing literal using single quotes: ' );
print( '@array and \n', "\n" );
print( "Printing literal using backslashes: " );
print( "\@array and \\n\n" );
----------------------------------------------------------------------------------------------
If Statements and Strings
Comparative operators used only with strings:         C++ Equivalent:
ne = not                                                                        !
eq = equals                                                                  =
lt = less than                                                                <
gt = greater than                                                           >

qw = "quote word" operator.  Takes all inside its parentheses and adds quotes and commas.
So (dog cat parrot) becomes ("dog", "cat", "parrot"). 

foreach = iterates sequentially through each item in array.  
#!/usr/bin/perl
# Program to demonstrate the eq, ne, lt, gt operators.
@pets = qw( dog cat parrot );
foreach $item ( @pets ) {
   if ( $item eq "cat" ) {
      print( "String '$item' matches string 'cat'\n" );
   }
   if ( $item ne "cat" ) {
      print( "String '$item' does not match string 'cat'\n" );
   }
   if ( $item lt "cat" ) {
      print( "String '$item' is less than string 'cat'\n" );
   }
   if ( $item gt "cat" ) {
      print( "String '$item' is greater than string 'cat'\n" );
   }
}
----------------------------------------------------------------------------------------------
String Searches

m//  =  match operator.  The "m" can be ooptional.  
=~  =  binding operator.  Binds expression on left to expression on right.
/someword/i = ignore case when searching.
/someword/g = perform global search.
/someword/m = evaluate stinrg with multiple lines of text (do not ignore newline characters).
/someword/s = ignore newline characters.
/someword/x = all whitespace characters are ignored when searching string.
#!/usr/bin/perl
# Searches using the matching operator and regular expressions.
$search = "Now is is the time";
print( "Test string is: '$search'\n\n" );
if ( $search =~ /Now/ ) {
   print( "String 'Now' was found.\n" );
}
if ( $search =~ /^Now/ ) {
   print( "String 'Now' was found at the beginning of the line." );
   print( "\n" );
}
if ( $search =~ /Now$/ ) {
   print( "String 'Now' was found at the end of the line.\n" );
}
if ( $search =~ /\b ( \w+ ow ) \b/x ) {
   print( "Word found ending in 'ow': $1 \n" );
}
if ( $search =~ /\b ( \w+ ) \s ( \1 ) \b/x ) {
   print( "Repeated words found: $1 $2\n" );
}
@matches = ( $search =~ / \b ( t \w+ ) \b /gx );
print( "Words beginning with 't' found: @matches\n" );
----------------------------------------------------------------------------------------------
Obtaining Client and Server Environment Variables

HASH - sort of like an array, but not.  Arrays use indices for element access.  On the other hand, Hash elements
are accessed using a unique string key that is associated with that element's value.  The are known as "associative arrays", 
because the keys and values are associated in pairs.  They are accessed with the syntax:  $hashName{keyName}.  

use = imports modules in Perl.    use CGI qw( :standard ); imports CGI standard module so we can use its functions.
header() = standard html header tags inherited from CGI library.
start_html() = prints document type definition and opening tags.
Tr and th = calls up HTML table row and table header tags.
%ENV = hash that contains all environment variables.  Each key in the hash is the name of an environment variable.
end_html = adds closing tags.
#!/usr/bin/perl
# Fig. 27.11: fig27_11.pl
# Program to display CGI environment variables.
use CGI qw( :standard );
$networkingprogramming = "-//\"http://www.networkingprogramming.com";
print( header() );
print( start_html( { networkingprogramming => $networkingprogramming,
          title => "Client-Server Environment Variables" } ) );
print( "<table style = \"border: 0; padding: 2;
        font-weight: bold\">" );
print( Tr( th( "Variable Name" ),
           th( "Value" ) ) );
print( Tr( td( hr() ), td( hr() ) ) );
foreach $variable ( sort( keys( %ENV ) ) ) {
   print( Tr( td( { style => "background-color: #11bbff" }, 
                    $variable ),
              td( { style => "font-size: 12pt" }, 
                        $ENV{ $variable } ) ) );
   print( Tr( td( hr() ), td( hr() ) ) );
}
print( "</table>" );
print( end_html() );
----------------------------------------------------------------------------------------------
Processing Information form an HTML Form
HTML Form
<html>
   <head>
      <title>Sample form to take user input in XHTML</title>
   </head>
   <body style = "font-face: arial; font-size: 12pt">
      <div style = "font-size: 14pt; font-weight: bold">
            This is a sample registration form.
      </div>
      <br />
      Please fill in all fields and click Register.
  
  
   
      <form method = "post" action = "/cgi-bin/fig27_13.pl">
         <img src = "images/user.gif" /><br />
         <div style = "color: blue" >
            Please fill out the fields below.<br />
         </div>
     
     
      
         <img src = "images/fname.gif" />
         <input type = "text" name = "fname" /><br />
         <img src = "images/lname.gif" />
         <input type = "text" name = "lname" /><br />
         <img src = "images/email.gif" />
         <input type = "text" name = "email" /><br />
         <img src = "images/phone.gif" />
         <input type = "text" name = "phone" /><br />
     
     
      
         <div style = "font-size: 10pt">
            Must be in the form (555)555-5555.<br /><br />
         </div>
     
     
      
         <img src = "images/downloads.gif" /><br />
         <div style = "color: blue">
            Which book would you like information about?<br />
         </div>
         <select name = "book">
            <option>Internet and WWW How to Program 2e</option>
            <option>C++ How to Program 3e</option>
            <option>Java How to Program 4e</option>
            <option>XML How to Program 1e</option>
         </select><br /><br />
           
           
            
         <img src = "images/os.gif" /><br />
         <div style = "color: blue">
            Which operating system are you currently using?
         </div><br />
         <input type = "radio" name = "os"
            value = "Windows NT" checked />
         Windows NT<input type = "radio"
            name = "os" value = "Windows 2000" />
         Windows 2000<input type = "radio"
            name = "os" value = "Windows 98/me" />
         Windows 98/me<br /><input type = "radio"
            name = "os" value = "Linux" />
         Linux<input type = "radio" name = "os"
            value = "Other" />
         Other<br /><input type = "submit"
            value = "Register" />
      </form>
   </body>
</html>
PERL Script
#!/usr/bin/perl

use CGI qw( :standard );
$os = param( "os" );
$firstName = param( "fname" );
$lastName = param( "lname" );
$email = param( "email" );
$phone = param( "phone" );
$book = param( "book" );
$dtd =
"-//W3C//DTD XHTML 1.0 Transitional//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";
print( header() );
print( start_html( { dtd => $dtd,
                     title => "Form Results" } ) );
if ( $phone =~ / ^ \( \d{3} \) \d{3} - \d{4} $ /x ) {
   print( "Hi " );
   print( span( { style => "color: blue; font-weight: bold" },
                  $firstName ) );
   print( "!" );
   print( "\nThank you for completing the survey." );
   print( br(), "You have been added to the " );
   print( span( { style => "color: blue; font-weight: bold" },
                  $book ) );
   print( " mailing list.", br(), br() );
   print( span( { style => "font-weight: bold" },
                 "The following information has
                  been saved in our database: " ), br() );
   print( table(
          Tr( th( { style => "background-color: #ee82ee" },
                    "Name" ),
              th( { style => "background-color: #9370db" },
                    "E-mail" ),
              th( { style => "background-color: #4169e1" },
                    "Phone" ),
              th( { style => "background-color: #40e0d0" },
                    "OS" ) ),
          Tr( { style => "background-color: #c0c0c0" },
              td( "$firstName $lastName" ),
              td( $email ),
              td( $phone ),
              td( $os ) ) ) );
   print( br() );
   print( div( { style => "font-size: x-small" },
            "This is only a sample form. You have not been
             added to a mailing list." ) ); 
}
else {
   print( div( { style => "color: red; font-size: x-large" },
             "INVALID PHONE NUMBER" ), br() );
   print( "A valid phone number must be in the form " );
   print( span( { style => "font-weight: bold" },
                  "(555)555-5555." ) );
   print( div( { style => "color: blue" },
             "Click the Back button, and enter a
              valid phone number and resubmit." ) );
   print( br(), br() );
   print( "Thank you." );
}
print( end_html() );
----------------------------------------------------------------------------------------------
Server Side Includes

Server Side Includes are embedded commands that allow the inclusion of dynamic content (such as time or date).
Since not all servers wupport them, they are written in HTML comment tags with keywords.  SSIs are ususally given
a file extension of ".shtml" instead of ".html". 

EXEC = runs CGI scripts and embeds their output into a stnadard HTML page.
ECHO VAR = displays variable information indicated by keyword "VAR".
OPEN = used to assign a file handle.
Environment Variables:
<html>
   <head>
      <title>Server Side Includes</title>
   </head>
   <body>  
      <h3 style = "text-align: center">
         Using Server Side Includes
      </h3>
  
  
   
      <!--#EXEC CGI="/cgi-bin/SomeKindOfScript.pl" --><br />
  
  
   
      The Greenwich Mean Time is
      <span style = "color: blue">
         <!--#ECHO VAR="DATE_GMT" -->.
      </span><br />
  
  
   
      The name of this document is
      <span style = "color: blue">
         <!--#ECHO VAR="DOCUMENT_NAME" -->.
      </span><br />
      The local date is
      <span style = "color: blue">  
         <!--#ECHO VAR="DATE_LOCAL" -->.
      </span><br />
      This document was last modified on
      <span style = "color: blue">
         <!--#ECHO VAR="LAST_MODIFIED" -->.
      </span><br />
      Your current IP Address is
      <span style = "color: blue"> 
         <!--#ECHO VAR="REMOTE_ADDR" -->.
      </span><br />
      My server name is
      <span style = "color: blue">
         <!--#ECHO VAR="SERVER_NAME" -->.
      </span><br />
      And I am using the
      <span style = "color: blue">  
         <!--#ECHO VAR="SERVER_SOFTWARE" -->
         Web Server.
      </span><br />
      You are using
      <span style = "color: blue"> 
         <!--#ECHO VAR="HTTP_USER_AGENT" -->.
      </span><br />
      This server is using
      <span style = "color: blue">  
         <!--#ECHO VAR="GATEWAY_INTERFACE" -->.
      </span><br />
      <br /><br />
      <div style = "text-align: center;
                    font-size: xx-small">
         <hr />
         This document was last modified on
         <!--#ECHO VAR="LAST_MODIFIED" -->.
      </div>
   </body>
</html>
Page Counter
#!/usr/bin/perl
use CGI qw( :standard );
open( COUNTREAD, "counter.dat" );
$data = <COUNTREAD>;
$data++;
close( COUNTREAD );
open( COUNTWRITE, ">counter.dat" );
print( COUNTWRITE $data );
close( COUNTWRITE );
print( header(), "<div style = \"text-align: center;
                                font-weight: bold\">" );
print( "You are visitor number", br() );
for ( $count = 0; $count < length( $data ); $count++ ) {
   $number = substr( $data, $count, 1 );
   print( img( { src => "images/$number.gif" } ), "\n" );
}
print( "</div>" );
----------------------------------------------------------------------------------------------
UserName and Password Check
die = executes when something returns false - in this case "open".
sub = subroutine.  Like functions in C++ and Java/JavaScript.

HTML FILE
<html>
   <head>
      <title>Verifying a username and a password</title>
   </head>
   <body>
      <p>
         <div style = "font-family = arial">
            Type in your username and password below.
         </div><br />
         <div style = "color: #0000ff; font-family: arial;
                       font-weight: bold; font-size: x-small">
            Note that the password will be sent as plain text.
         </div>
      </p>
      <form action = "/cgi-bin/fig27_17.pl" method = "post">
  
  
   
         <table style = "background-color: #dddddd">
            <tr>
               <td style = "font-face: arial;
                            font-weight: bold">Username:</td>
            </tr>
            <tr>
               <td>
                  <input name = "username" />
               </td>
            </tr>
            <tr>
               <td style = "font-face: arial;
                            font-weight: bold">Password:</td>
            </tr>
            <tr>
               <td>
                  <input name = "password" type = "password" />
               </td>
            </tr>
            <tr>
               <td>
                  <input type = "submit" value = "Enter" />
               </td>
            </tr>
         </table>
      </form>
   </body>
</html>
PERL FILE
#!/usr/bin/perl

use CGI qw( :standard );
$dtd =
"-//W3C//DTD XHTML 1.0 Transitional//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";
$testUsername = param( "username" );
$testPassword = param( "password" );
open( FILE, "password.txt" ) or
   die( "The database could not be opened." );
while ( $line = <FILE> ) {
   chomp( $line );
   ( $username, $password ) = split( ",", $line );
  
  
   
   if ( $testUsername eq $username ) {
      $userVerified = 1;
      if ( $testPassword eq $password ) {
         $passwordVerified = 1;
         last;
      }
   }
}
close( FILE );
print( header() );
print( start_html( { dtd => $dtd,
                     title => "Password Analyzed" } ) );
if ( $userVerified && $passwordVerified ) {
   accessGranted();
}
elsif ( $userVerified && !$passwordVerified ) {
   wrongPassword();
}
else {
   accessDenied();
}
print( end_html() );
sub accessGranted
{
   print( div( { style => "font-face: arial;
                           color: blue;
                           font-weight: bold" },
      "Permission has been granted,
       $username.", br(), "Enjoy the site." ) );
}
sub wrongPassword
{
   print( div( { style => "font-face: arial;
                           color: red;
                           font-weight: bold" },
      "You entered an invalid password.", br(),
      "Access has been denied." ) );
}
sub accessDenied
{
   print( div( { style => "font-face: arial;
                           color: red;
                           font-size: larger;
                           font-weight: bold" },
      "You have been denied access to this site." ) );
}
Password Text File
account1,password1
account2,password2
account3,password3
account4,password4
account5,password5
account6,password6
account7,password7
account8,password8
account9,password9
account10,password10
----------------------------------------------------------------------------------------------
Cookies

Cookies are small text files stored on the client's hard drive that can store form information for web site visits.
Part 1 - HTML File for Writing Cookie
<html>
   <head>
      <title>Writing a cookie to the client computer</title>
   </head>
   <body style = "font-face: arial">
         <div style = "font-size: large;
                       font-weight: bold">
            Click Write Cookie to save your cookie data.
         </div><br />
  
   
   
         <form method = "post" action = "cgi-bin/fig27_22.pl"
               style = "font-weight: bold">
            Name:<br />
            <input type = "text" name = "name" /><br />
            Height:<br />
            <input type = "text" name = "height" /><br />
            Favorite Color:<br />
            <input type = "text" name = "color" /><br />
            <input type = "submit" value = "Write Cookie" />
         </form>
      </font>
   </body>
</html>
Part 2 - PERL File for Writing Cookie
#!/usr/bin/perl

use CGI qw( :standard );
$name = param( "name" );
$height = param( "height" );
$color = param( "color" );
$expires = "Monday, 11-JUN-01 16:00:00 GMT";
print( "Set-Cookie: Name=$name; expires=$expires; path=\n" );
print( "Set-Cookie: Height=$height; expires=$expires; path=\n" );
print( "Set-Cookie: Color=$color; expires=$expires; path=\n" );
$dtd =
"-//W3C//DTD XHTML 1.0 Transitional//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";
print( header() );
print( start_html( { dtd => $dtd,
                     title => "Cookie Saved" } ) );
print <<End_Data;
<div style = "font-face: arial; font-size: larger">
   The cookie has been set with the following data:
</div><br /><br />
<span style = "color: blue">
Name: <span style = "color: black">$name</span><br />
Height: <span style = "color: black">$height</span><br />
Favorite Color:</span>
<span style = "color: $color"> $color</span><br />
<br />Click <a href = "fig27_25.pl">here</a>
to read saved cookie.
End_Data
print( end_html() );
Part 3 - PERL File for Reading Cookie
#!/usr/bin/perl
use CGI qw( :standard );
$dtd =
"-//W3C//DTD XHTML 1.0 Transitional//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";
print( header() );
print( start_html( { dtd => $dtd,
                     title => "Read Cookies" } ) );
print( div( { style => "font-face: arial;
                        font-size: larger;
                        font-weight: bold" },
          "The following data is saved in a
           cookie on your computer." ), br() );
print( "<table style = \"background-color: #aaaaaa\"
               border = 5 cellpadding = 10
               cellspacing = 0>" );
%cookies = readCookies();
$color = $cookies{ Color };
foreach $cookieName ( "Name", "Height", "Color" ) {
   print( Tr( td( { style => "background-color: $color" },
                  $cookieName ),
              td( $cookies{ $cookieName } ) ) );
}
print( "<table>" );
print( end_html() );
sub readCookies
{
   @cookieArray = split( "; ", $ENV{ 'HTTP_COOKIE' } );
   foreach ( @cookieArray ) {
      ( $cookieName, $cookieValue ) = split( "=", $_ );
      $cookieHash{ $cookieName } = $cookieValue;
   }
  
   
   
   return %cookieHash;
}
----------------------------------------------------------------------------------------------
DBI (Database Interface)
DBI allows PERL to connect to relational databases and handle SQL queries.  Examples:

#!/usr/bin/perl
use CGI qw( :standard );
use DBI;
use DBD::mysql;
$dtd =
"-//W3C//DTD XHTML 1.0 Transitional//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";
print( header() );
print( start_html( { dtd => $dtd,
                     title => "Authors" } ) );
# connect to "books" database, no password needed
$databaseHandle = DBI->connect( "DBI:mysql:books",
                     "root", "", { RaiseError => 1 } );
# retrieve the names and IDs of all authors
$query = "SELECT FirstName, LastName, AuthorID
          FROM Authors ORDER BY LastName";
# prepare the query for execution, then execute it
# a prepared query can be executed multiple times
$statementHandle = $databaseHandle->prepare( $query );
$statementHandle->execute();
print( h2( "Choose an author:" ) );
print( start_form( { action => 'fig27_20.pl' } ) );
print( "<select name = \"author\">\n" );
# drop-down list contains the author and ID number
# method fetchrow_array returns a single row from the result
while ( @row = $statementHandle->fetchrow_array() ) {
   print( "<option>" );
   print( "$row[ 2 ]. $row[ 1 ], $row[ 0 ]" );
   print( "</option>" );
}
print( "</select>\n" );
print( submit( { value => 'Get Info' } ) );
print( end_form(), end_html() );
# clean up -- close the statement and database handles
$databaseHandle->disconnect();
$statementHandle->finish();

 

 
#!/usr/bin/perl
use CGI qw( :standard );
use DBI;
use DBD::mysql;
$dtd =
"-//W3C//DTD XHTML 1.0 Transitional//EN\"
   \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd";
print( header() );
# retrieve author's ID and name from the posted form
$authorID = substr( param( "author" ), 0, 1 );
$authorName = substr( param( "author" ), 3 );
print( start_html( { dtd => $dtd,
                     title => "Books by $authorName" } ) );
$databaseHandle = DBI->connect( "DBI:mysql:books",
                     "root", "", { RaiseError => 1 } );
# use AuthorID to find all the ISBNs related to this author
$query1 = "SELECT ISBN FROM AuthorISBN
           WHERE AuthorID = $authorID";
$statementHandle1 = $databaseHandle->prepare( $query1 );
$statementHandle1->execute();
print( h2( "$authorName" ) );
print( "<table border = 1>" );
print( th( "Title" ), th( "ISBN" ), th( "Publisher" ) );
while ( @isbn = $statementHandle1->fetchrow_array() ) {
   print( "<tr>\n" );
   # use ISBN to find the corresponding title
   $query2 = "SELECT Title, PublisherID FROM titles
              WHERE ISBN = \'$isbn[ 0 ]\'";
   $statementHandle2 = $databaseHandle->prepare( $query2 );
   $statementHandle2->execute();
   @title_publisherID = $statementHandle2->fetchrow_array();
   # use PublisherID to find the corresponding PublisherName
   $query3 = "SELECT PublisherName FROM Publishers
              WHERE PublisherID = \'$title_publisherID[ 1 ]\'";
   $statementHandle3 = $databaseHandle->prepare( $query3 );
   $statementHandle3->execute();
   @publisher = $statementHandle3->fetchrow_array();
   # print resulting values
   print( td( $title_publisherID[ 0 ] ), "\n" );
   print( td( $isbn[ 0 ] ), "\n" );
   print( td( $publisher[ 0 ] ), "\n" );
   print( "</tr>" );
   $statementHandle2->finish();
   $statementHandle3->finish();
}
print( "</table>" );
print( end_html() );
$databaseHandle->disconnect();
$statementHandle1->finish();