Orders Orders Backward Forward
Comments Comments
© 1997 The McGraw-Hill Companies, Inc. All rights reserved.
Any use of this Beta Book is subject to the rules stated in the Terms of Use.

Chapter 24 - Creating CGI Scripts from Existing Tools

One of the problems that face companies of all sizes as they migrate operations to the World Wide Web, is what to do with their existing pool of applications that are either GUI- or screen-based. While the Web does make great inroads into creating and promoting a consistent appearance and interface, the nature of the HTTP protocol yields an environment that is devoid of state and persistence. This is not news. Hundreds of papers and publications mention this and address it, but there has not been a lot said about ways to work with it when faced with a great deal of legacy code from pre-WWW days.

Moving a tool from a more standard environment to the Web environment will mean resolving conflicts in several areas. These areas include (but are certainly not limited to) input parameters (command-line arguments versus HTML form elements), persistence of information from one page to the next, security of information and handling of error conditions. Any of these are viable chapters in a book devoted to Web and/or CGI, but in this chapter they will be examined from the viewpoint of trying to adapt older code to the Web API.

Make no mistake, there is no Perl library or wrapper out there that will automatically (or auto-magically) make screen-based or batch-execution scripts suddenly work as CGI scripts with comparable interfaces. In fact, this would not be a very good thing if it did exist, because as a totally different API, the Web has more to offer than just a generic graphical tool to browse information. Perl scripts running via CGI do have limitations, but they also have access to a very well documented, widely accepted graphical user interface.

Rather than try to blindly run old tools under CGI, or completely re-engineer tools for CGI at the expense of screen interfaces, this chapter will try to examine means by which to move scripts to a point in between, where they are useful on both fronts.

From the Start: Command Line Options

The first and most noticeable difference between traditional scripts and CGI scripts is the handling of input. CGI scripts do not have @ARGV populated as traditional scripts do. The STDIN file descriptor will not be usable as a source of input, either. A CGI script must retrieve its startup data from a combination of environment variables and STDIN, depending on the method used (GET or POST). Existing means of retrieving run-time options are all beholden to the @ARGV array. To start with, let's abstract the fetching and manipulation of run-time options.

An Abstracted Options Reader

We'll start with a simple module to read options in a more abstracted way. For this example, we'll use an object-oriented model:

Listing 24.1 - Options.pm

1 package Options;

2

3 use strict;

4 use Carp;

5 use Getopt::Long;

6

7 1;

8

9 sub import

