The Labs.Com Issue_02_CGI

TPJ: Issue_02_CGI

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

Download listing

#!/usr/local/bin/perl

# Example for PerlJournal column #2.

# Collect the user's responses in a file and

# echo them back to him when requested.

# CONSTANTS

$STATE_DIR = "./STATES";  # must be writable by 'nobody'

use CGI;

$q = new CGI;

$session_key = $q->path_info();

$session_key =~ s|^/||;                # get rid of the initial slash

# If no valid session key has been provided, then we

# generate one, tack it on to the end of our URL as

# additional path information, and redirect the user

# to this new location.

unless (&valid($session_key)) {

$session_key = &generate_session_key($q);

print $q->redirect($q->url() . "/$session_key");

exit 0;

}

$old_state = &fetch_old_state($session_key);

# Add the new item(s) to the old list of items

if ($q->param('action') eq 'ADD') {

@new_items = $q->param('item');

@old_items = $old_state->param('item');

$old_state->param('item',@old_items,@new_items);

} elsif ($q->param('action') eq 'CLEAR') {

$old_state->delete('item');

}

# Save the new list to disk

&save_state($old_state,$session_key);

# Now, at last, generate something for the use to look at.

print $q->header;

print $q->start_html("The growing list");

print <<END;

<h1>The Growing List</h1>

Type a short phrase into the text field below.  When you press <\

;i>ADD</i>,

it will be added to a history of the phrases that you've typed.  T\

he

list is maintained on disk at the server end, so it won't get out of

order if you press the "back" button.  Press <i>CLEAR</i&\

gt; to clear the

list and start fresh.

END

;

print $q->start_form;

print $q->textfield(-name=>'item',-default=>'',-size=>50,-\

override=>1),"<p>";

print $q->submit(-name=>'action',-value=>'CLEAR');

print $q->submit(-name=>'action',-value=>'ADD');

print $q->end_form;

print "<hr><h2>Current list</h2>";

if ($old_state->param('item')) {

print "<ol>";

foreach $item ($old_state->param('item')) {

print "<li>",$q->escapeHTML($item);

}

print "</ol>";

} else {

print "<i>Empty</i>";

}

print <<END;

<hr>

<address>Lincoln D. Stein, lstein\@genome.wi.mit.edu<br&g\

t;

<a href="/">Whitehead Institute/MIT Center for Genome Resear\

ch</a></address>

END

print $q->end_html;

# Silly technique: we generate a session key from the remote IP

# address plus our PID.  More sophisticated scripts should use a

# better technique.

sub generate_session_key {

my $q = shift;

my($remote) = $q->remote_addr;

return "$remote.$$";

}

# make sure the session ID passed to us is a valid one by

# looking for pattern ##.##.##.##.##

sub valid {

my $key = shift;

return $key=~/^\d+\.\d+\.\d+\.\d+.\d+$/;

}

# Open the existing file, if any, and read the current state from it.

# We use the CGI object here, because it's straightforward to do.

# We don't check for success of the open() call, because if there is

# no file yet, the new CGI(FILEHANDLE) call will return an empty

# parameter list, which is exactly what we want.

sub fetch_old_state {

my $session_key = shift;

open(SAVEDSTATE,"$STATE_DIR/$session_key");

my $state = new CGI(SAVEDSTATE);

close SAVEDSTATE;

return $state;

}

sub save_state {

my($state,$session_key) = @_;

open(SAVEDSTATE,">$STATE_DIR/$session_key") ||

die "Failed opening session state file: $!";

$state->save(SAVEDSTATE);

close SAVEDSTATE;

}

Issue_02_CGI 2. More Samples on CGI

• Issue_01_CGI
• Issue_02_CGI
• Issue_03_CGI
• Issue_04_CGI
• Issue_05_CGI
• Issue_06_CGI
• Issue_08_CGI
• Issue_10_CGI