Perl Tutorial - Practical Extraction and Reporting Language (Perl)
Please leave a remark at the bottom of each page with your useful suggestion.
Table of Contents
- Perl Introduction
- Perl Program Startup
- Perl Regular Expressions
- Perl Array Program
- Perl Basic Program
- Perl Subroutine / Function Program
- Perl XML Program
- Perl String Program
- Perl Statement Program
- Perl Network Program
- Perl Hash Program
- Perl File Handling Program
- Perl Data Type Program
- Perl Database Program
- Perl Class Program
- Perl CGI Program
- Perl GUI Program
- Perl Report Program
Perl CGI Program
Add a New Phone Number
<html>
<head>
<title>Add a New Phone Number</title>
</head>
<body>
<h2>Add a New Phone No</h2>
<form name="phoneform" method="post" action="index.pl">
Forename:<input type="text" name="forename">
Surname:<input type="text" name="surname">
Department:<input type="text" name="dept">
Phone No:<input type="text" name="phone">
Comments: <textarea name="comments"></textarea>
<input type="submit" name="submit" value="Add Record">
<input type="reset" name="reset" value="Clear Form and Start Again!">
</form>
</font>
</body>
</html>
#!c:\perl\bin
print "Content-type: text/html\n\n";
read(STDIN,$tempbuffer,$ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$tempbuffer);
foreach $item(@pairs){
($key,$content)=split(/=/,$item,2);
$content=~tr/+/ /;
$content=~s/%(..)/pack("c",hex($1))/g;
$fields{$key}=$content;
print "$key";
print " contains $content";
}Add form data to database
<html>
<head>
<title>Add New Contact</title>
</head>
<body>
<div align=center>
Contact Database<br><br>
Add New Contact<br><br>
</div>
<form name="addrec" method="post" action="insertrec.pl"><br>
Firstname<input name="firstname" type="text">
Middle Initial<input name="middle" type="text" size="3">
Last Name<input name="lastname" type="text" size="20">
Address<input name="street" type="text" size="40">
Town<input name="town" type="text" size="15">
Zip<input name="postcode" type="text" size="15">
Phone<input name="phone" type="text" size="10">
e-mail<input name="email" type="text" size="20">
Comments<textarea name=comments rows=4 cols=50></textarea>
<input type="button" name="addit" value="Add Contact"></td>
<td><input type="reset" name="reset" value="Clear Form"></td>
</body>
</html>
//File: insertrec.pl
#!c:/perl/bin
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
use CGI ':standard';
print header();
$firstname = param("firstname");
$lastname = param("lastname");
$middle = param("middle");
$street = param("street");
$town = param("town");
$postcode = param("postcode");
$phone = param("phone");
$email = param("email");
$comments = param("comments");
$table = "contact_table";
$conn = Win32::OLE->new("ADODB.Connection");
$rs = Win32::OLE->new("ADODB.Recordset");
$sql = "INSERT INTO $table (firstname, middle, lastname, street, town,postcode, telephone, email, comments)
VALUES ('$firstname', '$middle', '$lastname', '$street', '$town','$postcode', '$phone', '$email', '$comments')";
$conn->Open("contact");
$conn->Execute($sql);
print "<br>Contacts Database<br>";
print "Record Added!<br>";
print "<a href=/addcontact.htm>Add Another Contact?</a><br><br>";
print "<a href=/home.htm>Home</a><br><br>";
$rs->Close;
$conn->Close;A Form-Based Example
<HTML><HEAD>
<TITLE>A Simple Form-Based Example</TITLE>
</HEAD>
<FORM METHOD=GET ACTION="index.pl">
<H1>Please enter your name:</H1>
<P>First name: <INPUT NAME="first" TYPE=TEXT></P>
<P>Last name: <INPUT NAME="last" TYPE=TEXT></P>
<P><INPUT NAME="OK" TYPE=SUBMIT></P>
</FORM>
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $cgi=new CGI; #read in parameters
print $cgi->header(); #print a header
print $cgi->start_html("Welcome"); #generate HTML document start
print "<h1>Welcome, ",$cgi->param('first')," ",$cgi->param('last'),"</h1>";
print $cgi->end_html(); #finish HTML documentAn example of using QUERY_STRING.
# Name this Perl script file as test.pl
use warnings;
use strict;
use CGI qw( :standard );
my $query = $ENV{ "QUERY_STRING" };
print header(), start_html( "QUERY_STRING example" );
print h2( "Name/Value Pairs" );
if ( $query eq "" ) {
print 'Please add some name-value pairs to the URL above. ';
print 'Or try <a href = "test.pl?name=Joe&age=29">this</a>.';
}
else {
print i( "The query string is '$query'." ), br();
my @pairs = split ( "&", $query );
foreach my $pair ( @pairs ) {
my ( $name, $value ) = split ( "=", $pair );
print "You set '$name' to value '$value'.", br();
}
}
print end_html();A Safe String Example with uri_escape
#!/usr/bin/perl -T
use strict;
use URI::Escape;
use CGI qw/:standard/;
my $unsafestring = "\$5/[3454]/this is a windows filename.asp";
my $safestring = uri_escape($unsafestring);
print header,
start_html("start"),
p("unsafe URL is: $unsafestring\n"),
p("url_escape() function:$safestring\n"),
end_html;
exit;A Simple CGI Script
#!c:/ActivePerl/bin/perl.exe
$now=localtime;
$myname="AAA";
print <<EOF;
Content-type:text/html
<body>
<p>
Today is $now<br>
</body>
EOFA Simple Cookie Example
#!/usr/bin/perl -T
use strict;
print "Content-type: text/html\n";
print "Set-Cookie: testcookie=testvalue;";
print "\n\n";
print "You've received a cookie<p>\n";
exit;A Simple Cookie Example Using the CGI Module
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
my $cookie = cookie(-name=>'testcookie',-value=>'testvalue');
print header (-cookie=>$cookie);
print "You've received a cookie<p>\n";
exit;Authorization-required response
#!/usr/bin/perl
use warnings;
use strict;
use CGI;
my $cgi=new CGI;
print $cgi->header('text/html','401 Authorization Required');Capitalize the first letter of each parameter using ucfirst
<HTML><HEAD>
<TITLE>A Simple Form-Based Example</TITLE>
</HEAD>
<FORM METHOD=GET ACTION="index.pl">
<H1>Please enter your name:</H1>
<P>First name: <INPUT NAME="first" TYPE=TEXT></P>
<P>Last name: <INPUT NAME="last" TYPE=TEXT></P>
<P><INPUT NAME="OK" TYPE=SUBMIT></P>
</FORM>
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $cgi=new CGI; #read in parameters
#iterate over each parameter name
foreach ($cgi->param()) {
#modify and set each parameter value from itself
$cgi->param($_,ucfirst(lc($cgi->param($_))));
}
print $cgi->header(); #print a header
print $cgi->start_html("Welcome"); #generate HTML document start
print "<h1>Welcome, ",$cgi->param('first')," ",$cgi->param('last'),"</h1>";
print $cgi->end_html();CGI client-related environment variables
VARIABLE MEANING
AUTH_TYPE the authentication type to be used.
HTTP_ACCEPT MIME types that the client understands.
REMOTE_ADDR The IP address of the client making the CGI request.
REMOTE_HOST this variable is set to the client's name.
REMOTE_IDENT client user's name.
REMOTE_USER authentication and the correct protocol is supported by the clientCGI environment variable
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print
$co->header,
$co->start_html('CGI Environment Variables Example'),
$co->center($co->h1('CGI Environment Variables Example'));
foreach $key (sort keys %ENV) {
print $co->b("$key=>$ENV{$key}"),
$co->br;
}
print $co->end_html;CGI Environment Variables
# The HTML file with a hotlink to a CGI script
<html>
<head>
<title>TESTING ENV VARIABLES</title>
</head>
<body>
<p>
<a href="printenv.pl">here</a>
<p>text continues here...
</body>
</html>
#!/bin/perl
print "Content type: text/plain\n\n";
print "CGI/1.1 test script report:\n\n";
while(($key, $value)=each(%ENV)){
print "$key = $value\n";
}CGI Environment Variables (Must Be Uppercase)
Name Value
AUTH_TYPE if server supports user authentication
CONTENT_LENGTH The number of bytes passed from the server
CONTENT_TYPE MIME type
DOCUMENT ROOT The directory from which the server serves Web documents /index.html
GATEWAY_INTERFACE The revision of the CGI
HTTP_ACCEPT The MIME types accepted by the client
HTTP_CONNECTION The preferred HTTP connection typeCGI file upload example
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
if (!$co->param())
{
print
$co->header,
$co->start_html('CGI File Upload Example'),
$co->center
(
$co->start_multipart_form,
$co->filefield(-name=>'filename', -size=>30),
$co->br,
$co->submit(-value=>'Upload'),
$co->reset,
$co->end_form
),
$co->hr;
} else {
print
$co->header,
$co->start_html('');
$file = $co->param('filename');
@data = <$file>;
foreach (@data) {
s/\n/<br>/g;
}
print
$co->center($co->h2("Here's the contents of $file...")),
"@data";
}
print $co->end_html;CGI request-related environment variables
VARIABLE MEANING
CONTENT_LENGTH The length of POST data sent by the client.
CONTENT_TYPE For POST and PUT requests, this is the type of data being sent.
PATH_INFO extra path information
PATH_TRANSLATED Path info for Web document
QUERY_STRING query string
REQUEST_METHOD The type of request being made. Normally this is either GET or POST.
SCRIPT_NAME The path to the script used to refer to it in a URL.CGI server-related environment variables
VARIABLE MEANING
GATEWAY_INTERFACE The version of CGI that the server supports. This might be CGI/1.1.
SERVER_NAME The Internet domain name of the server.
SERVER_PORT The port number that the Web server is using.
SERVER_PROTOCOL The name and version of the protocol with which the client sent this request.
SERVER_SOFTWARE The name and version of the Web server software. This might be NCSA/1.3.Checking for Acceptable File Types
#!/usr/bin/perl
use strict;
use CGI qw/:standard/;
my $q = new CGI;
my $filename = $q->param('uploaded_file');
my $contenttype = $q->uploadInfo($filename)->{'Content-Type'};
print header;
print start_html;
if ($contenttype !~ /^text\/html$/) {
print "Only HTML is allowed<P>";
print end_html;
exit;
} else {
print "Type is $contenttype<P>";
}
print end_html;Code to Accept Input with the CGI Module
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
print header,
start_html('Hello'),
start_form,
"Enter your name: ",textfield('name'),
submit,
end_form,
hr,
end_html;
exit;Cookies and Session Tracking
#!/usr/bin/perl
use warnings;
use CGI;
use strict;
print "content-type: text/html\n\n";
my $cgi=new CGI;
my $cookie1=$cgi->cookie(-name=>"myCookie1",-value=>"abcde");
print "Cookie 1: $cookie1\n";
#equivalently:
#!/usr/bin/perl
use warnings;
use CGI::Cookie;
use strict;
print "content-type: text/html\n\n";
my $cookie2=new CGI::Cookie(-name=>"myCookie2",-value=>"fghij");
print "Cookie 2: $cookie2\n";Create a form and set the method and action
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->start_form
(
-method=>'POST',
-action=>"http://www.yourserver.com/user/cgi/cgi2.cgi"
);Create a form with Perl code
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html(-title=>'CGI Example'),
$co->center($co->h1('Welcome to CGI!')),
$co->start_form(),
$co->textarea
(
-name=>'textarea',
-rows=>10,
-columns=>60
),
$co->end_form(),
$co->end_html;Create a form with submit button
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->start_form
(
-method=>'POST',
-action=>"http://www.yourserver.com/user/cgi/cgi2.cgi"
),
$co->textarea
(
-name=>'textarea',
-value=>'Hello!',
-rows=>10,
-columns=>60
),
$co->submit('Submit'),
$co->reset,
$co->end_form;Create cookie
use CGI;
$q1 = new CGI;
$cookie1 = $q1->cookie(
-name=>'FIRST_NAME', -value=>'Joe',
-expires=>'Fri, 30-Aug-2002 15:30:30 GMT;',
-path=>'/',
-domain=>'127.0.0.1');
print $q1->header(-cookie=>$cookie1);
print "Cookie Created ...";Create Frame set
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->frameset(
{-rows=>'40%,60%'},
$co->frame
({
-name=>'top',
-src=>'http://www.yourserver.com/username/cgi/a.htm'
}),
$co->frame
({
-name=>'bottom',
-src=>'http://www.yourserver.com/username/cgi/b.htm'
})
);Create header 1 using Perl code
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html(-title=>'CGI Example'),
$co->center($co->h1('Welcome to CGI!')),
$co->start_form(),
$co->textarea
(
-name=>'textarea',
-rows=>10,
-columns=>60
),
$co->end_form(),
$co->end_html;Create HTML form with CGI
#!c:/perl/bin
use CGI ':standard';
print header();
print "Form Elements", br(), br(), br();
print start_form;
print "A Text Box: ", textfield('surname', 'Default', 50), br();
print "A Select Box: ", popup_menu('SelectBox', ['Perl', 'Web', 'Development'], 'Fast');
print p, "Text Area: ", textarea('comments', 'Default Text', 10, 50);
print p, "CheckBoxes: ", checkbox_group('check1', ['one', 'two', 'three']);
print p, "Radio Buttons: ", radio_group('radio1', ['a', 'b', 'c']);
print p, submit();
print end_form;
if (param())
{
print "The surname you entered was: ",em(param('surname')),
p, "The Selections are: ",em(join(", ",param('SelectBox'))),
p, "The comments box contains: ",em(param('comments')),
p, "you selected checkbox: ",em(param('check1')),
p, "you selected radio: ",em(param('radio1'));
}Create Image map
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html('Image Map Example'),
$co->h1('Image Map Example'),
$co->start_form,
$co->image_button
(
-name => 'map',
-src=>'map.gif'
),
$co->p,
$co->end_form,
$co->hr;
if ($co->param())
{
$x = $co->param('map.x');
$y = $co->param('map.y');
print "You clicked the map at ($x, $y)";
}
print $co->end_html;Create three table rows with the same attributes for each
#!/usr/bin/perl
use warnings;
use CGI::Pretty;
use strict;
print "Content-type: text/html\n\n";
my $cgi=new CGI;
print $cgi->table({-border=>1,-cellspacing=>3,-cellpadding=>3},
$cgi->Tr({-align=>'center',-valign=>'top'}, [
$cgi->th(["Column1","Column2","Column3"]),]),
$cgi->Tr({-align=>'center',-valign=>'middle'}, [
$cgi->td(["Red","Blue","Yellow"]),
$cgi->td(["Cyan","Orange","Magenta"]),
$cgi->td({-colspan=>3},["A wide row"]),]),
$cgi->caption("An example table")
);Creating a Table
#!\usr\bin\perl
use warnings;
use strict;
use DBI;
my ($dbh, $sth);
$dbh=DBI->connect('dbi:mysql:test','root','password') || die "Error opening database: $DBI::errstr\n";
$sth=$dbh->prepare("CREATE TABLE checkin (id INTEGER AUTO_INCREMENT PRIMARY KEY,
firstname VARCHAR(32) NOT NULL,
lastname VARCHAR(32) NOT NULL,
destination VARCHAR(32) NOT NULL)");
$sth->execute(); # execute the statement
$sth->finish(); # finish the execution
print "All done\n";
$dbh->disconnect || die "Failed to disconnect\n";Data-Entry Forms in Web Pages
<html>
<body>
<FORM METHOD="POST" ACTION="index.cgi">
<H2>Customer Order Tracking</H2>
Enter order number:
<INPUT NAME="orderno">
<p>
<INPUT TYPE="submit" VALUE="Look up">
</FORM>
</body>
</html>
#!/usr/bin/perl -w
# CGI script using CGI.pm module.
use CGI;
$form = CGI->new();
$orderno = $form->param('orderno');
print $form->header();
print $form->start_html(-title=>'Customer Order Tracking',-BGCOLOR=>'white');
print "<h1>Your Order Number</h1>\n";
print "Your order number was: $orderno.\n";
print "<p>\n"; # Paragraph
# End HTML form.
print $form->end_html();Decoding the Input Data
<html>
<body>
<form action="index.pl" method=get>
Name: <BR>
<input type="text" size=50 name=name>Salary ($####.##): <BR>
<INPUT TYPE="text" SIZE=30 NAME=Salary>Birth date (mm/dd/yy): <BR>
<input type="text" size=30 name=birthdate><P/>
<input type=submit value="Submit Query">
<INPUT TYPE=RESET VALUE="Reset">
</form>
</body></html>
//File: index.pl
#!c:/perl/bin/perl
print "Content-type: text/html\n\n";
print <<HTML;
<html><title>Decoding the Input Data</title>
<body>
HTML
print "Decoding the query string";
$inputstring=$ENV{QUERY_STRING}};
print "<B>Before decoding:</B>";
print "<P>$inputstring";
@key_value=split(/&/,$inputstring);
foreach $pair ( @key_value){
($key, $value) = split(/=/, $pair);
$value=~s/%(..)/pack("C", hex($1))/ge;
$value =~ s/\n/ /g;
$value =~ s/\r//g;
$value =~ s/\cM//g;
$input{$key}=$value ; # Creating a hash
}
print "<HR>";
print "<P><B>After decoding:</B><P>";
while(($key, $value)=each(%input)){
print "$key: <I>$value</I><BR>";
}
print <<HTML;
<hr>
</body>
</html>
HTMLDefines a title, author, base, and target for a document, plus a few metatags and a stylesheet:
#!/usr/bin/perl
use warnings;
use CGI qw(Link myheadertag);
use strict;
my $cgi=new CGI;
print $cgi->header();
print $cgi->start_html(-title => 'A HTML document header',
-author=> 's@h.org',
-xbase => 'http://h.net',
-target => '_map_panel',
-meta => {keywords => 'CGI header HTML',
description => 'Header',
message => 'Hello World!'},
-style => {src => '/my.css'},
-head => [Link({-rel=>'origin',
-href=>'http://h.org/'}),
myheadertag({-myattr=>'myvalue'}),]
);
print $cgi->end_html();Demonstrates GET method with HTML form.
# Name this Perl script as test.pl
use warnings;
use strict;
use CGI qw( :standard );
our ( $name, $value ) = split( '=', $ENV{ QUERY_STRING } );
print header(), start_html( 'Using GET with forms' );
print p( 'Enter one of your favorite words here: ' );
print '<form method = "GET" action = "test.pl">';
print '<input type = "text" name = "word">';
print '<input type = "submit" value = "Submit word">';
print '</form>';
if ( $name eq 'word' ) {
print p( 'Your word is: ', b( $value ) );
}
print end_html();Demonstrates use of CGI.pm with HTML form.
use warnings;
use strict;
use CGI qw( :standard );
my $word = param( "word" );
print header(), start_html( 'Using CGI.pm with forms' );
print p( 'Enter one of your favorite words here: ' );
print start_form(), textfield( "word" );
print submit( "Submit word" ), end_form();
print p( 'Your word is: ', b( $word ) ) if $word;
print end_html();Demostrates POST method with HTML form.
# Name this Perl script as test.pl
use warnings;
use strict;
use CGI qw( :standard );
our ( $data, $name, $value );
read( STDIN, $data, $ENV{ 'CONTENT_LENGTH' } );
( $name, $value ) = split( '=', $data );
print header(), start_html( 'Using POST with forms' );
print p( 'Enter one of your favorite words here: ' );
print '<form method = "POST" action = "test.pl">';
print '<input type = "text" name = "word">';
print '<input type = "submit" value = "Submit word">';
print '</form>';
if ( $name eq 'word' ) {
print p( 'Your word is: ', b( $value ) );
}
print end_html();Determining the User Agent and Printing the Appropriate Result
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
my $useragent = $ENV{'HTTP_USER_AGENT'};
print header,
start_html('User Agent Example');
if ($useragent =~ /Firefox/) {
print p("You are visiting with a Firefox browser");
} elsif ($useragent =~ /MSIE/) {
print p("You are visiting with an Internet Explorer browser");
} else {
print p("Could not determine browser: $useragent");
}
print end_html;
exit;Display all values in env
#!/usr/bin/perl -w
use strict;
print "Content-Type: text/plain\n";
print "\n";
foreach (sort keys %ENV) {
print "$_ = $ENV{$_}\n";
}Display CGI environment variables
#!perl
use CGI qw( :standard );
print header;
print <<End_Begin;
<HTML>
<HEAD>
<TITLE>Environment Variables...</TITLE>
</HEAD>
<BODY>
<TABLE>
End_Begin
foreach $variable ( sort( keys( %ENV ) ) )
{
print <<End_Row;
<TR>
<TD><STRONG>$variable</STRONG></TD>
<TD>$ENV{$variable}</TD>
</TR>
End_Row
}
print <<End_Finish;
</TABLE>
</BODY>
</HTML>
End_Finish
# Must include newline after End_Finish!EMail sending form
<HTML>
<HEAD>
<TITLE>Send me some email</TITLE>
</HEAD>
<BODY>
<H1>Send me some email!</H1>
<FORM METHOD="POST"
ACTION="email.cgi" ENCTYPE="application/x-www-form-urlencoded">
Please enter your email address: <INPUT TYPE="text" NAME="name" VALUE=""><P>
Please enter the email's subject:<INPUT TYPE="text" NAME="subject" VALUE=""><P>
Please enter the email you want to send: <P>
<TEXTAREA NAME="text">Dear you:</TEXTAREA>
<P>
<INPUT TYPE="submit" NAME="submit" VALUE="Send email">
<INPUT TYPE="reset">
</FORM>
</BODY>
</HTML>
#File: email.cgi
#!/usr/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html
(
-title=>'Email Example',
-author=>'your name',
-BGCOLOR=>'white',
-LINK=>'red'
);
if ($co->param()) {
$from = $co->param('name');
$from =~ s/@/\@/;
$subject = $co->param('subject');
$text = $co->param('text');
$text =~ s/</</g;
open(MAIL, '| /usr/lib/sendmail -t -oi');
print MAIL <<EOF;
To: yourname\@yourserver.com
From: $from
Subject: $subject
$text
EOF
close MAIL;
}
print
$co->center($co->h1('Thanks for sending me email!')),
$co->hr,
$co->end_html;$ENV{'HTTP_USER_AGENT'}, $ENV{'SERVER_PROTOCOL'}, $ENV{'HTTP_HOST'}
#!/usr/bin/perl
print "Content-type: text/html\n\n";
print "Your browser is a $ENV{'HTTP_USER_AGENT'} <BR>";
print "The Server Protocol is $ENV{'SERVER_PROTOCOL'}<BR>";
print "The HTTP Host is $ENV{'HTTP_HOST'}<BR>";Explicitly name the content type and status arguments:
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $cgi=new CGI;
print $cgi->header(-type=>'text/html',
-status=>'401 Authorization Required',
-authname=>'Tom');Form based table editing
#!c:/perl/bin
use Win32::OLE;
use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
$table = "employee";
$conn = Win32::OLE->new("ADODB.Connection");
$rs = Win32::OLE->new("ADODB.Recordset");
$conn->Open("contact");
print "Content-Type:text/html\n\n";
print "Contact Database<br>";
print "<table>";
print "<tr>";
print "<th>ID</th>";
print "<th>First Name</th>";
print "<th>Last Name</th>";
print "<th>Town</th>";
print "<th>Edit?</th>";
print "</tr>";
$sql = "SELECT * FROM $table";
$rs->Open($sql, $conn, 1, 1);
while(!$rs->EOF){
$id = $rs->Fields('id')->value;
$firstname = $rs->Fields('firstname')->value;
$lastname = $rs->Fields('lastname')->value;
$town = $rs->Fields('town')->value;
print "<tr><td>$id</td><td>$firstname</td><td>$lastname</td><td>$town</td>";
print "<form name=editrec" . $id . " method=post action=editcontact.pl>";
print "<input type=hidden name=id value=$id>";
print "<td><input type=Submit name=submit value=Edit></td>";
print "</form>";
print "</tr>";
$rs->MoveNext;
}
print "</table></div>";
$rs->Close;
$conn->Close;Form Input Types
#Input Type Attributes
#CHECKBOX NAME, VALUE
#FILE NAME
#HIDDEN NAME, VALUE
#IMAGE SRC, VALUE, ALIGN
#PASSWORD NAME, VALUE
#RADIO NAME, VALUE
#RESET NAME, VALUE
#SELECT NAME, OPTION SIZE, MULTIPLE
#SUBMIT NAME, VALUE
#TEXT NAME SIZE, MAXLENGTH
#TEXTAREA NAME, SIZE ROWS, COLS
<html><head>
<title>First CGI Form</title></head>
<body>
<form action="index.pl" >
Name:<input type="text" name="namestring">
Desc: <br>
<textarea name="comments"></textarea>
Food:
<input type="radio" name="choice" value="burger"/>Hamburger
<input type="radio" name="choice" value="fish"/>Fish
<input type="radio" name="choice" value="steak"/>Steak
<input type="radio" name="choice" value="yogurt"/>Yogurt
</p> <b>Choose a work place:</b> <br>
<input type="checkbox" name="place" value="la"/>Los Angeles
<input type="checkbox" name="place" value="sj"/>San Jose
<input type="checkbox" name="place" value="sf" checked/>San Francisco
<select name="location">
<option selected value="hawaii"/> Hawaii
<option value="bali"/>Bali
<option value="maine"/>Maine
<option value="paris"/>Paris
</select>
<p>
<input type="submit" value="submit">
<input type="reset" value="clear">
</body>
</form>
</html>
<html>
<head><title>First CGI Form</title></head>
<body>
<form action="form1.cgi" method=get>
Please enter your name: <br>
<input type="text" size=50 name="Name">
Please enter your phone number: <br>
<input type="text" size=30 name="Phone">
<input type=submit>
<input type=reset value="Clear">
</form>
</body>
#!c:/ActivePerl/bin/perl.exe
print "Content-type: text/html\n\n";
print "Processing CGI form :\n\n";
# Print out only the QUERY_STRING environment variable
while(($key, $value)=each(%ENV)){
print "<h3>$key = <em>$value</em></h3><br>"
if $key eq "QUERY_STRING";
}Form Mail
#!/usr/bin/perl
##############################################################################
# FormMail Version 1.5 #
# Copyright 1996 Matt Wright mattw@worldwidemart.com #
# Created 6/9/95 Last Modified 2/5/96 #
# Scripts Archive at: http://www.worldwidemart.com/scripts/ #
##############################################################################
# COPYRIGHT NOTICE #
# Copyright 1996 Matthew M. Wright All Rights Reserved. #
# #
# FormMail may be used and modified free of charge by anyone so long as this #
# copyright notice and the comments above remain intact. By using this #
# code you agree to indemnify Matthew M. Wright from any liability that #
# might arise from it's use. #
# #
# Selling the code for this program without prior written consent is #
# expressly forbidden. In other words, please ask first before you try and #
# make money off of my program. #
# #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium. In all cases copyright and header must remain intact #
##############################################################################
# Define Variables
# Detailed Information Found In README File.
# $mailprog defines the location of the sendmail program on your system.
$mailprog = 'c:/blat/blat.exe';
# @referers allows forms to be located only on servers which are defined
# in this field. This fixes a security hole in the last version which
# allowed anyone on any server to use your FormMail script.
#@referers = ('www.worldwidemart.com','worldwidemart.com','206.31.72.203');
@referers = ('macros','milamber');
# SERVER_OS defines the server Operating System if other that UNIX
$SERVER_OS="WIN";
# WIN_TEMPFILE is needed to store the mail as it's built.
# this is only required if SERVER_OS is set to "WIN"
$WIN_TEMPFILE="c:/website/cgi-temp/formmail.$$";
# Done
#############################################################################
# Check Referring URL
&check_url;
# Retrieve Date
&get_date;
# Parse Form Contents
&parse_form;
# Check Required Fields
&check_required;
# Return HTML Page or Redirect User
&return_html;
# Send E-Mail
&send_mail;
sub check_url {
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
$check_referer = '1';
last;
}
}
}
else {
$check_referer = '1';
}
if ($check_referer != 1) {
&error('bad_referer');
}
}
sub get_date {
@days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
@months = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
if ($hour < 10) { $hour = "0$hour"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }
$date = "$days[$wday], $months[$mon] $mday, 19$year at $hour\:$min\:$sec";
}
sub parse_form {
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
}
else {
&error('request_method');
}
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# arent a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
# Create two associative arrays here. One is a configuration array
# which includes all fields that this form recognizes. The other
# is for fields which the form does not recognize and will report
# back to the user in the html return page and the e-mail message.
# Also determine required fields.
if ($name eq 'recipient' ||
$name eq 'subject' ||
$name eq 'email' ||
$name eq 'realname' ||
$name eq 'redirect' ||
$name eq 'bgcolor' ||
$name eq 'background' ||
$name eq 'link_color' ||
$name eq 'vlink_color' ||
$name eq 'text_color' ||
$name eq 'alink_color' ||
$name eq 'title' ||
$name eq 'sort' ||
$name eq 'print_config' ||
$name eq 'return_link_title' ||
$name eq 'return_link_url' && ($value)) {
$CONFIG{$name} = $value;
}
elsif ($name eq 'required') {
@required = split(/,/,$value);
}
elsif ($name eq 'env_report') {
@env_report = split(/,/,$value);
}
else {
if ($FORM{$name} && ($value)) {
$FORM{$name} = "$FORM{$name}, $value";
}
elsif ($value) {
$FORM{$name} = $value;
}
}
}
}
sub check_required {
foreach $require (@required) {
if ($require eq 'recipient' ||
$require eq 'subject' ||
$require eq 'email' ||
$require eq 'realname' ||
$require eq 'redirect' ||
$require eq 'bgcolor' ||
$require eq 'background' ||
$require eq 'link_color' ||
$require eq 'vlink_color' ||
$require eq 'alink_color' ||
$require eq 'text_color' ||
$require eq 'sort' ||
$require eq 'title' ||
$require eq 'print_config' ||
$require eq 'return_link_title' ||
$require eq 'return_link_url') {
if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') {
push(@ERROR,$require);
}
}
elsif (!($FORM{$require}) || $FORM{$require} eq ' ') {
push(@ERROR,$require);
}
}
if (@ERROR) {
&error('missing_fields', @ERROR);
}
}
sub return_html {
if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) {
# If the redirect option of the form contains a valid url,
# print the redirectional location header.
print "Location: $CONFIG{'redirect'}\n\n";
}
else {
print "Content-type: text/html\n\n";
print "<html>\n <head>\n";
# Print out title of page
if ($CONFIG{'title'}) {
print " <title>$CONFIG{'title'}</title>\n";
}
else {
print " <title>Thank You</title>\n";
}
print " </head>\n <body";
# Get Body Tag Attributes
&body_attributes;
# Close Body Tag
print ">\n <center>\n";
if ($CONFIG{'title'}) {
print " <h1>$CONFIG{'title'}</h1>\n";
}
else {
print " <h1>Thank You For Filling Out This Form</h1>\n";
}
print "</center>\n";
print "Below is what you submitted to $CONFIG{'recipient'} on ";
print "$date<p><hr size=7 width=75\%><p>\n";
if ($CONFIG{'sort'} eq 'alphabetic') {
foreach $key (sort keys %FORM) {
# Print the name and value pairs in FORM array to html.
print "<b>$key:</b> $FORM{$key}<p>\n";
}
}
elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
$sort_order = $CONFIG{'sort'};
$sort_order =~ s/order://;
@sorted_fields = split(/,/, $sort_order);
foreach $sorted_field (@sorted_fields) {
# Print the name and value pairs in FORM array to html.
if ($FORM{$sorted_field}) {
print "<b>$sorted_field:</b> $FORM{$sorted_field}<p>\n";
}
}
}
else {
foreach $key (keys %FORM) {
# Print the name and value pairs in FORM array to html.
print "<b>$key:</b> $FORM{$key}<p>\n";
}
}
print "<p><hr size=7 width=75%><p>\n";
# Check for a Return Link
if ($CONFIG{'return_link_url'} =~ /http\:\/\/.*\..*/ && $CONFIG{'return_link_title'}) {
print "<ul>\n";
print "<li><a href=\"$CONFIG{'return_link_url'}\">$CONFIG{'return_link_title'}</a>\n";
print "</ul>\n";
}
print "<a href=\"http://www.worldwidemart.com/scripts/formmail.shtml\">FormMail</a> Created by Matt Wright and can be found at <a href=\"http://www.worldwidemart.com/scripts/\">Matt's Script Archive</a>.\n";
print "</body>\n</html>";
}
}
sub send_mail {
# Open The Mail Program
if ($SERVER_OS eq "WIN") {
open(MAIL,">$WIN_TEMPFILE");
local($BLAT_ARGS);
} else {
open(MAIL,"|$mailprog -t");
}
# Windows (blat) needs these on the command line, so we'll skip them here
if ($SERVER_OS ne "WIN") {
print MAIL "To: $CONFIG{'recipient'}\n";
print MAIL "From: $CONFIG{'email'} ($CONFIG{'realname'})\n";
}
# Check for Message Subject
if ($CONFIG{'subject'}) {
print MAIL "Subject: $CONFIG{'subject'}\n\n";
}
else {
print MAIL "Subject: WWW Form Submission\n\n";
}
print MAIL "Below is the result of your feedback form. It was ";
print MAIL "submitted by $CONFIG{'realname'} ($CONFIG{'email'}) on ";
print MAIL "$date\n";
print MAIL "---------------------------------------------------------------------------\n\n";
if ($CONFIG{'print_config'}) {
@print_config = split(/,/,$CONFIG{'print_config'});
foreach $print_config (@print_config) {
if ($CONFIG{$print_config}) {
print MAIL "$print_config: $CONFIG{$print_config}\n\n";
}
}
}
if ($CONFIG{'sort'} eq 'alphabetic') {
foreach $key (sort keys %FORM) {
# Print the name and value pairs in FORM array to mail.
print MAIL "$key: $FORM{$key}\n\n";
}
}
elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) {
$CONFIG{'sort'} =~ s/order://;
@sorted_fields = split(/,/, $CONFIG{'sort'});
foreach $sorted_field (@sorted_fields) {
# Print the name and value pairs in FORM array to mail.
if ($FORM{$sorted_field}) {
print MAIL "$sorted_field: $FORM{$sorted_field}\n\n";
}
}
}
else {
foreach $key (keys %FORM) {
# Print the name and value pairs in FORM array to html.
print MAIL "$key: $FORM{$key}\n\n";
}
}
print MAIL "---------------------------------------------------------------------------\n";
# Send Any Environment Variables To Recipient.
foreach $env_report (@env_report) {
print MAIL "$env_report: $ENV{$env_report}\n";
}
close (MAIL);
# If we're running under Windows, we actually send mail here...
if ($SERVER_OS eq "WIN") {
$WIN_TEMPFILE =~ s/\//\\/g;
$mailprog =~ s/\//\\/g;
$BLAT_ARGS = "$WIN_TEMPFILE -t $CONFIG{'recipient'} -penguin ";
$BLAT_ARGS .= "-f $CONFIG{'email'} " if defined($CONFIG{'email'});
$BLAT_ARGS .= "-q";
system "$mailprog $BLAT_ARGS";
unlink $WIN_TEMPFILE;
}
}
sub error {
($error,@error_fields) = @_;
print "Content-type: text/html\n\n";
if ($error eq 'bad_referer') {
print "<html>\n <head>\n <title>Bad Referrer - Access Denied</title>\n </head>\n";
print " <body>\n <center>\n <h1>Bad Referrer - Access Denied</h1>\n </center>\n";
print "The form that is trying to use this <a href=\"http://www.worldwidemart.com/scripts/\">FormMail Program</a>\n";
print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.<p>\n";
print "Sorry!\n";
print "</body></html>\n";
}
elsif ($error eq 'request_method') {
print "<html>\n <head>\n <title>Error: Request Method</title>\n </head>\n";
print "</head>\n <body";
# Get Body Tag Attributes
&body_attributes;
# Close Body Tag
print ">\n <center>\n\n";
print " <h1>Error: Request Method</h1>\n </center>\n\n";
print "The Request Method of the Form you submitted did not match\n";
print "either GET or POST. Please check the form, and make sure the\n";
print "method= statement is in upper case and matches GET or POST.\n";
print "<p><hr size=7 width=75%><p>\n";
print "<ul>\n";
print "<li><a href=\"$ENV{'HTTP_REFERER'}\">Back to the Submission Form</a>\n";
print "</ul>\n";
print "</body></html>\n";
}
elsif ($error eq 'missing_fields') {
print "<html>\n <head>\n <title>Error: Blank Fields</title>\n </head>\n";
print " </head>\n <body";
# Get Body Tag Attributes
&body_attributes;
# Close Body Tag
print ">\n <center>\n";
print " <h1>Error: Blank Fields</h1>\n\n";
print "The following fields were left blank in your submission form:<p>\n";
# Print Out Missing Fields in a List.
print "<ul>\n";
foreach $missing_field (@error_fields) {
print "<li>$missing_field\n";
}
print "</ul>\n";
# Provide Explanation for Error and Offer Link Back to Form.
print "<p><hr size=7 width=75\%><p>\n";
print "These fields must be filled out before you can successfully submit\n";
print "the form. Please return to the <a href=\"$ENV{'HTTP_REFERER'}\">Fill Out Form</a> and try again.\n";
print "</body></html>\n";
}
exit;
}
sub body_attributes {
# Check for Background Color
if ($CONFIG{'bgcolor'}) {
print " bgcolor=\"$CONFIG{'bgcolor'}\"";
}
# Check for Background Image
if ($CONFIG{'background'} =~ /http\:\/\/.*\..*/) {
print " background=\"$CONFIG{'background'}\"";
}
# Check for Link Color
if ($CONFIG{'link_color'}) {
print " link=\"$CONFIG{'link_color'}\"";
}
# Check for Visited Link Color
if ($CONFIG{'vlink_color'}) {
print " vlink=\"$CONFIG{'vlink_color'}\"";
}
# Check for Active Link Color
if ($CONFIG{'alink_color'}) {
print " alink=\"$CONFIG{'alink_color'}\"";
}
# Check for Body Text Color
if ($CONFIG{'text_color'}) {
print " text=\"$CONFIG{'text_color'}\"";
}
}Generate and Process Forms
#!/usr/bin/perl
use warnings;
use CGI::Pretty qw(:all);
use strict;
print header();
if (param('first') and param('last')) {
my $first=ucfirst(lc(param('first')));
my $last=ucfirst(lc(param('last')));
print start_html("Welcome"),h1("Hello, $first $last");
} else {
print start_html(title=>"Enter your name");
if (param('first') or param('last')) {
print center(font({color=>'red'},"You must enter a",(param('last')?"first":"last"),"name"));
}
print generate_form();
}
print end_html();
sub generate_form {
return start_form,
h1("Please enter your name:"),
p("Last name", textfield('last')),
p("First name", textfield('first')),
p(submit),
end_form;
}Generates HTML with the use of CGI.pm
#!/usr/bin/perl -w
use strict;
use CGI ':standard';
print header();
print start_html('Generating HTML');
print h1('Now Is:');
print p('The current date and time is:', scalar(localtime));
print hr();
print h1('This is heading 1');
my $file_listing = '';
$file_listing .= "<br />$_" foreach <*.pl>;
print p('This is a ', ' file list:', $file_listing);
print p('Check out the',a({ href => 'http://www.java2s.com/' }, 'www.java2s.com Home Page'));
print end_html();Generates HTML with the use of CGI.pm using the conventional style
#!/usr/bin/perl -w
use strict;
use CGI ':standard';
print
header(),
start_html('Generating HTML'),
h1('Now Is:'),
p('The current date and time is:', scalar(localtime)),
hr(),
h1('This is heading 1');
my $file_listing = '';
$file_listing .= "<br />$_" foreach <*.pl>;
print
p('This is a ','file list:', $file_listing),
h1('Go Here For Excellent Books!'),
p('Check out the',a({ href => 'http://www.java2s.com/' }, 'www.java2s.com Home Page')),
end_html();Generate the HTML form
#!/usr/bin/perl
use CGI::Pretty qw(:all);
use strict;
print header();
print generate_form();
print end_html();
sub generate_form {
return start_form,
h1("Please enter your name:"),
p("Last name", textfield('last')),
p("First name", textfield('first')),
p(submit),
end_form;
}Generating HTML
#!/usr/bin/perl
use strict;
use warnings;
print "Content-type: text/html\n\n";
print "<html><head><title>Environment Dumper </title></head><body>";
print "<center><table border=1>";
foreach (sort keys %ENV) {
print "<tr><td>$_</td><td>$ENV{$_}</td></tr>"
}
print "</table></center></body></html>";Generating HTML Programmatically
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $cgi=new CGI;
print $cgi->header(),$cgi->start_html("Simple Examples");
print $cgi->center("Centered Text");
print $cgi->p("A Paragraph");
print $cgi->br();
print $cgi->b("Bold"),$cgi->i("Italic");
print $cgi->p("A Paragraph",$cgi->sup("A superscript"));
print $cgi->end_html();Get and display the browser type by referencing HTTP_USER_AGENT
#!/usr/bin/perl -w
use strict;
print "Content-Type: text/plain\n";
print "\n";
print "your browser is: $ENV{HTTP_USER_AGENT}\n";Get form submitted value
#!c:/perl/bin
use CGI ':standard';
print header();
print "Form Elements", br(), br(), br();
print start_form;
print "A Text Box: ", textfield('surname', 'Default', 50), br();
print "A Select Box: ", popup_menu('SelectBox', ['Perl', 'Web', 'Development'], 'Fast');
print p, "Text Area: ", textarea('comments', 'Default Text', 10, 50);
print p, "CheckBoxes: ", checkbox_group('check1', ['one', 'two', 'three']);
print p, "Radio Buttons: ", radio_group('radio1', ['a', 'b', 'c']);
print p, submit();
print end_form;
if (param())
{
print "The surname you entered was: ",em(param('surname')),
p, "The Selections are: ",em(join(", ",param('SelectBox'))),
p, "The comments box contains: ",em(param('comments')),
p, "you selected checkbox: ",em(param('check1')),
p, "you selected radio: ",em(param('radio1'));
}Get form value with param
#!c:/ActivePerl/bin/perl.exe
use DBI;
use CGI qw(:standard);
print header, start_html(-title=>"Team Lookup",-BGCOLOR=>"#66ff33");
print start_form,"<font face='arial' size='+1'>Look up what name? ",textfield('name'),p;
print submit, end_form, hr;
if(param()) {
$team = param('name');
$dbh = DBI->connect("DBI:mysql:host=localhost;database=sample_db;user=root;password=") or print "Connection failed: ". $DBI::errstr;
$sth=$dbh->prepare("SELECT name, salary, age FROM teams where name = ?");
$sth->execute($team);
if ($sth->rows == 0){
print "Your team isn't in the table.<br>";
exit;
}
print h2("Data for \u$team");
while(($name,$salary,$age) = $sth->fetchrow_array()){
print <<EOF;
<table border="1">
<tr>
<th>Name</th>
<th>Salary</th>
<th>Age</th>
</tr>
<tr>
<td>$name</td>
<td>$salary</td>
<td>$age</td>
</tr>
</table>
EOF
print end_html();
$sth->finish();
$dbh->disconnect();
}
}Guest book form
<HTML>
<BODY>
<H1>Please add to my guest book...</H1>
<FORM METHOD = POST ACTION ="guestbook.cgi">
<BR>
Please enter your name:
<P>
<INPUT TYPE = "TEXT" NAME = "username">
</INPUT>
<BR>
Please enter your comments:
<P>
<TEXTAREA NAME = "comments"></TEXTAREA>
<BR>
<BR>
<INPUT TYPE = SUBMIT VALUE = "Send">
<INPUT TYPE = RESET VALUE = "Reset">
</FORM>
</BODY>
</HTML>
#File: guestbook.cgi
#!/usr/bin/perl
use CGI;
$co = new CGI;
open (BOOK, "+<book.htm") or die "Could not open guest book.";
seek (BOOK, -length($co->end_html), 2);
$date = `date`;
chop($date);
$username = $co->param('username');
$username =~ s/</</g;
$text = $co->param('comments');
$text =~ s/</</g;
print BOOK
$co->h3
(
"New comments by ", $username, " on ", $date,
$co->p,
$text,
),
$co->hr,
$co->end_html;
close BOOK;
print $co->header,
$co->start_html
(
-title=>'Guest Book Example',
-author=>'your name',
-BGCOLOR=>'white',
-LINK=>'red'
);
print
$co->center
(
$co->h1('Thanks for adding to the guest book!')
),
"If you want to take a look at the guest book, ",
$co->a
(
{href=>"http://www.yourserver.com/user/cgi/book.htm"},
"click here"
),
".",
$co->hr,
$co->end_html;Header, br, ol,li
#!c:/perl/bin
use CGI ':standard';
print header();
print "Here is some ",em("emphasised text "), b("and this is bold.");
print br(), i("This is italic text"), br(), br(), br();
print h3("Languages"),
ol(
li('C++'),
li('PHP'),
li('Perl')
);HEADER DESCRIPTION
HTTP_ACCEPT MIME types, for example,"image/gif, image/xxbitmap, image/jpeg, image/pjpeg,image/png, */*".
HTTP_ACCEPT_CHARSET Character sets, for example, "iso88591,*,utf8".
HTTP_ACCEPT_ENCODING Character coding types, for example, "gzip".
HTTP_ACCEPT_LANGUAGE The languages, for example, "en".
HTTP_AUTHORIZATION The authorization data of an HTTP authentication.
HTTP_CACHE_CONTROL Set if a request can be cached by the server.
HTTP_CONNECTION The connection type, for example, "Keep-alive".
HTTP_COOKIE The cookie or cookies transmitted by the client.
HTTP_HOST The name of the server requested by the client.
HTTP_REFERER The URL of the page from which this page was accessed.
HTTP_USER_AGENT The user agent, for example, "Mozilla/4.72 [en] (X11; I; Linux 2.2.9 i686)". Note that user agents often pretend to be other agents to work with web sites that treat particular agents differently.
HTTP_VIA Proxy cache or caches.
REQUEST_METHOD GET or POST.
PATH_INFO The relative path of the requested resource.
PATH_TRANSLATED The absolute path of the requested resource.
QUERY_STRING Additional supplied parameters.
SCRIPT_NAME The name the script was called with.
DOCUMENT_ROOT Root of the HTML document tree, for example, /home/sites/myserver.com/html/.
GATEWAY_INTERFACE The revision of the CGI specification, for example, CGI/1.1.
SERVER_NAME The server's hostname, for example, www.myserver.com.
SERVER_SOFTWARE The server software's name,for example, Apache/1.3.11 (Unix).
AUTH_TYPE The authorization type, for example, Basic, if authentication is being used.
CONTENT_LENGTH Length content sent by the client in bytes.
CONTENT_TYPE Type of the content sent by the client, for example, text/html.
PATH The search path for remotely executable programs.
PATH_INFO The extra path information given by the client.
PATH_TRANSLATED The value of PATH_INFO converted into a physical file location.
QUERY_STRING The information that follows the ? in a URL.
REMOTE_ADDR The IP address of the remote host.
REMOTE_HOST The hostname of the remote host. This may be the same as
REMOTE_ADDR If the server is not doing name lookups.
REMOTE_IDENT The remote user name retreived from the ident protocol. This is usually unset, as servers rarely perform this lookup.
REMOTE_PORT The port number of the network connection on the client side.
REMOTE_USER The user name that was authenticated by the server, if authentication is being used.
REQUEST_METHOD How the script was called (GET, PUT, POST...).
SCRIPT_NAME The virtual path to the script, for example, /perl/askname.plx.
SCRIPT_FILENAME The absolute path to the script, for example, /home/sites/myserver.com/scripts/askname.plx.
SERVER_ADMIN The email address of the web server administrator, for example, webmaster@myserver.com.
SERVER_PORT The port number to which the request was sent, for example, 80.
SERVER_PROTOCOL The name and revision of the protocol used to make the request, for example, HTTP/1.1.Hello World in Function-Oriented Fashion
#!/usr/bin/perl -T
use strict;
use CGI ':standard';
print header;
print start_html('Hello World');
print h1('Hello World');
print end_html();
exit;Hello World in Object-Oriented Fashion
#!/usr/bin/perl -T
use strict;
use CGI;
my $cgi = new CGI;
print $cgi->header;
print $cgi->start_html('Hello World');
print $cgi->h1('Hello World');
print $cgi->end_html();
exit;Image based counter
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
open (COUNT, "<count.dat")
or die "Could not open counter data file.";
$count = <COUNT>;
close COUNT;
$image = int($count / 10) % 10;
open (IMAGE, "<$image.gif");
$size = -s "$image.gif";
read IMAGE, $data, $size;
close IMAGE;
print
$co->header(-type=>'image/gif'),
$data;Learn about the current CGI request
#!/usr/bin/perl
print "Content-type: text/plain\n\n";
print "The command line arguments for this script are:\n";
print join(" ",@ARGV),"\n\n";
print "The request information available to the script includes:\n\n";
print "REQUEST_METHOD = ",$ENV{"REQUEST_METHOD"},"\n";
print "PATH_INFO = " ,$ENV{"PATH_INFO"},"\n";
print "PATH_TRANSLATED = " ,$ENV{"PATH_TRANSLATED"},"\n";
print "SCRIPT_NAME = " ,$ENV{"SCRIPT_NAME"},"\n";
print "QUERY_STRING = " ,$ENV{"QUERY_STRING"},"\n";
print "CONTENT_TYPE = ",$ENV{"CONTENT_TYPE"},"\n";
print "CONTENT_LENGTH = ",$ENV{"CONTENT_LENGTH"},"\n\n";
if($ENV{"REQUEST_METHOD"} eq "POST")
{
$contentLength = $ENV{"CONTENT_LENGTH"};
if($contentLength)
{
read(STDIN,$queryString,$contentLength);
}
else
{
$queryString = "";
}
print "Standard in is:\n";
print $queryString;
print "\n";
}
1;
#############################################
<HTML>
<HEAD>
<TITLE>Request Initiator</TITLE>
</HEAD>
<BODY>
<H1>GET Form</H1>
<FORM ACTION="index.pl" METHOD=GET>
<INPUT TYPE="TEXT" SIZE=60 NAME="DATA">
<INPUT TYPE="SUBMIT" NAME="SUBMIT" VALUE="SUBMIT">
</FORM>
<BR><BR>
<H1>POST Form</H1>
<FORM ACTION="PerlCGI/requestinfo.pl" METHOD=POST>
<INPUT TYPE="TEXT" SIZE=60 NAME="DATA">
<INPUT TYPE="SUBMIT" NAME="SUBMIT" VALUE="SUBMIT">
</FORM>
</BODY>
</HTML>Learn about the server for a CGI request
#!/usr/bin/perl
print "Content-type: text/plain\n\n";
print "The server information:\n\n";
print "SERVER_SOFTWARE = ",$ENV{"SERVER_SOFTWARE"},"\n";
print "SERVER_NAME = ",$ENV{"SERVER_NAME"},"\n";
print "GATEWAY_INTERFACE = ",$ENV{"GATEWAY_INTERFACE"},"\n";
print "SERVER_PROTOCOL = ",$ENV{"SERVER_PROTOCOL"},"\n";
print "SERVER_PORT = ",$ENV{"SERVER_PORT"},"\n";Logs visitors to web site
use strict;
use warnings;
use CGI qw( :standard );
use Fcntl qw( :flock );
my @vars = qw( REMOTE_ADDR REMOTE_PORT REQUEST_URI QUERY_STRING );
my @stuff = @ENV{ @vars };
my $info = join( " | ", @stuff );
open( FILE, "+>>log.txt" ) or die( "Could not open log.txt: $!" );
flock( FILE, LOCK_EX ) or die( "Could not get exclusive lock: $!" );
print( FILE "$info\n\n" );
flock( FILE, LOCK_UN ) or die( "Could not unlock file: $!" );
close( FILE );
if ( $stuff[3] ne "" ) {
print( header( -Refresh=> '5; URL=http://www.java2s.com' ) );
print( start_html( "log.txt" ) );
print( p( i( "You will now be redirected to our home page." ) ) );
}
else {
print( header() );
print( start_html( "log.txt" ) );
print( h1( "Please add a \"?\" and your name to the URL.\n" ) );
}
print( end_html() );Output a HTML table
#!/usr/bin/perl -w
use strict;
print "Content-Type: text/html\n";
print "\n";
print "<table border=\"1\">";
foreach (sort keys %ENV) {
print "<tr><th>$_</th><td>$ENV{$_}</td>";
}
print "</table>";Page counter
#!/usr/bin/perl
use CGI;
$co = new CGI;
open (COUNT, "<count.dat")
or die "Could not open counter data file.";
$count = <COUNT>;
close COUNT;
$count++;
open (COUNT, ">count.dat");
print COUNT $count;
close COUNT;
print
$co->header,
$co->start_html(
-title=>'Counter Example',
-author=>'your Name',
-BGCOLOR=>'white',
),
$co->center($co->h1('Counter Example')),
$co->p,
$co->center($co->h3("Current count: ", $count)),
$co->p,
$co->center($co->h3("Reload the page to update the count")),
$co->end_html;Passing parameter to perl CGI code
<html>
<head>
<title>A Simple Form</title>
</head>
<body>
<h1>Please Enter Your Name</h1>
<form action="http://localhost/cgi-bin/form.pl">
First name: <input type="text" name="firstname">
<br>
Last name: <input type="text" name="lastname">
<br>
<input type="submit">
</form>
</body>
</html>
#!/usr/bin/perl -w
use strict;
use CGI ':standard';
my @params = param();
my $firstname = param('firstname') || 'you have no first name!';
my $lastname = param('lastname') || 'you have no last name!';
print
header(),
start_html(
-title => 'Welcome!',
-text => '#520063'
),
h1("Hello, $firstname $lastname!"),
end_html();Pretty print HTML code
#!/usr/bin/perl
use warnings;
use strict;
use CGI::Pretty;
my $cgi=new CGI::Pretty;
print $cgi->header(),
$cgi->start_html("Environment Dumper"),
$cgi->table({-border=>1},
$cgi->Tr($cgi->th(["Parameter","Value"])),
map {
$cgi->Tr($cgi->td([$_,$ENV{$_}]))
} sort keys %ENV
),
$cgi->end_html();Printing the Content-Type of an Uploaded File
#!/usr/bin/perl
use strict;
use CGI qw/:standard/;
my $q = new CGI;
my $filename = $q->param('uploaded_file');
my $contenttype = $q->uploadInfo($filename)->{'Content-Type'};
print header;
print start_html;
print "Type is $contenttype<P>";
print end_html;Printing the Name Input Using the CGI Module
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
print header,
start_html('Hello'),
start_form,
"Enter your name: ",textfield('name'),
submit,
end_form,
hr;
if (param()) {
print "Hello ",
param('name'),
p;
}
print end_html;
exit;Process form with regular expression: date
<html>
<head>
<title>form page</title>
</head>
<body>
<p>here's my test form</p>
<form method = "post" action = "/your.pl">
<p>First name:
<input name = "firstName" type = "text" size = "20"></p>
<p>Last name:
<input name = "lastName" type = "text" size = "20"></p>
<p>Phone number:
<input name = "phone" type = "text" size = "20"></p>
<p>Date (MM/DD/YY):
<input name = "date" type = "text" size = "20"></p>
<p>Time (HH:MM:SS):
<input name = "time" type = "text" size = "20"></p>
<input type = "submit" value = "submit">
<input type = "reset" value = "reset">
</form>
</body>
</html>
#your.pl
#!/usr/bin/perl
use strict;
use warnings;
use CGI ':standard';
my $firstName = param( "firstName" );
my $lastName = param( "lastName" );
my $phone = param( "phone" );
my $date = param( "date" );
my $time = param( "time" );
print header();
print start_html( -title => "form page" );
if ( $date =~ m#^(1[012]|0?[1-9])/([012]?\d|3[01])/(\d\d)$# ) {
print "<p>The date is $1 / $2 / $3.</p>";
}
print end_html();Process form with regular expression: first name and last name
<html>
<head>
<title>form page</title>
</head>
<body>
<p>here's my test form</p>
<form method = "post" action = "/your.pl">
<p>First name:
<input name = "firstName" type = "text" size = "20"></p>
<p>Last name:
<input name = "lastName" type = "text" size = "20"></p>
<p>Phone number:
<input name = "phone" type = "text" size = "20"></p>
<p>Date (MM/DD/YY):
<input name = "date" type = "text" size = "20"></p>
<p>Time (HH:MM:SS):
<input name = "time" type = "text" size = "20"></p>
<input type = "submit" value = "submit">
<input type = "reset" value = "reset">
</form>
</body>
</html>
#your.pl
#!/usr/bin/perl
use strict;
use warnings;
use CGI ':standard';
my $firstName = param( "firstName" );
my $lastName = param( "lastName" );
my $phone = param( "phone" );
my $date = param( "date" );
my $time = param( "time" );
print header();
print start_html( -title => "form page" );
if ( $firstName =~ /^\w+$/ ) {
print "<p>Hello there \L\u$firstName.</p>";
}
if ( $lastName =~ /^\w+$/ ) {
print "<p>Hello there Mr./Ms. \L\u$lastName.</p>";
}
print end_html();Process form with regular expression: time
<html>
<head>
<title>form page</title>
</head>
<body>
<p>here's my test form</p>
<form method = "post" action = "your.pl">
<p>First name:
<input name = "firstName" type = "text" size = "20"></p>
<p>Last name:
<input name = "lastName" type = "text" size = "20"></p>
<p>Phone number:
<input name = "phone" type = "text" size = "20"></p>
<p>Date (MM/DD/YY):
<input name = "date" type = "text" size = "20"></p>
<p>Time (HH:MM:SS):
<input name = "time" type = "text" size = "20"></p>
<input type = "submit" value = "submit">
<input type = "reset" value = "reset">
</form>
</body>
</html>
#your.pl
#!/usr/bin/perl
use strict;
use warnings;
use CGI ':standard';
my $firstName = param( "firstName" );
my $lastName = param( "lastName" );
my $phone = param( "phone" );
my $date = param( "date" );
my $time = param( "time" );
print header();
print start_html( -title => "form page" );
if ( $time =~ m#^(1[012]|[1-9]):([0-5]\d):([0-5]\d)$# ) {
print "<p>The time is $1 : $2 : $3.</p>";
}
print end_html();Producing Human-Readable HTML
#!/usr/bin/perl
use warnings;
use strict;
use CGI::Pretty qw(:standard);
my $cgi=new CGI::Pretty;
print header,
start_html("Pretty HTML Demo"),
ol(li(["First","Second","Third"])),
end_html;Program to display CGI environment variables.
use warnings;
use strict;
use CGI qw( :standard );
print header(), start_html( "Environment Variables" );
print '<table>';
foreach my $variable ( sort( keys %ENV ) ) {
print Tr( td( b( "$variable:" ) ),
td( i( $ENV{ $variable } ) ) );
}
print '</table>', end_html();Program to read cookies from the client's computer
#!perl
use CGI qw( :standard );
print header, start_html( "Read cookies" );
print "<STRONG>The folowing data is saved in a cookie on your ";
print "computer.<STRONG><BR><BR>";
%cookies = readCookies();
print "<TABLE>";
foreach $cookieName ( "Name", "Height", "Color" )
{
print "<TR>";
print " <TD>$cookieName</TD>";
print " <TD>$cookies{ $cookieName }</TD>";
print "</TR>";
}
print "</TABLE>";
print end_html;
sub readCookies
{
@cookieArray = split( "; ", $ENV{ 'HTTP_COOKIE' } );
foreach ( @cookieArray )
{
( $cookieName, $cookieValue ) = split ( "=", $_ );
$cookieHash{ $cookieName } = $cookieValue;
}
return %cookieHash;
}Querying all the parameters
#!/usr/bin/perl -w
use CGI;
$cgi = CGI->new();
print $cgi->header();
print $cgi->start_html(-title=>'8-Ball',-BGCOLOR=>'white');
print "<h1>Your Answer</h1>\n";
#print "Your query was: @ARGV<p>\n";
print "The data you passed was:<p>\n";
@param_names = $cgi->param();
foreach $p (@param_names) {
$value = $cgi->param($p);
print "Param $p = $value<p>\n";
}
print "Sorry, ask again later.<p>\n";
print $cgi->end_html();
<html>
<head>
<title>Command-Line CGI</title>
</head>
<body>
Ask the
<A HREF="/cgi-bin/cmdline.cgi?name1=value1&name2=value2">
param</A>
</body>
</html>Read cookie value
#!c:/perl/bin
use CGI;
$q1 = new CGI;
print $q1->header;
$cookie1 = $q1->cookie('FIRST_NAME');
if($cookie1)
{
print $cookie1;
}
else
{
print "No such Cookie!";
}Reading text in textarea
<html>
<head>
<title>TEXTAREA</title>
</head>
<body>
<FORM METHOD="POST" ACTION="/cgi-bin/textarea.cgi">
Suggestion:
<p>
<TEXTAREA NAME="suggestion" ROWS=6 COLS=60>
Default data goes here.
</TEXTAREA>
<p>
<INPUT TYPE="submit" VALUE="Submit">
<INPUT TYPE="reset" VALUE="Reset Form">
</FORM>
</body>
</html>
#!/usr/bin/perl -w
use CGI;
$form = CGI->new();
@suggest = $form->param('suggestion');
print $form->header();
print $form->start_html(-title=>'Thanks',-BGCOLOR=>'white');
print "<h1>Thanks For Your Suggestion</h1>\n";
print "<hr>";
print "@suggest\n";
print "<p>\n";
print "<hr>";
print "Thank you!";
print "<p>\n";
print $form->end_html();Read the data for a CGI GET request
<HTML>
<HEAD>
<TITLE>CGI Form</TITLE>
</HEAD>
<BODY>
<FORM METHOD="GET" ACTION="index.pl">
<P>Name: <INPUT TYPE = "text" NAME = "name" VALUE = "" ></P>
<P>Address: <INPUT TYPE = "text" NAME = "street" VALUE = "" ></P>
City: <INPUT TYPE = "text" NAME = "city" VALUE = "" >
State: <INPUT TYPE = "text" NAME = "state" VALUE = "" >
Zip: <INPUT TYPE = "text" NAME = "zip" VALUE = "" >
<P>Overall rating:</P>
Needs Improvement: <INPUT TYPE = "radio" NAME = "rating" VALUE = "NI">
Average: <INPUT TYPE = "radio" NAME = "rating" VALUE = "AV">
Above Average: <INPUT TYPE = "radio" NAME = "rating" VALUE = "AA">
Excellent: <INPUT TYPE = "radio" NAME = "rating" VALUE = "EX">
<BR>
<P>Comments:</P>
<P><TEXTAREA NAME = "comments"></TEXTAREA></P>
<INPUT TYPE = "reset" name="reset" value = "Reset the Form">
<INPUT type = "submit" name="submit" value = "Submit Comment">
</FORM></H4>
</BODY>
</HTML>
############################################################
$requestType = $ENV{"REQUEST_METHOD"};
print "Content-type: text/plain\n\n";
if($requestType eq "GET")
{
&readGetData(*data);
# Print the data that we read
print "The GET data is:\n\n";
print $data;
print "\n";
}
sub readGetData
{
local(*queryString) = @_ if @_;
$queryString = $ENV{"QUERY_STRING"};
return 1;
}Read the data passed to a script on the command line?
<HTML>
<HEAD>
<TITLE>CGI How-to, ReadC_pl Test Form</TITLE>
</HEAD>
<BODY>
<A HREF="index.pl?test+query+string">Press here to try the test command line string.</A>
</BODY>
</HTML>
File: index.pl
#!/usr/local/bin/perl
sub readCommandLineData
{
local(*queryString) = @_ if @_;
$queryString = join(" ",@ARGV);
return 1;
}
print "Content-type: text/plain\n\n";
&readCommandLineData(*data);
print "The command line data is:\n\n";
print $data;
print "\n";Redirect a web page
use strict;
use warnings;
use CGI qw( :standard );
use Fcntl qw( :flock );
my @vars = qw( REMOTE_ADDR REMOTE_PORT REQUEST_URI QUERY_STRING );
my @stuff = @ENV{ @vars };
my $info = join( " | ", @stuff );
open( FILE, "+>>log.txt" ) or die( "Could not open log.txt: $!" );
flock( FILE, LOCK_EX ) or die( "Could not get exclusive lock: $!" );
print( FILE "$info\n\n" );
flock( FILE, LOCK_UN ) or die( "Could not unlock file: $!" );
close( FILE );
if ( $stuff[3] ne "" ) {
print( header( -Refresh=> '5; URL=http://www.java2s.com' ) );
print( start_html( "log.txt" ) );
print( p( i( "You will now be redirected to our home page." ) ) );
}
else {
print( header() );
print( start_html( "log.txt" ) );
print( h1( "Please add a \"?\" and your name to the URL.\n" ) );
}
print( end_html() );Redirect page
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->redirect('http://www.java2s.com');
print $co->start_html,
$co->end_html;Retrieving Cookies
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
my $retrievedcookie = cookie('testcookie');
print header,
start_html,
p("cookie value was $retrievedcookie\n"),
end_html;
exit;Retrieving Multiple Cookies
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
my $retrievedcookie1 = cookie('testcookie');
my $retrievedcookie2 = cookie('secondcookie');
print header,
start_html,
p("values were $retrievedcookie1 and $retrievedcookie2\n"),
end_html;
exit;Sample Database Query
<HTML>
<HEAD>
<TITLE>Sample Database Query</TITLE>
</HEAD>
<BODY>
<STRONG>Querying an ODBC database.</STRONG>
<FORM METHOD = "POST" ACTION = "index.pl">
<INPUT TYPE = "TEXT" NAME = "QUERY" SIZE = 40 VALUE = "SELECT * FROM Authors"><BR><BR>
<INPUT TYPE = "SUBMIT" VALUE = "Send Query">
</FORM>
</BODY>
</HTML>
#!perl
use Win32::ODBC;
use CGI qw( :standard );
$queryString = param( "QUERY" );
$dataSourceName = "Products";
print header, start_html( "Search Results" );
if ( !( $data = new Win32::ODBC( $dataSourceName ) ) )
{
print "Error connecting to $dataSourceName: ";
print Win32::ODBC::Error();
exit;
}
if ( $data->Sql( $queryString ) )
{
print "SQL failed. Error: ", $data->Error();
$data->Close();
exit;
}
print "Search Results";
print "<TABLE>";
for ( $counter = 0; $data->FetchRow(); $counter++ )
{
%rowHash = $data->DataHash();
print <<End_Row;
<TR>
<TD>$rowHash{'ID'}</TD>
<TD>$rowHash{'FirstName'}</TD>
<TD>$rowHash{'LastName'}</TD>
<TD>$rowHash{'Phone'}</TD>
</TR>
End_Row
}
print <<End_Results;
</TABLE>
<BR>Your search yielded <B>$counter</B> results.<BR><BR>
<FONT SIZE = 2>
Please email comments to
<A href = "mailto:d\@d.com">Associates, Inc.</A>.
End_Results
print end_html;
$data->Close();Send image to client
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
open (IMAGE, "<image.gif");
$size = -s "image.gif";
read IMAGE, $data, $size;
close IMAGE;
print
$co->header(-type=>'image/gif'),
$data;Sending Multiple Cookies Using CGI.pm
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
my $cookie1 = cookie(-name=>'testcookie',value=>'testcookievalue',expires=>'+7d');
my $cookie2 = cookie(-name=>'secondcookie',value=>'secondcookievalue',expires=>'+1d');
print header (-cookie=>[$cookie1,$cookie2]),start_html('CGI Cookie Test'),p("You've received a cookie\n"),
end_html;
exit;Separate the form and perl script
#!c:/perl/bin
use CGI;
$q1 = new CGI;
print $q1->header;
$firstname = $q1->param('firstname');
$email = $q1->param('email');
print "<H3>Sessions - Preserving State</H3>";
print "<br><br>";
print "<H3>Page 3</H3>";
print "Hello $firstname <br><br>";
print "Your email address is: $email <br><br>";
print "<form name=myform3 method=post action=index.pl>";
print "<input type=hidden name=firstname value=$firstname>";
print "<input type=hidden name=email value=$email>";
print "Enter your post code: <input type=text name=postcode>";
print "<input type=submit name=submit value='Go to page 4!'>";
print "</form>";
############################
#!c:/perl/bin
use CGI;
$q1 = new CGI;
print $q1->header;
$firstname = $q1->param('firstname');
$email = $q1->param('email');
$postcode = $q1->param('postcode');
print "<H3>Sessions - Preserving State</H3>";
print "<br><br>";
print "<H3>Page 4</H3>";
print "Hello $firstname <br><br>";
print "Your email address is: $email <br><br>";
print "Your Postcode is: $postcode <br><br>";
print "Hi";Server Environment Values
#!/usr/bin/perl
print "Content-type: text/html\n\n";
print "<H2>Server Environment Values</H2>";
foreach $env_var (keys %ENV)
{
print "$env_var = $ENV{$env_var} <BR>";
}Server push
#!/usr/bin/perl
use CGI::Push;
$co = new CGI::Push;
$co->do_push(-next_page=>\&page);
sub page
{
my($obj, $counter) = @_;
return undef if $counter > 50;
return
$co->start_html,
$co->br,
$co->center($co->h1('Server Push Example')),
$co->br,
$co->center($co->h1('Counter: ', $counter)),
$co->end_html;
}Sessions - Preserving State
<html>
<head>
<title>Hidden Fields</title>
</head>
<body>
<H3>Sessions - Preserving State</H3>
<br><br>
<H3>Page 1</H3>
<form name="myform1" method="post" action="index.pl">
Enter your First Name: <input type="text" name="firstname">
<input type="submit" name="submit" value="Go to Page 2!">
</form>
</body>
</html>
File: index.pl
#!c:/perl/bin
use CGI;
$q1 = new CGI;
print $q1->header;
$firstname = $q1->param('firstname');
print "<H3>Sessions - Preserving State</H3>";
print "<br><br>";
print "<H3>Page 2</H3>";
print "Hello $firstname <br><br>";
print "<form name=myform2 method=post action=index.pl>";
print "<input type=hidden name=firstname value=$firstname>";
print "Enter your e-mail address: <input type=text name=email>";
print "<input type=submit name=submit value='Go to page 3!'>";
print "</form>";Session tracking in our CGI scripts
#!/usr/bin/perl
use warnings;
use CGI;
use strict;
my $cgi=new CGI;
my $cookie=$cgi->cookie("myCookie");
if ($cookie) {
print $cgi->header(); #no need to send cookie again
} else {
my $value=generate_unique_id();
$cookie=$cgi->cookie(-name=>"myCookie",
-value=>$value,
-expires=>"+1d"); #or whatever we choose
print $cgi->header(-type=>"text/html",-cookie=>$cookie);
}
sub generate_unique_id {
#generate a random 8 digit hexadecimal session id
return sprintf("%08.8x",rand()*0xffffffff);
}Set content type
#!/usr/bin/perl -w
use strict;
print "Content-Type: text/plain\n";
print "\n";
print "hello, world!\n";Set html header content type
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
open (COUNT, "<count.dat")
or die "Could not open counter data file.";
$count = <COUNT>;
close COUNT;
$image = $count % 10;
open (IMAGE, "<$image.gif");
$size = -s "$image.gif";
read IMAGE, $data, $size;
close IMAGE;
print
$co->header(-type=>'image/gif'),
$data;Set HTML page title, author name, meta info, background color and link color
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html
(
-title=>'CGI Example',
-author=>'your Name',
-meta=>{'keywords'=>'CGI Perl'},
-BGCOLOR=>'white',
-LINK=>'red'
)Set Textarea row and column size by using Perl CGI code
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html(-title=>'CGI Example'),
$co->center($co->h1('Welcome to CGI!')),
$co->start_form(),
$co->textarea
(
-name=>'textarea',
-rows=>10,
-columns=>60
),
$co->end_form(),
$co->end_html;Setting Cookie Expiration Using the CGI Module
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
my $cookie = cookie(-name=>'testcookie',value=>'testcookievalue',-expires=>'+7d');
print header (-cookie=>$cookie),
start_html('CGI Cookie Test'),
p("You've received a cookie\n"),
end_html;
exit;Setting Cookie Expiration Without Using the CGI Module
#!/usr/bin/perl -T
use strict;
my @monthnames = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my @weekdays = qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
my $nextweek = time+604800;
my ($sec,$min,$hour,$mday,$mon,$year,$dayname,$dayofyear) = gmtime($nextweek);
$year += 1900;
print "Content-type: text/html\n";
print "Set-Cookie: testcookie=testcookievalue;";
printf ("expires=%s, %02d-%s-%d %02d:%02d:%02d GMT",$weekdays[$dayname],$mday,$monthnames[$mon],$year,$hour,$min,$sec);
print "\n\n";
print "You've received a cookie<p>\n";
exit;The POST Method
<HTML>
<HEAD>
<TITLE>CGI Form</TITLE>
<HR>
<FORM ACTION="index.pl" METHOD=POST>Name: <BR>
<INPUT TYPE="text" SIZE=50 NAME=Name>Please enter your salary ($####.##): <BR>
<INPUT TYPE="text" SIZE=30 NAME=Salary><P>Please enter your birth date (mm/dd/yy): <BR>
<INPUT TYPE="text" SIZE=30 NAME=Birthdate><P>
<INPUT TYPE=SUBMIT VALUE="Submit Query">
<INPUT TYPE=RESET VALUE="Reset">
</FORM>
</HTML>
File: index.pl
#!c:/perl/bin/perl
print "Content-type: text/html\n\n";
print <<HTML;
<html><title>Decoding the Input Data</title>
<body>
HTML
print "Decoding the query string";
Getting the input
$inputstring=$ENV{QUERY_STRING}};
print "<B>Before decoding:</B>";
print "<P>$inputstring";
@key_value=split(/&/,$inputstring);
foreach $pair ( @key_value){
($key, $value) = split(/=/, $pair);
$value=~s/%(..)/pack("C", hex($1))/ge;
$value =~ s/\n/ /g;
$value =~ s/\r//g;
$value =~ s/\cM//g;
$input{$key}=$value ; # Creating a hash
}
print "<P><B>After decoding:</B><P>";
while(($key, $value)=each(%input)){
print "$key: <I>$value</I><BR>";
}
print <<HTML;
</body>
</html>
HTMLTime Period Abbreviations for the CGI Module's Header and Cookie Functions
Abbreviation Definition Example
d Days +1d (expire 1 day from now)
h Hours +8h (expire 8 hours from now)
M Months +1M (expire 1 month from now)
m Minutes -1m (expire immediately)
now Immediately now (expire immediately)
s Seconds +30s (expire 30 seconds from now)
y Years +1y (expire 1 year from now)Track the number of times a web page has been accessed
#!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;
print "<CENTER>";
print "<STRONG>You are visitor number</STRONG><BR>";
for ( $count = 0; $count < length( $data ); $count++ )
{
$number = substr( $data, $count, 1 );
print "<IMG SRC = \"images/counter/$number.jpg\">";
}
print "</CENTER>";URL Hex-Encoded Characters
Character Value
Tab %09
Space %20
! %21
" %22
# %23
$ %24
% %25
& %26
( %28
) %29
, %2C
. %2E
/ %2F
: %3A
; %3B
< %3C
= %3D
> %3E
? %3F
@ %40
[ %5B
\ %5C
] %5D
^ %5E
' %60
{ %7B
| %7C
} %7D
~ %7EUsing CGI function to check the parameter
#!/usr/local/bin/perl
use CGI qw/:standard/;
print header,
start_html('CGI Functions Example'),
h1('CGI Functions Example'),
start_form,
"Please enter your name: ",
textfield('text'),
p,
submit, reset,
end_form,
hr;
if (param()) {
print "Your name is: ", em(param('text')), hr;
}
print end_html;Using LI
<html>
<body>
<FORM METHOD="POST" ACTION="index.cgi">
<INPUT NAME="web" TYPE="checkbox" VALUE="yes">web<br>
<INPUT NAME="gui" TYPE="checkbox" VALUE="yes">Option 1
<INPUT NAME="oop" TYPE="checkbox" VALUE="yes">oop<br>
<INPUT NAME="mod" TYPE="checkbox" VALUE="yes">mod<p>
Project name: <INPUT NAME="projectname">
<p>
<INPUT TYPE="submit" VALUE="Request Software">
</FORM>
</body>
</html>
#!/usr/bin/perl -w
use CGI;
$form = CGI->new();
$web = $form->param('web');
$gui = $form->param('gui');
$oop = $form->param('oop');
$mod = $form->param('mod');
$proj = $form->param('projectname');
# Print form header.
print $form->header();
print $form->start_html(title=>'This is the title', -BGCOLOR=>'white');
print "<UL>\n";
if ($web eq "yes") {
print "<LI>web.<p>\n";
}
if ($gui eq "yes") {
print "<LI>GUI<p>\n";
}
if ($oop eq "yes") {
print "<LI>oop<p>\n";
}
if ($mod eq "yes") {
print "<LI>mod<p>\n";
}
print "</UL>\n";
print "Estimated completion time for $proj: 5 March, 2025.";
print "<p>\n"; # Paragraph
# End HTML form.
print $form->end_html();Using param() function to get parameter
#!/usr/bin/perl -w
use strict;
use CGI ':standard';
if (param()) {
my @params = param();
my $firstname = param('firstname') || 'you have no first name!';
my $lastname = param('lastname') || 'you have no last name!';
print
header(),
start_html(
-title => 'Welcome!',
-text => '#520063'
),
h1("Hello, $firstname $lastname!"),
end_html();
} else {
print
header(),
start_html('A Simple Form'),
h1('Please Enter Your Name'),
start_form(),
'First name: ',
textfield(-name => 'firstname'),
br(),
'Last name: ',
textfield(-name => 'lastname'),
br(),
submit(),
end_form(),
end_html();
}Using Perl CGI code to set value to Textarea
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html(-title=>'CGI Example'),
$co->center($co->h1('Welcome to CGI!')),
$co->start_form(),
$co->textarea
(
-name=>'textarea',
-value=>'Hello!',
-rows=>10,
-columns=>60
),
$co->end_form(),
$co->p({-align=>center}, 'Welcome to CGI!'),
$co->end_html;Using Perl code align Paragraph tag
#!/usr/local/bin/perl
use CGI;
$co = new CGI;
print $co->header,
$co->start_html(-title=>'CGI Example'),
$co->center($co->h1('Welcome to CGI!')),
$co->start_form(),
$co->textarea
(
-name=>'textarea',
-rows=>10,
-columns=>60
),
$co->end_form(),
$co->p({-align=>center}, 'Welcome to CGI!'),
$co->end_html;Using set_message with CGI::Carp
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser set_message);
set_message("This is a better message for the end.");
print header,
start_html("Testing CGI Carp");
die ("This is a test die");
print end_html;
exit;Using the option select box
<HTML>
<body>
<FORM METHOD="POST" ACTION="index.cgi">
<H2>Option</H2>
<p>
<SELECT NAME="pro" SIZE=4>
<OPTION>Pro1
<OPTION>Pro2
<OPTION>Pro3
<OPTION>Pro4
</SELECT>
<p>
Option:
<SELECT NAME="wing" SIZE=1>
<OPTION>wing1
<OPTION>wing2
</SELECT>
<p>
<INPUT TYPE="submit" VALUE="Specify Candidate">
<p>
</FORM>
</body>
</html>
#!/usr/bin/perl -w
use CGI;
$form = new CGI;
$favor = $form->param('pro');
$wing = $form->param('wing');
print $form->header();
print $form->start_html(-title=>'Political Candidate',-BGCOLOR=>'white');
print "<h1>Option</h1>\n";
if ($favor eq "") {
print "Is in favor of: nothing<p>\n";
} else {
print "Is: $favor<p>\n";
}
print "and leans to the $wing views.<p>\n";
print $form->end_html();Using uri_unescape to Make a String Without Escape Characters
#!/usr/bin/perl -T
use strict;
use URI::Escape;
use CGI qw/:standard/;
my $unsafestring = "\$5/[3454]/this is a windows filename.asp";
my $safestring = uri_escape($unsafestring);
my $unescstring = uri_unescape($safestring);
print header,
start_html("start"),
p("unsafe URL: $unsafestring\n"),
p("url_escape(): $safestring\n"),
p("$unescstring: $unescstring\n"),
end_html;
exit;Values Carried Between Pages
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
print header;
if (param('color')) {
print start_html('Hello'),
"Hello ", param('name'),p,
"Your favorite color is: ",param('color'),p,
hr;
}
elsif (param('name')) {
print start_html('Hello'),
"Hello ",
param('name'),
p,
start_form,
"Please enter your favorite color: ",textfield('color'),
hidden(-name=>'name',-value=>param('name')),
submit,
end_form,
hr;
} else {
print start_html('Hello'),
start_form,
"Enter your name: ",textfield('name'),
submit,
end_form,
hr;
}
print end_html;
exit;Verifying a username and a password
<HTML>
<HEAD>
<TITLE>Verifying a username and a password.</TITLE>
</HEAD>
<BODY>
Type in your username and password below.
<FORM ACTION = "index.pl" METHOD = "POST">
Username:<INPUT SIZE = "40" NAME = "USERNAME">
Password:<INPUT SIZE = "40" NAME = "PASSWORD" TYPE = PASSWORD>
<INPUT TYPE = "SUBMIT" VALUE = "Enter">
</FORM>
</BODY>
</HTML>
#!perl
use CGI qw(:standard);
$testUsername = param( "USERNAME" );
$testPassword = param( "PASSWORD" );
open ( FILE, "password.txt" ) || 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;
if ( $userVerified && $passwordVerified )
{
accessGranted();
}
elsif ( $userVerified && !$passwordVerified )
{
wrongPassword();
}
else
{
accessDenied();
}
sub accessGranted
{
print "<TITLE>Thank You</TITLE>";
print "Permission has been granted, $username.";
print "<BR>Enjoy the site.";
}
sub wrongPassword
{
print "<TITLE>Access Denied</TITLE>";
print "You entered an invalid password.<BR>";
print "Access has been denied.";
}
sub accessDenied
{
print "<TITLE>Access Denied</TITLE>";
print "You were denied access to this server.";
}
#File: password.txt
#account1,password1
#account2,password2
#account3,password3Viewing Environment Variables in a CGI Script
#!/usr/bin/perl -T
use strict;
use CGI qw/:standard/;
print header,
start_html('Environment Variables');
foreach my $variable (keys %ENV) {
print p("$variable is $ENV{$variable}");
}
print end_html;
exit;Write CGI scripts with CGI.pm
#!/usr/bin/perl
use warnings;
use CGI::Pretty qw(:all);
use strict;
my $cgi=new CGI;
print header();
if ($cgi->param('first') and $cgi->param('last')) {
my $first=ucfirst(lc($cgi->param('first')));
my $last=ucfirst(lc($cgi->param('last')));
print start_html("Welcome"),h1("Hello, $first $last");
} else {
print start_html(-title=>"Name");
if ($cgi->param('first') or $cgi->param('last')) {
print center(font({-color=>'red'},"You must enter a",($cgi->param('last')?"first":"last"),"name"));
}
print generate_form();
}
print end_html();
sub generate_form {
return start_form,
h1("Please enter your name:"),
p("First name", textfield('first')),
p("Last name", textfield('last')),
p(submit),
end_form;
}Writing a cookie to the client computer
<HTML>
<HEAD>
<TITLE>Writing a cookie to the client computer</TITLE>
</HEAD>
<BODY>
Click Write Cookie to save your cookie data.
<FORM METHOD = "POST" ACTION = "index.pl">
<STRONG>Name:</STRONG><BR>
<INPUT TYPE = "TEXT" NAME = "NAME"><BR>
<STRONG>Height:</STRONG><BR>
<INPUT TYPE = "TEXT" NAME = "HEIGHT"><BR>
<STRONG>Favorite Color</STRONG><BR>
<INPUT TYPE = "TEXT" NAME = "COLOR"><BR>
<INPUT TYPE = "SUBMIT" VALUE = "Write Cookie">
</FORM>
</BODY>
</HTML>
#!perl
use CGI qw( :standard );
$name = param( NAME );
$height = param( HEIGHT );
$color = param( COLOR );
$expires = "Monday, 11-JUN-10 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";
print header, start_html( "Cookie Saved" );
print <<End_Data;
The cookie has been set with the folowing data:<BR><BR>
<FONT>Name:</FONT> $name <BR>
<FONT>Height:</FONT> $height<BR>
<FONT>Favorite Color:</FONT>
<FONT COLOR = $color> $color<BR></FONT>
<BR>Click <A HREF = "read_cookies.pl">here</A>
to read saved cookie.
End_Data
print end_html;