10 {

11 my $class = shift;

12

13 @Options::Argv = @ARGV;

14 @Options::Argv = () if ($#Options::Argv == -1);

15

16 if (defined $_[0] and $_[0] =~ /^-?pass/oi)

17 {

18 Getopt::Long::config('pass_through');

19 }

20

21 1;

22 }

23

24 sub unimport

25 {

26 my $class = shift;

27 $class = ref($class) || $class;

28

29 carp "Command `no $class;' not implemented";

30

31 1;

32 }

33

34 sub new

35 {

36 my $class = shift;

37 my @opts = @_;

38

39 $class = ref($class) || $class;

40

41 my $self = bless {}, $class;

42

43 $self->{RAW_ARGV} = [@Options::Argv];

44 $self->{RAW_OPTS} = [@opts];

45

46 my %opts;

47 local @ARGV = @Options::Argv;

48

49 if (! GetOptions(\%opts, @opts))

50 {

51 croak "Invalid option(s). Exiting";

52 }

53

54 $self->{opts} = \%opts;

55

56 $self;

57 }

58

59 sub option

60 {

61 my $self = shift;

62 my $arg = shift;

63

64 my $type;

65

66 return undef unless (defined $self->{opts}->{$arg});

67

68 if ($type = ref($self->{opts}->{$arg}))

69 {

70 if (! wantarray)

71 {

72 return ($type eq 'ARRAY') ? scalar(@{$self->{opts}->{$arg}}) :

73 scalar(keys %{$self->{opts}->{$arg}});

74 }

75 else

76 {

77 return ($type eq 'ARRAY') ? (@{$self->{opts}->{$arg}}) :

78 (%{$self->{opts}->{$arg}});

79 }

80 }

81 else

82 {

83 return $self->{opts}->{$arg};

84 }

85 }

86

87 sub option_names

88 {

89 my $self = shift;

90

91 my @list = sort keys %{$self->{opts}};

92 }

This is a simple class that provides a few simple methods. The import method, starting at line 9, is designed to preserve a copy of @ARGV at initialization. This allows the rest of the module to operate without destroying @ARGV.

It then looks for the only currently supported option to the package itself, a string starting with "-pass". This will tell Options to set the value in the core Getopt::Long module that allows quiet allowance of options other than those specifically requested. This is useful for tools that in turn call other tools, and thus receive options intended for the other tool.

When this is done, import returns. There is an unimport method provided for completeness, so that should someone code a line that reads "no Options", they be informed that such is not a valid invocation.

The new method is the heart of any given class. This method is responsible for creating the new object and returning it. Lines 36-37 read in the arguments to the method (remember that the object calling convention automatically puts $class as the first argument). Line 39 is a little sleight-of-hand to allow the constructor to be called as either a static or dynamic constructor; one can create an object as "$obj = new Options ..." or one can create from an existing object of the class via "$obj2 = $obj->new(...)".

Each object keeps a copy of the raw command line (line 43) and requested options list (line 44) for debugging purposes. In 46-47, a new hash table is created, and the special variable @ARGV gets localized to the current scope, in preparation for the call to Getoptions. Line 49 does the call, using croak to report any errors and exit if need be. Assuming success, the hash is stored on an internal key and the reference is returned to the caller. But how are the options actually accessed?

The methods option_names and option are the access methods for the class. When the caller gets an object of class Options, they do not get any indication of which options were present, only that no illegal options were. The method option_names returns a list of the options that were successfully read, sorted.

Given the names, calls can be made to the option method to retrieve an actual value. The caller is responsible for knowing if said method invocation should return something other than a scalar. Lines 61-62 get the object reference and desired option from the call. Line 66 returns the special value undef if the requested option is not in the table. Other null values such as zero (0) could actually be valid option values, so undef is used.

On line 68, the value associated with $arg is checked to see if it is a reference. Jumping to the second half of the condition, lines 81-84, if it isn't a reference it is treated and returned as a scalar. If it is a reference, then a test is done to see if the caller is calling in a scalar or list context. In a scalar context (lines 72-73, when wantarray returns 0), the number of elements is the return value. Either the size of the array, or the number of keys in the hash table. If the context is an array context (lines 77-78), then the reference is simply de-referenced and the caller receives either the array or hash table, as appropriate.

Our Options Class is best illustrated by example:

Listing 24.2 - opttest.p

1 #!/usr/bin/perl -w

2

3 use Options;

4

5 my $opts = new Options qw(-list=s@ -int=i -any=s);

6

7 print "No options specified.\n" unless ($opts->option_names());

8

9 for $name ($opts->option_names())

10 {

11 printf "Option %-10s: %s\n", $name, join(" ", $opts->option($name));

12 }

13

14 exit;

This test script will accept -int followed by an integer, any number of -list specifications followed by general strings, and -any followed by a general string. Line 5 gets a new object of class Options with these specifications. Line 7 informs the use that there were no options, if none were found. Assuming that there was at least one, line 9 loops over the names returned by options_names. For each iteration of the loop, line 11 displays the name and value of the option. Note that the call to the option method on line 11 is forced into a list context by being called within join(). Thus, if the value of option $name is a list or hash table, all parts will be returned and joined into one string using a single space as the separator. If the script is run as:

test_opt -int 5 -list a -list b -any thing

The output will be:

Option any : thing

Option int : 5

Option list : a b

But this:

test_opt -int bad

Yields:

Value "bad" invalid for option int (number expected)

Invalid option(s). Exiting at test_opt line 6

A good start. But it clearly still uses @ARGV and standard argument parsing approaches. Where does CGI come in?

Subclassing the Basic Options

With a basic framework of a class in place, it is now easy to subclass it to handle more complex features. Specifically, it is desirable to detect at compile time if the program is running under CGI or not, and act accordingly. What follows is a sub-class of Options called Options::Common, in Listing 24.3:

Listing 24.3 Options::Common

Options/Common.pm

 

1 package Options::Common;

2

3 use strict;

4 use vars qw($running_under_cgi);

5 use Carp;

6 use Options;

7 use Detect;

8

9 @Options::Common::ISA = qw(Options);

10

11 1;

12

13 sub import

14 {

15 my $class = shift;

16 $class = ref($class) || $class;

17

18 if ($Detect::cgi && $#_ != -1) # ANYTHING in use line triggers this

19 {

20 print STDOUT "Content-type: text/plain\n\n";

21 }

22

23 $class->SUPER::import(@_);

24

25 1;

26 }

27

28 sub new

29 {

30 my $class = shift;

31 $class = ref($class) || $class;

32 my $self = bless {}, $class;

33

34 if (! $Detect::cgi)

35 {

36 return $self->SUPER::new(@_);

37 }

38 require CGI;

39

40 my @opts = @_;

41 my %opts;

42 my $cgi_obj = new CGI;

43 my ($item, $name, $type);

44

45 $self->{RAW_OPTS} = [@opts];

46 $self->{RAW_ARGV} = [@Options::Argv];

47 $cgi_obj->import_names('ARG');

48

49 no strict 'refs';

50

51 for $item (@opts)

52 {

53 $item =~ s/^-//o;

54 ($name, $type) = split(/=/, $item, 2);

55 if ($type =~ /\@$/o)

56 {

57 my @list;

58 if (defined @{"ARG::$name"} or defined $ {"ARG::$name"})

59 {

60 @list = @{"ARG::$name"};

61 @list = ($ {"ARG::$name"}) unless (@list);

62 }

63 if ($type =~ /^i/oi)

64 {

65 croak "All arguments for $name must be integers"

66 if (grep(! /^-?\d+$/o, @list));

67 }

68 $opts{$name} = [@list] if (@list);

69 }

70 elsif ($type eq 'i')

71 {

72 if (defined $ {"ARG::$name"})

73 {

74 $opts{$name} = $ {"ARG::$name"};

75 croak "Arg $name requires an integer (got $opts{$name})"

76 unless ($opts{$name} =~ /^-?\d+$/o);

77 }

78 }

79 elsif ($type eq 's' || $type == '')

80 {

81 if (defined $ {"ARG::$name"})

82 {

83 $opts{$name} = $ {"ARG::$name"};

84 }

85 }

86 else

87 {

88 croak "Unrecognized option type specifier: $type";

89 }

90 }

91

92 $self->{opts} = \%opts;

93

94 $self;

95 }

In subclassing Options, Options::Common starts by declaring Options as the parent class (line 9) and then re-defines the methods import and new. Looking first at import, variable $Detect::cgi is examined. This is set by the Detect module referenced on line 7 and explained a little later. If the running program is in a CGI environment, this value will be true. If it is, and if anything was put after the "use Options::Common" akin to importing, then the string "text/plain" is output. This will simplify converting batch-style scripts to CGI in the short-term.

Whether this is done or not, the parent class import method is then called using the special namespace identifier "SUPER". None of the functionality of Options::import was replaced, only a little extra added at the start.

The real changes come in the new method. Lines 30-32 are basically the same as the old, but the resemblance stops there. In line 34, CGI context is once again checked. If this is not a CGI process, then the superclass new method is called instead, with its return value directly passed back to the caller.

If this tool is a CGI script, things are now handled much more differently. Line 38 makes sure that the CGI library is loaded. Lines 40-47 declare variables and make local copies of options and @ARGV just as the parent new does. Line 47 itself uses the import_names method of the CGI class to copy all of the input values into variables in the ARG::* namespace. Fortunately, the CGI library abstracts POST and GET input methods, so the programmer does not need to worry at that level; all values are reachable via the same access method (a design very similar to what we are doing right now with command-line arguments!).

Line 49 disables the strict checking of references. Normally, symbolic references are disallowed by the strict pragma, but the rest of new needs them. Between lines 51 and 90, the requested options are examined one-by-one. The leading hyphen is removed (line 53) and the value split into name and type (line 54). If the type specifier starts with a @ character, then a list is requested. CGI doesn't have a data specification means that translates into a hash, so this loop can ignore hashes.

All the values under that name (tested both as a list or a scalar) are stored in a temporary list which is in turn stored on the opts key under $name. If there are no values, then no storage takes place.

Before leaving this branch of the conditional, the type specifier is checked to see if they requested a list of only integers. Lines 65-66 check the list, in this case. If the type requested was not a list, then it must be a scalar value. The block in lines 70-78 checks to see if they specifically want an integer and tests the value, if there is one, for this. The default falls through to lines 79-89, where a specifier of "s" or no specifier at all result in a scalar value with no type tests, and if the identifier was something other than "@", "i" or "s", an error is reported.

In a more detailed implementation, one would want to use the CGI::Carp package in a CGI context, so that the error messages were directed to the error logs and possibly the browser. As a simpler example, this communicates the point. At line 92, the %opts table is assigned to the object, and the object reference is returned. The caller now has an object of class Options::Common, but the retrieval of option names and values is exactly the same as it was for the command-line version.

Detect

For the purposes of compile time detection of a CGI context, it was necessary to throw together a small module to check the appropriate environment variables. We code a Detect module, which understands which environment - CGI, or shell - a given script is running in. The code for this is:

Listing 24.5 - Detect

Detect.pm

 

1 package Detect;

2

3 use strict;

4 use Carp;

5 use vars qw($cgi $webserver $server_version);

6

7 1;

8

9 sub import

10 {

11 my $class = shift;

12 my $params = shift || {};

13

14 $cgi = $webserver = $server_version = '';

15

16 if (defined $params->{cgi} and ref($params->{cgi}) eq 'CODE')

17 {

18 $cgi = &{$params->{cgi}};

19 }

20 else

21 {

22 $cgi = (defined $ENV{GATEWAY_INTERFACE}) ? 1 : 0;

23 }

24

25 return 1 unless ($cgi);

26

27 if (defined $params->{webserver} and

28 ref($params->{webserver}) eq 'CODE')

29 {

30 ($webserver, $server_version) = &{$params->{webserver}};

31 }

32 else

33 {

34 my $srv_string = $ENV{SERVER_SOFTWARE} || '1/0';

35 ($webserver, $server_version) = split('/', $srv_string);

36 }

37

38 1;

39 }

40

41 sub unimport

42 {

43 my $class = shift;

44 $class = ref($class) || $class;

45

46 carp "Command `no $class;' not implemented";

47

48 1;

49 }

This module only needs import. The unimport function is provided as protection again "no Detect". The import method takes and ignores the class passed in as the first argument, but takes note of the second argument, which is expected to be a hash reference. An empty hash reference is used if none was given.

The first test is on lines 16 to 23. The default (basic) test for CGI context is the presence of the environment variable named GATEWAY_INTERFACE. This is also the case when Perl is running under Windows 95 or NT. However, if the user wants more done, or more specific checking (such as specific gateway protocol revision), they can pass in a reference to an existent subroutine as the value to a key called "cgi" in the input hash. If this key exists and points to a code reference, that routine is called instead.

Note that since this is all running at compile time, the routine will have to be declared either within a BEGIN block prior to using this module, or passed as a closure. The return value of the routine should be 0 or 1. The default is sufficient to identify a CGI context. On line 25, we return if there is no CGI context, because there is nothing else worth checking. But if this is a CGI environment, then lines 27-36 check the name and version of the web server software. As with the CGI detection, the user can specify a routine to use, or the default just takes the SERVER_SOFTWARE environment variable. In case this is not set (such as debugging a CGI program from a command-line), the string defaults to "1/0", so that testing the variable $Detect::webserver still returns true.

A sample usage of this module might look like what is in Listing 24.6. Note that the $Detect::cgi variable determines whether or not to output HTML tags:

Listing 24.6 - testdetect.p

1 #!/usr/bin/perl

2

3 use Detect;

4

5 if ($Detect::cgi)

6 {

7 # ... output HTML start-up tags and headers

8 }

9

10 # ... normal script processing, with output format also based on the CGI

11 # ... test, maybe even testing $Detect::webserver for some features

12

13 if ($Detect::cgi)

14 {

15 # ... output HTML closing tags

16 }

17

18 exit;

Nothing too new, but the ready availability of the value $Detect::cgi allows easy in-line selection of output styles.

Error Reporting and Management

Earlier it was noted that the simplified implementation of Options::Common suffered from the fact that it did not take into account the CGI context when reporting errors (or warnings).

This is another major area in which the transition from traditional scripts to CGI is significant. Errors and warnings generally go to STDOUT, which in a CGI context goes to the server's error logs. The CGI library provides an additional module CGI::Carp that redefines die, warn, carp and croak to send their output to the logs in a format consistent with HTTP error reporting. It is also possible to have errors echoed to the browser. Of course, you don't want your script to load either of CGI or CGI::Carp unless it is actually running in a CGI context. This makes for a more challenging issue.

To maintain maximum transparency, using the test on $Detect::cgi to choose either "croak" or "CGI::Carp::croak" is undesirable. Better to use eval after the CGI context has been identified:

eval { use CGI::Carp; }

if ($Detect::cgi);

 

die "Something bad has happened!";

Putting this in Detect.pm's import function would require using Perl's caller function and calling CGI::Carp's import directly. Putting it in the script itself adds a little more verbiage, but leaves a clearer distinction (remember, there will be no auto-magic conversion).

This package can be made to also send fatal errors to the browser by importing a special "function" called fatalsToBrowser:

eval { use CGI::Carp qw(fatalsToBrowser); }

if ($Detect::cgi);

 

die "Something else bad has happened!";

Yet another means of fine-tuning the control over errors and warnings comes from a routine called carpout. It is not a very good performer, and is mostly recommended for handling warnings in such a way as to echo them to the browser (the fatalsToBrowser predicate only affects errors.) The carpout routine is not exported by default, and must be requested:

eval { use CGI::Carp qw(carpout); carpout(STDOUT); }

if ($Detect::cgi);

 

warn "Something non-fatal just happened";

It is called with an open, writeable filehandle. An important subtlety here is that in order to catch compiler errors this way, the eval/if would need to be in a BEGIN block, likely requiring that the call to Options::Common (or maybe just directly to Detect) occurs there as well. Not worrying about compile-time errors for now, the earlier test script can be enhanced as follows:

1 #!/usr/bin/perl -wT

2

3 use Options::Common;

4

5 eval { use CGI::Carp qw(fatalsToBrowser); } if ($Detect::cgi);

6

7 my $opts = new Options::Common qw(-list=s@ -int=i -any=s);

8 die "No options specified" unless ($opts->option_names);

9

10 print "Content-type: text/plain\n\n" if ($Detect::cgi);

11 for $name ($opts->option_names)

12 {

13 printf "Option %-10s: %s\n", $name, join(" ", $opts->option($name));

14 }

15

16 exit;

There is no need to show specific outputs, as the core of the script has not changed at all; compare lines 7 and 11-14 with lines 5 and 9-12 in the first version of this test. The only difference is the use of Options::Common instead of Options. Here, there is the eval/if combo, and an additional test on the $Detect::cgi value, to spit out a simple text/plain header. Any errors trapped by CGI::Carp will have sent their own headers.

A successful run under a browser results in input that looks exactly like the sample input earlier. But if an error occurs in the argument parsing or in the case of no arguments, then the error message on the browser references the line at which the error occurred and clearly notes that this is an error. This is an improvement over the more typical behavior of getting an empty document with no explanation.

Of course, if the legacy code handles its errors and warnings with print's to STDERR and the occasional exit, then that is a different matter. But if all the diagnostics are managed via warn/die, or the confess/croak/carp set, then switching between terminal and web browser contexts should not be too much hassle.

On The Inside: Input, Output and Persistent Data

HTTP, as a protocol, is stateless. CGI, reliant upon HTTP, is therefore also stateless. If you've read any other sources on either HTTP or CGI, you have heard this repeated over and over.

A lot of the reason for the repetition (including the repetition here, as well) is that matters of information persistence between sessions ranks high on the list of things that developers new to CGI have to overcome. Most programs that have any degree of user interaction, particularly legacy code, follow a design of forward processing. They proceed from start to finish, polling data as needed. When a CGI application runs, it goes straight through.

The only user input is that which is gleaned from the query. Many CGI scripts are self-referencing, running anywhere from a few to a few dozen times for one "session" of one end-user. Web designers have taken a number of approaches to implementing data persistence across sessions while also structuring the programs themselves to run in different states based on the combination of input data. This section will start by looking at some of these approaches.

Squeezing the Most out of Post

The most obvious way to carry data from one session to the next is as part of the URL in a GET method, or in the data of a POST method. Using GET methods result in very cryptic URL strings and are limited to an arbitrary length (which can vary based on the server or browser). On the other hand, such a URL can be checkpointed and jumped to directly at a later time.

With POST methods, there are fewer limitations on the size of the data being passed from session to session, but it isn't possible to checkpoint any one page and return to it later. As such, if this is the preferred method of data persistence, the choice boils down to whether the end user should be able to bookmark the process at some internal point or not. For on-line ordering systems, this probably is not a requirement. For other systems, it may well be.

This is also one of the easiest means by which to move your data from session to session. It requires no external packages (not even the CGI library, though this chapter assumes that it is being used) or juggling of the data. When browsing a site via one of the commercial search engines such as Yahoo! or Altavista, take note of the URL displayed in the browser's location window. Cryptic as it may appear, it contains all the information relevant to the ongoing search session taking place, including the browsing through page after page of results.

Using a Database Index Key for Sessions

If you use a database system with your CGI project (whether this be a simple system like DBM or a commercial SQL-based system), then the data can be held on the server, and the browser need only remember the unique key from page to page. If the database sessions are meant only for short term, the key can be in a hidden form element and the progression from page to page done by POST (useful if there are other forms to be filled out along the way). If the key is indexing data that may persist over a longer period, the key could be part of the URL for a GET method, and thus bookmarked for later use (also see the next section on browser cookies).

By using this approach, the quantity, persistence and freshness of data are at the leisure of the CGI developer. This approach is further enhanced by the fact that Perl itself includes multiple DBM-style interfaces in the core of the language. GNU GDM, Berkeley DB, standard UNIX DBM and NDBM, as well as a local implementation called SDBM that runs on the ports of Perl to Windows platforms. While the best choice may be to install an extra package such as Berkeley DB, an application can be quickly prototyped with the Perl extension called AnyDBM_File, which picks the first DBM implementation it can find that is implemented on the system. Later on, the data can be moved to a specific format of database for the production code.

Browser-Specific Features: Cookies

Some browsers support the concept of cookies, a data token that is stored locally on the user's machine. It is transmitted to a particular host or domain whenever the browser requests a page from that host or domain.

Cookies can be given a lifespan, can be set to be sent only for a certain area of the target host, and can carry a flag that indicates the cookie should only be sent if communicating on a secure channel. Cookies don't generally transmit a large chunk of data. However, they are a good way to sustain a database key across sessions, or store data that is by definition smaller (such as end-user preferences for the web site, such as whether to use frames, text-only, etc.) The pitfall to this approach is the browser-specific nature of cookies, limiting their usefulness to visitors who do not use a compatible browser.

Back to the Issue at Hand: Data

Those tools that are the most interactive in their execution and gathering of data will be the most difficult to bring over to a CGI environment. If the pool of scripts awaiting conversion is mostly made up of single-purse, short administrative scripts, the task will be much easier. Take as an example the following very basic rolodex utility.

Listing 24.7 - rolodex.p

1 #!/usr/bin/perl -w

2

3 BEGIN { @AnyDBM_File::ISA = qw(DB_File SDBM_File NDBM_File) }

4 use AnyDBM_File;

5 use Options;

6 use Carp;

7

8 $opts = new Options qw(-name=s -add -delete=s);

9

10 $name = $opts->option('name') || '';

11 $add = $opts->option('add') || 0;

12 $del = $opts->option('delete') || '';

13

14 croak "Only one of -add or -delete may be specified, stopped"

15 if ($add and $del);

16

17 tie %rolo_hash, 'AnyDBM_File', '/u/rjray/locarolo.dex';

18

19 if ($name)

20 {

21 if (exists $rolo_hash{$name})

22 {

23 @data = split("\n", $rolo_hash{$name});

24 %data = map { split(/=/, $_, 2) } @data;

25 for (qw(NAME PHONE EMAIL))

26 {

27 printf "%-10s: %s\n", ucfirst lc $_, $data{$_};

28 }

29 for (grep(/^ADD/, sort keys %data))

30 {

31 printf "%-10s: %s\n", ucfirst lc $_, $data{$_};

32 }

33 }

34 else

35 {

36 carp "No record for ``$name'' in the rolodex.\n";

37 }

38 }

39 elsif ($add)

40 {

41 $line = '';

42 @addr = ();

43

44 print "Creating new record:\n\nNew Name:\n";

45 $new_name = <STDIN>; chomp $new_name;

46 croak "NAME is a required field, stopped" unless ($new_name);

47 croak "NAME $new_name already exists, stopped"

48 if (exists $rolo_hash{$new_name});

49

50 print "New phone:\n";

51 $new_phone = <STDIN>; chomp $new_phone;

52 print "E-Mail address:\n";

53 $new_email = <STDIN>; chomp $new_email;

54

55 print "Enter address information. Enter '.' to end input:\n";

56 do

57 {

58 $line = <STDIN>; chomp $line;

59 push(@addr, $line) unless ($line eq '.');

60 } while ($line ne '.');

61

62 $data = "NAME=$new_name\nPHONE=$new_phone\nEMAIL=$new_email\n";

63 $count = 1;

64 $data .= join("\n",

65 map { sprintf("ADDR%d=%s", $count++, $_) } (@addr));

66

67 $rolo_hash{$new_name} = $data;

68 }

69 elsif ($del)

70 {

71 croak "DELETE: Name ``$del'' is not in the rolodex, stopped"

72 unless (exists $rolo_hash{$del});

73

74 delete $rolo_hash{$del};

75 }

76 else

77 {

78 for (sort keys %rolo_hash)

79 {

80 print "$_\n";

81 }

82 }

83

84 untie %rolo_hash;

85

86 exit;

When this is described as basic, understand that the word is not used lightly. A real system would offer more in terms of data validation, flexible searching, and a host of other options. But for the sake of illustration, this is sufficient.

Picking the tool apart in sections, the lines from 3-6 control the use of outside libraries. The use of the BEGIN block on line 3 forces the order of preference in the module AnyDBM_File. Doing this, the Berkeley DB library gets preference, falling through to SDBM_File if DB_File is not present. In case neither are, the last choice is NDBM_File. Line 4 pulls in the AnyDBM_File superclass, and line 5 pulls in the now-familiar Options library. The Carp library is referenced on line 6 as a matter of preference for the flexibility in error message routing it offers (this will be a boon later on.)

Lines 8-12 create the Options class instance and assign some local names for the requested options. This also allows for defaulting these variables to empty strings or zeros as appropriate (a step that prevents warnings of the variety "Use of uninitialized value".) Line 17 connects to the database.

Lines 17-38 are the first of three cases that demand specific action. The if clause looks for a requested name to have been passed in via the -name command line option. If a name was passed, it is then checked to see that it actually exists in the database. If this test also succeeds, the information is retrieved from the DB, unpacked according to the simple format used, then displayed in a neatly-formatted manner. If the requested name is not found, then an error message is displayed using the croak function.

The second operative case is the addition of a new record, tested for and handled in lines 39-68. Rather than have the -add option provide some subset of the data, this block handles all of the new data input, so as to reduce the potential for confusion. After the name is read on line 45, it is checked against the current rolodex to ensure that said key is not already in use.

Lines 50-60 read the remaining data, with the simple loop being used to allow an arbitrary number of lines for the surface-mail address. Lines 62-65 pack the data for storage, and line 67 handles the assignment to the rolodex database.

For deletion requests, the block in lines 69-75 take the name from the -delete command-line option, check for existence in the database (lines 71-72 with a croak if it is not found), and perform the delete. Nothing fancy, though it could probably benefit from a confirmation.

The last block is executed only when none of the other options were requested. It simply displays the names in the rolodex in alphabetical order, using a simple for loop and the built-in sort function. Lastly within the script, line 84 forces a release of the database handles (often a redundant operation, but in some cases an explicit untie can be very necessary) and line 86 exits gracefully.

The first steps toward CGI co-existence

For this first stage of transformation, the focus will be on simply making the existing "rolodex" script run under a Web browser, without adding any new or fanciful features. Below, in Listing 24.8, is the text of rolodex2:

Listing 24.8 - rolodex2.p

1 #!/usr/bin/perl -w

2

3 BEGIN { @AnyDBM_File::ISA = qw(DB_File SDBM_File NDBM_File) }

4 use AnyDBM_File;

5 use Options::Common;

6 use Detect;

7 use Carp;

8

9 $opts = new Options::Common qw(-name=s -add -delete=s

10 -new_name=s -new_phone=s -new_email=s

11 -new_addr=s@);

12

13 $name = $opts->option('name') || '';

14 $add = $opts->option('add') || 0;

15 $del = $opts->option('delete') || '';

16

17 if ($Detect::cgi)

18 {

19 eval "use CGI; use CGI::Carp";

20

21 croak "Error bringing in CGI support: $@, stopped" if ($@);

22 }

23

24 croak "Only one of -add or -delete may be specified, stopped"

25 if ($add and $del);

26

27 tie %rolo_hash, 'AnyDBM_File', '/u/rjray/locarolo.dex';

28

29 if ($name)

30 {

31 if (exists $rolo_hash{$name})

32 {

33 print "Content-Type: text/html\n\n" if ($Detect::cgi);

34 @data = split("\n", $rolo_hash{$name});

35 %data = map { split(/=/, $_, 2) } @data;

36 for (qw(NAME PHONE EMAIL))

37 {

38 printf "%-10s: %s\n", ucfirst lc $_, $data{$_};

39 print "<br>" if ($Detect::cgi);

40 }

41 for (grep(/^ADD/, sort keys %data))

42 {

43 printf "%-10s: %s\n", ucfirst lc $_, $data{$_};

44 print "<br>" if ($Detect::cgi);

45 }

46 }

47 else

48 {

49 carp "No record for ``$name'' in the rolodex.\n";

50 }

51 }

52 elsif ($add)

53 {

54 if ($Detect::cgi)

55 {

56 my $Q = new CGI;

57

58 if ($new_name = $opts->option('new_name'))

59 {

60 $new_phone = $opts->option('new_phone') || '';

61 $new_email = $opts->option('new_email') || '';

62 @addr = $opts->option('new_addr') || ();

63

64 chomp ($new_phone, $new_email, $new_name, @addr);

65

66 $data = "NAME=$new_name\nPHONE=$new_phone\nEMAIL=$new_email\n";

67 $count = 1;

68 $data .= join("\n",

69 map { sprintf("ADDR%d=%s",

70 $count++, $_) } (@addr));

71

72 $rolo_hash{$new_name} = $data;

73 print $Q->header, $Q->start_html(-title => 'Entry Added');

74 print $Q->p("The new data for: $new_name");

75 print $Q->p("has been added to the rolodex.");

76 print $Q->end_html;

77 }

78 else

79 {

80 print $Q->header;

81 print $Q->start_html(-title => 'Add new rolodex entry');

82 print $Q->center($Q->h1('Add new rolodex entry'));

83 print $Q->p();

84 print $Q->startform('POST', $Q->script_name);

85 print "New Name: ";

86 print $Q->textfield(-name => 'new_name', -maxlength => 30),

87 $Q->br;

88 print "New phone: ";

89 print $Q->textfield(-name => 'new_phone', -maxlength => 12),

90 $Q->br;

91 print "E-Mail: ";

92 print $Q->textfield(-name => 'new_email', -maxlength => 30),

93 $Q->br;

94 print "Address:", $Q->br;

95 print $Q->textarea(-name => 'new_addr', -rows => 5,

96 -columns => 40);

97 print $Q->br;

98 print $Q->submit(-name => 'add'), " this data", $Q->br;

99 print $Q->reset, " the form";

100 print $Q->endform;

101 print $Q->end_html;

102 }

103 }

104 else

105 {

106 $line = '';

107 @addr = ();

108

109 print "Creating new record:\n\nNew Name:\n";

110 $new_name = <STDIN>; chomp $new_name;

111 croak "NAME is a required field, stopped" unless ($new_name);

112 croak "NAME $new_name already exists, stopped"

113 if (exists $rolo_hash{$new_name});

114

115 print "New phone:\n";

116 $new_phone = <STDIN>; chomp $new_phone;

117 print "E-Mail address:\n";

118 $new_email = <STDIN>; chomp $new_email;

119

120 print "Enter address information. Enter '.' to end input:\n";

121 do

122 {

123 $line = <STDIN>; chomp $line;

124 push(@addr, $line) unless ($line eq '.');

125 } while ($line ne '.');

126

127 $data = "NAME=$new_name\nPHONE=$new_phone\nEMAIL=$new_email\n";

128 $count = 1;

129 $data .= join("\n",

130 map { sprintf("ADDR%d=%s", $count++, $_) } (@addr));

131

132 $rolo_hash{$new_name} = $data;

133 }

134 }

135 elsif ($del)

136 {

137 croak "DELETE: Name ``$del'' is not in the rolodex, stopped"

138 unless (exists $rolo_hash{$del});

139

140 delete $rolo_hash{$del};

141 print "Content-Type: text/html\n\n" if ($Detect::cgi);

142 print "Record ``$del'' has been deleted.\n";

143 }

144 else

145 {

146 my $Q = new CGI

147 if ($Detect::cgi);

148

149 print $Q->header, $Q->start_html(-title => 'rolodex') if ($Detect::cgi);

150 for (sort keys %rolo_hash)

151 {

152 if ($Detect::cgi)

153 {

154 ($name = $_) =~ s/ /+/go;

155 print $Q->a({ -HREF => $Q->script_name . "?name=$name" },

156 $_);

157 print $Q->br;

158 }

159 else

160 {

161 print "$_\n";

162 }

163 }

164

165 print $Q->end_html;

166 }

167

168 untie %rolo_hash;

169

170 exit;

In this example, you will see that a lot of the code is the same as the previous version. The first noteworthy addition is on lines 9-11, where Options::Common is used instead of plain Options (as was specified on the use statement on line 5). new is given four more potential parameters to watch for. These will be checked later.

The Detect module is also directly referenced here, though mostly for the sake of clarity. Nothing is exported by it, and the rest of the code will be checking the value of the variable $Detect::cgi directly, with full package-qualification.

The block from lines 17 to 22 replaces the previous usage of the Carp library. Now, if the script is running in a CGI context, the CGI library and the CGI::Carp library are both used. Otherwise, the Carp library is left in place and used, as was the case previously. As a result, for the remainder of the script any use of carp or croak will be properly handled for both CGI and command-line contexts.

Line 29 is where the core of the script starts, in the series of if statements that decide what course of action to follow. On line 33, within the block that will output the data "card" for a requested name, the value of $Detect::cgi is tested. If the script is in a CGI context a simple header (Content-Type) is output, identifying what follows as HTML. None of the actual data output is altered. HTML tags that cause linebreaks are output after each line to keep it from running together in the browser, but again these are done conditionally based on the value of $Detect::cgi.

This is the extent of change to the block that handles the "-name" command line functionality. Any errors were reported with croak, which will act accordingly based on the context. There is no need to examine the various print statements to see which ones are error messages to be specially handled. The alternation of Carp and CGI::Carp takes care of this.

Skipping over the block that handles adds (we'll return to it last) to line 135, there is even less change to the block that handles deletions. Only the output of the Content-Type header, to satisfy the browser. As with the name-display block, errors are routed correctly through croak.

From lines 144 to 166, the default action of displaying the names alphabetically is handled. But with a twist this time, due to the CGI support. Rather than try to emit a great deal of HTML manually, this block creates an object of the CGI class if $Detect::cgi indicates such a need. This object is used to reference the HTML shortcuts that the library provides.

In this block, the desire is to not just list the names to the browser, but to actually make them links to this same script, but with a specific name specified for display. Now that the CGI object and its attendant methods are available, line 149 uses those methods to emit the relevant HTTP headers (the $Q->header method) and start the HTML code with proper initialization and directives (the $Q->start_html method, which also provides a document title).

The loop that actually lists the names now has a an if clause, allowing it to simply print the names in a command-line context, or do much more in the CGI context. In the latter, the name is first slightly altered so that spaces are marked by the "+" sign. This is for the sake of the CGI protocol for passing arguments in a GET method. Without this, the name data would not be transmitted correctly.

Then the method $Q->a is used to effect an anchor, the familiar HTML "A" tag. All of these shortcuts that follow a basic pattern have the same interface: if the first argument is a hash reference, it is treated as a list of attributes for the HTML tag. In this case, the only attribute being passed is the well-known "HREF" for specifying the link. Its value is created by using another CGI method, script_name, that returns the URL of the current script for the sake of self-referencing CGI applications such as this one.

Following the hash reference (if it is present at all) is the text that should be enclosed within this tag and the tag's closing specifier. For this example, that text is the unchanged name. The doctored name was used in specifying the URL for the HREF attribute. As with the earlier block that also displayed multiple lines, the BR tag is emitted to force line-breaks. Only in this case, it is called as a method on the CGI object instead of emitted directly.

This takes us to the add block, the block from lines 52 to 134. Unlike the logical blocks that only produced output, the add functionality of the rolodex required several pieces of input from the user. As a result, the block looks drastically different now that CGI support is required. Notes lines 104 to 133 are unchanged from the original script, just moved to a block where they serve as a clause to the testing of $Detect::cgi. Line 56 starts the CGI-specific block with the creating of a CGI class object.

The test on line 58 is the first reference to the four new options specified on lines 9-11, in the new method call to Options::Common. If this parameter has a value, then it can only mean one thing: that the script has already been through once. This is because the second part of this if evaluation, the case in which "new_name" has no value, is the only other reference to the parameter.

Looking at this second block first, lines 80-101 use a variety of HTML shortcut methods provided by the CGI object to emit HTTP headers, start the HTML page, create a form and end the page. Look closely at the names of the shortcuts; they are designed to be very similar or outright identical to the resulting HTML. Rather than explaining each one here, the reader is referred to the manual page for the CGI.pm library. Line 84 is worth note, as it starts the form declaring that it will be sent as a POST method, and that the action to be taken is to call this same script again (but note the lack of trailing information on the URL, since this method is POST rather than GET).

The sequence from line 85 to 87 is essentially repeated for the other parts of data. The sequence itself prints a simple textual label followed by an entry box. The specification of the box gives a name to the form field produced, and also specifies size. When the form is posted (when the "Submit" button is pressed), the data in these fields will be passed along using the specified names. This is how the test for "new_name" can tell that the script is on its second cycle, and thus avoids redisplaying the form.

Returning to the processing of the form data, lines 60-76, the variable $new_name was set as a side effect of the test, and the other values are set by querying the Options::Common object. Line 64 is a safety measure to ensure that no trailing whitespace or newline characters are left in. Then the block from lines 66 to 72 performs the same processing of the data that the old version of the script did (and still does in lines 127-132). A short message is output to the browser using the CGI shortcuts, indicating a successful addition of data.

So what does this illustrate? Those blocks that were not dependent on user interactive input showed very little change. But the block that did require input from the user was drastically altered. This repeats the point made earlier, that there is no one pass, off-the-shelf solution to this process.

The goal here is to simplify, not automate. All the same, this second-generation script still has a lot of shortcomings. It simply is not easy to use in a WWW environment, and that is after all the goal.

One More Iteration Through

Now that the impact of the differences in input handling have been illustrated, one more pass at the rolodex script should be made. This will add some nicer appearance characteristics and make it a little more user friendly in the WWW sense of the term. For this example, the CGI class will be subclassed in order to let us add a little twist to the IMG tag: automatic size information. A few icons and small graphics can add a little more sense of life to the generated page. However, CGI scripts are not static things. The various tools available to stream edit HTML code and add HEIGHT and WIDTH attributes to images, cannot be used on CGI scripts. For this next example to run, the Image::Size library from CPAN will be needed. The library is pure Perl code, requiring no compilation, and should install very easily.

First, the code for the subclassed CGI approach, called simply NewCGI:

Listing 24.9 - NewCgi

1 package NewCGI;

2

3 use CGI;

4 use Image::Size qw(attr_imgsize);

5 use vars qw(@ISA);

6

7 my $img_path = '/u/rjray/html';

8

9 @ISA = qw(CGI);

10

11 sub img

12 {

13 my $self = shift;

14 my $args = (ref($_[0]) eq 'HASH') ? shift : {};

15

16 my ($key) = grep(/^-?src$/oi, keys %{$args});

17

18 if ($key)

19 {

20 my $url = $args->{$key};

21 my $path;

22 ($path = $url) =~ s|^/~rjray|$img_path|;

23 if (-e "$path")

24 {

25 %{$args} = (%{$args}, attr_imgsize($path));

26 }

27

28 return CGI->img($args, @_);

29 }

30 else

31 {

32 return CGI->img(@_);

33 }

34 }

There is little remarkable here. The goal of this is to allow a local version of the img() method to be used. To do this, all that needs to be done is to refer to CGI as the parent class (line 9) and define our own img() method (lines 11-34). The new version of img is done very simply here, for the sake of illustration. Only those image URLs that start with the string "/~rjray" are handled. The URL is translated into a viable path, and then that path is passed to the subroutine attr_imgsize to get height and width.

The attr_imgsize routine takes an image file, finds the size, then returns a four-element list that is tailored to the style of attributes used in the CGI library. This makes it easier to inline these values directly into the existing attributes. Because the CGI.pm library is designed well from an OO standpoint, all the other methods (including new) are automatically available through an object of class NewCGI.

Now, on to the last example of a rolodex:

Listing 24.10 - rolodex3.p

1 #!/usr/bin/perl -w

2

3 BEGIN { @AnyDBM_File::ISA = qw(DB_File SDBM_File NDBM_File) }

4 use AnyDBM_File;

5 use Options::Common;

6 use Detect;

7 use Carp;

8 use NewCGI;

9

10 $opts = new Options::Common qw(-name=s -add -delete=s

11 -new_name=s -new_phone=s -new_email=s

12 -new_addr=s -del_name=s);

13

14 $name = $opts->option('name') || '';

15 $add = $opts->option('add') || 0;

16 $del = $opts->option('delete') || '';

17

18 if ($add and $del)

19 {

20 if ($Detect::cgi)

21 {

22 print $Q->header, $Q->start_html(-title => 'ERROR');

23 print $Q->p("Only one of `add' or `delete' may be specified, ",

24 "stopped at line " . __LINE__);

25 print $Q->p();

26 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

27 -ALIGN => 'BOTTOM' }), " ",

28 $Q->a({ -HREF => $Q->script_name },

29 "Return to the list of entries"));

30 print $Q->end_html;

31 exit -1;

32 }

33 else

34 {

35 croak "Only one of `add' or `delete' may be specified, stopped";

36 }

37 }

38

39 tie %rolo_hash, 'AnyDBM_File', '/u/rjray/locarolo.dex';

40

41 if ($name)

42 {

43 if (! exists $rolo_hash{$name})

44 {

45 if ($Detect::cgi)

46 {

47 print $Q->header, $Q->start_html(-title => 'ERROR');

48 print $Q->p("No record for ``$name'' in the rolodex, ",

49 "stopped at line " . __LINE__);

50 print $Q->p();

51 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

52 -ALIGN => 'BOTTOM' }), " ",

53 $Q->a({ -HREF => $Q->script_name },

54 "Return to the list of entries"));

55 print $Q->end_html;

56 exit -1;

57 }

58 else

59 {

60 croak "No record for ``$name'' in the rolodex, stopped";

61 }

62 }

63 else

64 {

65 @data = split("\n", $rolo_hash{$name});

66 %data = map { split(/=/, $_, 2) } @data;

67 if ($Detect::cgi)

68 {

69 my $Q = new NewCGI;

70

71 print $Q->header;

72 print $Q->start_html(-title => "Rolodex entry for: $name");

73 print $Q->p($Q->img({ -SRC => '/~rjray/g/bigblueball.gif',

74 -ALIGN => 'BOTTOM' }),

75 $Q->font({ -SIZE => '+3' },

76 $Q->b($Q->i(" Rolodex Entry for: $name"))));

77 print $Q->p();

78 print $Q->table({ -BORDER => 0, -CELLPADDING => 3 },

79 (map {

80 $Q->TR($Q->td({ -ALIGN => 'RIGHT' },

81 ucfirst lc $_ . ':'),

82 $Q->td(),

83 $Q->td($data{$_}))

84 } (qw(NAME PHONE EMAIL),

85 (grep(/^ADD/, sort keys %data)))));

86 print $Q->p();

87 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

88 -ALIGN => 'BOTTOM' }), " ",

89 $Q->a({ -HREF => $Q->script_name },

90 "Return to the list of entries"));

91 print $Q->end_html;

92 }

93 else

94 {

95 for (qw(NAME PHONE EMAIL))

96 {

97 printf "%-10s: %s\n", ucfirst lc $_, $data{$_};

98 }

99 for (grep(/^ADD/, sort keys %data))

100 {

101 printf "%-10s: %s\n", ucfirst lc $_, $data{$_};

102 }

103 }

104 }

105 }

106 elsif ($add)

107 {

108 if ($Detect::cgi)

109 {

110 my $Q = new NewCGI;

111

112 if ($new_name = $opts->option('new_name'))

113 {

114 if (defined $rolo_hash{$new_name})

115 {

116 print $Q->header, $Q->start_html(-title => 'ERROR');

117 print $Q->p("NAME $new_name already exists in database. ",

118 "Stopped at $0, line " . __LINE__);

119 print $Q->p();

120 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

121 -ALIGN => 'BOTTOM' }), " ",

122 $Q->a({ -HREF => $Q->script_name },

123 "Return to the list of entries"));

124 print $Q->end_html;

125 exit -1;

126 }

127 $new_phone = $opts->option('new_phone') || '';

128 $new_email = $opts->option('new_email') || '';

129 my $addr = $opts->option('new_addr');

130 @addr = split("\n", $addr);

131

132 chomp ($new_phone, $new_email, $new_name, @addr);

133

134 $data = "NAME=$new_name\nPHONE=$new_phone\nEMAIL=$new_email\n";

135 $count = 1;

136 $data .= join("\n",

137 map { sprintf("ADDR%d=%s",

138 $count++, $_) } (@addr));

139

140 $rolo_hash{$new_name} = $data;

141 print $Q->header,

142 $Q->start_html(-title => "Entry $new_name Added");

143 print $Q->p($Q->img({ -SRC => '/~rjray/g/bigblueball.gif',

144 -ALIGN => 'BOTTOM' }),

145 $Q->font({ -SIZE => '+3' },

146 $Q->b($Q->i(" New Entry for: $new_name"))));

147 print $Q->p("The new data for: $new_name", $Q->br,

148 "has been added to the rolodex.");

149 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

150 -ALIGN => 'BOTTOM' }), " ",

151 $Q->a({ -HREF => $Q->script_name },

152 "Return to the list of entries"));

153 print $Q->end_html;

154 }

155 else

156 {

157 print $Q->header;

158 print $Q->start_html(-title => 'Add new rolodex entry');

159 print $Q->p($Q->img({ -SRC => '/~rjray/g/bigblueball.gif',

160 -ALIGN => 'BOTTOM' }),

161 $Q->font({ -SIZE => '+3' },

162 $Q->b($Q->i(" Add a new rolodex entry"))));

163 print $Q->p();

164 print $Q->startform('POST', $Q->script_name);

165 print $Q->table({ -BORDER => 0, -CELLPADDING => 3 },

166 $Q->TR(

167 $Q->td({ -ALIGN => 'RIGHT' },

168 "New Name:"),

169 $Q->td($Q->textfield(-name => 'new_name',

170 -maxlength => 30))

171 ),

172 $Q->TR(

173 $Q->td({ -ALIGN => 'RIGHT' },

174 "New phone:"),

175 $Q->td($Q->textfield(-name => 'new_phone',

176 -maxlength => 12))

177 ),

178 $Q->TR(

179 $Q->td({ -ALIGN => 'RIGHT' },

180 "E-Mail:"),

181 $Q->td($Q->textfield(-name => 'new_email',

182 -maxlength => 30))

183 ),

184 $Q->TR({ -VALIGN => 'TOP' },

185 $Q->td({ -ALIGN => 'RIGHT' },

186 "Address:"),

187 $Q->td($Q->textarea(-name => 'new_addr',

188 -rows => 5,

189 -columns => 40))

190 ));

191 print $Q->br;

192 print $Q->submit(-name => 'add'), " this data", $Q->br;

193 print $Q->b("or"), $Q->br;

194 print $Q->reset, " the form";

195 print $Q->endform;

196 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

197 -ALIGN => 'BOTTOM' }), " ",

198 $Q->a({ -HREF => $Q->script_name },

199 "Go back to the list of entries"));

200 print $Q->end_html;

201 }

202 }

203 else

204 {

205 $line = '';

206 @addr = ();

207

208 print "Creating new record:\n\nNew Name:\n";

209 $new_name = <STDIN>; chomp $new_name;

210 croak "NAME is a required field, stopped" unless ($new_name);

211 croak "NAME $new_name already exists, stopped"

212 if (exists $rolo_hash{$new_name});

213

214 print "New phone:\n";

215 $new_phone = <STDIN>; chomp $new_phone;

216 print "E-Mail address:\n";

217 $new_email = <STDIN>; chomp $new_email;

218

219 print "Enter address information. Enter '.' to end input:\n";

220 do

221 {

222 $line = <STDIN>; chomp $line;

223 push(@addr, $line) unless ($line eq '.');

224 } while ($line ne '.');

225

226 $data = "NAME=$new_name\nPHONE=$new_phone\nEMAIL=$new_email\n";

227 $count = 1;

228 $data .= join("\n",

229 map { sprintf("ADDR%d=%s", $count++, $_) } (@addr));

230

231 $rolo_hash{$new_name} = $data;

232 }

233 }

234 elsif ($del)

235 {

236 if ($Detect::cgi)

237 {

238 my $del_name;

239 my $Q = new NewCGI;

240

241 if ($del_name = $opts->option('del_name'))

242 {

243 unless (exists $rolo_hash{$del_name})

244 {

245 print $Q->header, $Q->start_html(-title => 'ERROR');

246 print $Q->p("DELETE: Name ``$del_name'' not in the rolodex, ",

247 "stopped at line " . __LINE__);

248 print $Q->p();

249 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

250 -ALIGN => 'BOTTOM' }), " ",

251 $Q->a({ -HREF => $Q->script_name },

252 "Return to the list of entries"));

253 print $Q->end_html;

254 exit -1;

255 }

256

257 delete $rolo_hash{$del_name};

258

259 print $Q->header;

260 print $Q->start_html(-title => "Rolodex - $del_name deleted");

261 print $Q->p($Q->img({ -SRC => '/~rjray/g/bigblueball.gif',

262 -ALIGN => 'BOTTOM' }),

263 $Q->font({ -SIZE => '+3' },

264 $Q->b($Q->i(" Entry $del_name Deleted"))));

265 print $Q->p();

266 print $Q->p("The rolodex entry ``$del_name'' has been deleted.");

267 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

268 -ALIGN => 'BOTTOM' }), " ",

269 $Q->a({ -HREF => $Q->script_name },

270 "Go back to the list of entries"));

271 print $Q->end_html;

272 }

273 else

274 {

275 print $Q->header;

276 print $Q->start_html(-title => "Rolodex - Select Name to Delete");

277 print $Q->p($Q->img({ -SRC => '/~rjray/g/bigblueball.gif',

278 -ALIGN => 'BOTTOM' }),

279 $Q->font({ -SIZE => '+3' },

280 $Q->b($Q->i(" Select a name to delete:"))));

281 print $Q->p();

282 print $Q->startform('POST', $Q->script_name);

283 my @boxes = $Q->radio_group(-name => 'del_name',

284 -values => [sort keys %rolo_hash],

285 -default => '-',

286 -nolabels => 1);

287 print $Q->table({ -BORDER => 0, -CELLPADDING => 3 },

288 (map {

289 $Q->TR($Q->td(shift(@boxes)),

290 $Q->td($_))

291 } (sort keys %rolo_hash)));

292 print $Q->br;

293 print $Q->submit(-name => 'delete', -value => 'Delete');

294 print " the selected entry";

295 print $Q->p($Q->img({ -SRC => '/~rjray/g/bluediam.gif',

296 -ALIGN => 'BOTTOM' }), " ",

297 $Q->a({ -HREF => $Q->script_name },

298 "Go back to the list of entries"));

299 print $Q->end_html;

300 }

301 }

302 else

303 {

304 croak "DELETE: Name ``$del'' is not in the rolodex, stopped"

305 unless (exists $rolo_hash{$del});

306

307 delete $rolo_hash{$del};

308 print "Record ``$del'' has been deleted.\n";

309 }

310 }

311 else

312 {

313 if ($Detect::cgi)

314 {

315 my $Q = new NewCGI;

316

317 print $Q->header;

318 print $Q->start_html(-title => 'Rolodex');

319 print $Q->p($Q->img({ -SRC => '/~rjray/g/bigblueball.gif',

320 -ALIGN => 'BOTTOM' }),

321 $Q->font({ -SIZE => '+3' },

322 $Q->b($Q->i(" Welcome to WWW-Rolodex"))));

323 print $Q->p();

324 for (sort keys %rolo_hash)

325 {

326 ($name = $_) =~ s/ /+/go;

327 print $Q->img({ -SRC => '/~rjray/g/bluediam.gif',

328 -ALIGN => 'BOTTOM' }), " ";

329 print $Q->a({ -HREF => $Q->script_name . "?name=$name" },

330 $_);

331 print $Q->br;

332 }

333

334 print $Q->startform('POST', $Q->script_name);

335 print $Q->submit(-name => 'add', -value => 'Add a new entry');

336 print " ";

337 print $Q->submit(-name => 'delete', -value => 'Delete an entry');

338 print $Q->endform;

339 print $Q->end_html;

340 }

341 else

342 {

343 for (sort keys %rolo_hash)

344 {

345 print "$_\n";

346 }

347 }

348 }

349

350 untie %rolo_hash;

351

352 exit;

This is clearly a more serious script! For starters, there is no longer the pretext of only reading in the CGI support if so needed. The CGI (and NewCGI) modules are very lightweight until used. No great amount of code is compiled initially, so there is very little added to the start-up time. Also, testing this showed that referring to the CGI::Carp library within an eval interfered with some of the sanity checks that it performs. Instead, errors are handled natively, which also allows for the addition of a link to let the user return to the full list.

Rather than slowly going over each changed line (since there are so many), the explanation will just address blocks. The reader is encouraged to examine the blocks more closely, to help in understanding.

The block that displays a record is now redesigned to make the output somewhat nicer. The technique used here will be repeated in later blocks. A table with no border is used to manage the spacing of lines and elements. By doing this, it is possible to create effects such as having the field labels all right-justified while having the field values left-justified. Whatever the width of the browser window or length of the data, these will persist. A few graphics are dropped in to add a splash of color. However, these will not slow the display of text, since the NewCGI version of the img method provides height and width information. This allows a browser to render the text before it finishes loading the image.

The adding of a new record is still handled in two steps, a self-referencing process. Again, a few graphics are thrown in for color. As before, a "transparent" table is used to force the alignment of the screen elements.

In this case, all the form entry elements are aligned with each other. If so desired, the submit and reset buttons could be better aligned using a second table. A common approach is to put the left-most button in a cell that is left-aligned, and the right-most in a right-aligned cell. The visual effect is that the buttons are on the opposite edges, regardless of the broswer width.

pdg2401.gif

Figure 24.1

Rolodex version 1

The delete block has now undergone a major revision from the previous incarnation. Since previously it was assumed that the name to be removed would already be in the parameter list, little was changed over the non-Web version. In this newer case, the user is offered a nicer interface.

In the absence of the name to delete (denoted as del_name), a form is presented with all the current rolodex names in alphabetical order. Each has a radiobutton beside the name. The user can select which name to delete and press the Delete button. This submit button is named delete, which means that the next iteration of the script will still detect a value for the parameter "delete" in the form data. The selected name will be in the parameter del_name. Note that a table is once again used. If the call to the CGI method radio_group (line 283) were to provide the labels itself, there would be no visible space between the button and the name. By saving the returned list from radio_group and using those elements in a table, the more professional layout is achieved.

pdg2402.gif

Figure 24.2

Form with Rolodex Names

Lastly, the main loop, which displays the names in the rolodex, allowing the user to select one for display. This page is not changed as much, the layout of names-as-links is the same as it was. But graphical "dots" (or diamonds, in this case) are added in for splash, and at the bottom are two submit-style buttons, one to add a new record and the other to delete a record. These are given names of add and delete, and thus if either is pressed, the tests for non-null values in either of these parameters will succeed, taking the correct action. Where the command-line version relied on "-add" and "-delete", this is the best approach for the CGI context.

pdg2403.gif

Figure 24.3

Display of Rolodex Names

Conclusions

Migrating command line scripts to CGI is not impossible, and does not always have to be difficult. Though the concepts of application design are beyond the scope of this chapter, designing your scripts with the intent to operate in both arenas can help a great deal. The problem is, many people are faced with legacy code that was designed and developed before there was a World-Wide Web. There may be cases where it is more cost efficient to simply rewrite the application than try to convert it.

When designing for both arenas, try to isolate the input-driven sections, so that the different techniques do not get in each other's way. Output is not as strictly segregated, but taking the effort to use the full capacity of HTML on the Web side of the application may be worth the time.

In these examples, some things were glossed over in order to keep the code readable to newer Perl programmers. There are a lot of things that could be added to this application to make it into a truly useful inter-office (or personal) tool: options to edit existing records, better handling of graphics by the NewCGI class, better handling of non-command-line contexts in Options::Common, just to name a few. Hopefully, the basic code can provide a starting point for experimentation and exploration.

Orders Orders Backward Forward
Comments Comments

COMPUTING MCGRAW-HILL | Beta Books | Contact Us | Order Information | Online Catalog


HTML conversions by Mega Space.

This page updated on October 14, 1997 by Webmaster.

Computing McGraw-Hill is an imprint of the McGraw-Hill Professional Book Group.

Copyright ©1997 The McGraw-Hill Companies, Inc. All Rights Reserved.
Any use is subject to the rules stated in the Terms of Use.