ColorChooserExampleApp
MidLifeXis edited this page Dec 6, 2012
·
8 revisions
This example application by Dave Baker is online at http://benefitslink.com/cgi-bin/colors.cgi
(Errors formerly on this page, described at http://www.mail-archive.com/cgiapp@lists.erlbaum.net/msg06317.html, were corrected on 2-2-2008.)
Here's the instance script, named colors.cgi:
#!/usr/local/bin/perl
use lib '/www/cgi-bin/lib'; # Directory in which Colors.pm is stored
use Colors;
my $app = Colors->new( PARAMS => { 'version' => '2008.1' } );
$app->run();
(The name of the instance application is not important, but of course any URL in a web form that points to this application must use its correct name.)
Here's the application module, named Colors.pm:
package Colors;
# Purpose/operation:
#
# Displays an HTML web form using colors specified by the user
# for each of five attributes in the web form's "<body>"
# HTML tag: text, link, bgcolor, alink and vlink.
#
# The form asks the user to specify colors as RGB (red/green/blue)
# values: the first number is the level of a color's red component
# (0 to 255, inclusive), the second is the level of green, and
# the third is the level of blue.
#
# Upon submission of the form, this application converts each RGB
# color into its hexadecimal equivalent and supplies that hex value
# to a template that is used to programmatically create a revised
# web form. (The HTML specification requires that colors be expressed
# as hex values, not as RGB values.)
#
# The revised web form also prints the color values it is using,
# in hex format.
use strict;
use warnings;
use base 'CGI::Application';
# Using CGI::Carp with its fatalsToBrowser parameter
# displays compilation errors for the programmer.
# It also displays runtime errors. But if
# the error_mode method is called below,
# runtime errors are handled instead by a
# subroutine specified in the error_mode call.
#
# use CGI::Carp qw( fatalsToBrowser );
sub setup {
my $self = shift;
$self->start_mode('start');
$self->mode_param('rm');
$self->tmpl_path('/www/htdocs/templates/Colors'); # Directory in which
# specify_colors.tmpl
# template is stored.
$self->run_modes(
'start' => 'view_form',
'results' => 'convert_colors',
);
### $self->error_mode('report_error_during_debugging');
$self->error_mode('report_error_during_production');
my @rgb_components = qw( Red Green Blue );
$self->param('rgb_components', \@rgb_components);
my @attributes = qw( alink bgcolor link text vlink );
$self->param('attributes', \@attributes);
# Set default colors in hex format for each attribute.
my %default_hex_value = ( alink => '0000ff',
bgcolor => 'ffffff',
link => 'ff0000',
text => '000000',
vlink => '0000ff',
);
$self->param('default_hex_value_hashref', \%default_hex_value);
}
sub view_form {
my $self = shift;
my $hex_value_hashref = defined $self->param('hex_value_hashref')
? $self->param('hex_value_hashref')
: $self->param('default_hex_value_hashref');
my %hex_value = %{ $hex_value_hashref };
my $template = $self->load_tmpl( 'specify_colors.tmpl',
die_on_bad_params => 0,
cache => 0,
# global_vars => 1 tells HTML::Template to treat parameters
# sent to the template as global, so that an inner loop in the
# specify_colors.tmpl template can make use of a parameter used in
# an outer loop. HTML::Template in effect introduces a new
# scope in each loop, but global_vars => 1 cancels that.
global_vars => 1, );
$template->param( VERSION => $self->param('version') );
my $attributes_string = '';
foreach my $attribute ( keys %hex_value ) {
$attributes_string .= qq|$attribute="#|
. $hex_value{$attribute}
. q|" |;
}
$template->param( ATTRIBUTES_STRING => $attributes_string );
my @attributes_loop_for_template;
foreach my $attribute ( keys %hex_value ) {
my ( $red_value, $green_value, $blue_value )
= map {hex} unpack "a2a2a2", $hex_value{$attribute};
my @rgb_loop_for_template;
push( @rgb_loop_for_template,
{ COLOR => 'Red',
VALUE => $red_value
},
{ COLOR => 'Green',
VALUE => $green_value
},
{ COLOR => 'Blue',
VALUE => $blue_value
},
);
push( @attributes_loop_for_template,
{ ATTRIBUTE => $attribute,
RGB_LOOP => \@rgb_loop_for_template,
HEX_VALUE => $hex_value{$attribute},
} );
}
$template->param( ATTRIBUTES_LOOP => \@attributes_loop_for_template );
return $template->output;
}
sub convert_colors {
my $self = shift;
my $q = $self->query();
my %default_hex_value = %{ $self->param('default_hex_value_hashref') };
my %hex_value;
foreach my $attribute ( keys %default_hex_value ) {
# User has specified in the web form each attribute's RGB triplet
# (user enters the 0-255 value of the red, green and blue components for
# each attribute). The names of the form fields holding these values
# are a concatenation of the attribute's name and one of the strings
# 'Red', 'Green' or 'Blue' (e.g., bgcolorRed).
my @rgb_values_list;
foreach my $color ( 'Red', 'Green', 'Blue' ) {
my $value = $q->param("$attribute$color");
unless ($value =~ /^\d+$/ && $value >= 0 && $value < 256) { # Validation
$hex_value{$attribute} = $default_hex_value{$attribute};
}
push (@rgb_values_list, $value); # Values will be in RGB order;
# red value will be first element in
# array, then green, then blue.
}
# Calculate the hex format for the user-specified RGB combination
# for this attribute; store in hex_value hash to be saved as
# param available to other runmodes.
$hex_value{$attribute} = sprintf("%02x%02x%02x", @rgb_values_list);
}
# Revised hex value for each of the attributes is saved as a parameter
# so that the view_form subroutine can access it; that sub is called
# by this run_mode as its last statement, which means the output of the
# view_form subroutine is the return value (the output) of this
# run_mode.
$self->param('hex_value_hashref', \%hex_value);
return $self->view_form();
}
sub report_error_during_debugging {
my ( $self, $error ) = @_; # The sub specified by error_mode is sent
# the CGI::Application object and the value of @!
return '<h1>Runtime Error</h1>' . $error;
}
sub report_error_during_production {
my $self = shift; # error_mode sends in the the CGI::Application object
# and the value of @! but here we're ignoring @! because
# we won't display it during production.
my $html_to_user = qq|<h1>Unable to Process Your Request</h1> The
web server is unable to process your request due to a
programming error. You did not cause the problem. <p>We
apologize for this trouble.|;
return $html_to_user;
}
return 1;
Here are the templates used by the program:
header.tmpl:
<html>
<head>
<title>Demo of CGI::Application: a Color Chooser</title>
</head>
footer.tmpl:
</body>
</html>
specify_colors.tmpl:
<TMPL_INCLUDE NAME="header.tmpl">
<body <TMPL_VAR NAME=ATTRIBUTES_STRING> >
<h1>Color Demonstration for Attributes of the HTML Body Tag</h1>
<hr>
<i>Instructions:</i> Choose the color of any of the listed attributes of the
HTML "body" tag by setting its Red, Green and Blue values to a number between
0 and 255.
<p>
<ul>
<li>"link" sets the color of links you haven't followed
<li>"alink" sets the color of links as you click on them
<li>"vlink" sets the color of links you have followed
<li>"bgcolor" sets the background color of the web page
<li>"text" sets the color of text on the web page
</ul>
<p>Then click the button to see a modified version of this page that
uses your chosen RGB values.
<p>The modified version also will show the hexadecimal (hex)
equivalent of the RGB values. (The HTML in the page uses those hex
values rather than the RGB values, per the HTML specification; use
your browser's "View Source" command if you'd like to see how those
hex values are specified in the HTML body tag.)
<br>
<br>
<form method="post" action="colors.cgi">
<input type="hidden" name="rm" value="results">
<table width="50%" cellspacing="5">
<tr>
<th align="center">Attribute</th>
<th align="center">Red</th>
<th align="center">Green</th>
<th align="center">Blue</th>
<th align="center">Hex</th>
</tr>
<TMPL_LOOP NAME=ATTRIBUTES_LOOP>
<tr>
<td align="left"><TMPL_VAR NAME=ATTRIBUTE></td>
<TMPL_LOOP NAME=RGB_LOOP>
<td align="center"><input type="text"
name="<TMPL_VAR NAME=ATTRIBUTE><TMPL_VAR NAME=COLOR>"
value="<TMPL_VAR NAME=VALUE>" size="8"></td>
</TMPL_LOOP>
<td align="left"><tt><TMPL_VAR NAME=HEX_VALUE></tt></td>
</tr>
</TMPL_LOOP>
</table>
<br>
<a href="http://google.com/">This link to Google</a> illustrates the
colors being used for the link, vlink and alink attributes of the
HTML body tag.
<br>
<br>
<input type="submit" name="submit" value="View Results">
</form>
<TMPL_INCLUDE NAME="footer.tmpl">
I created the above application using an example from the Apache::ASP distribution, when I was considering that framework. If you were to implement the application in Apache::ASP (which embeds Perl into the HTML pages, like PHP), here's how you could do it:
-
The "start" page would be called colors.html, and would use this code:
<!--\#include file="header.html"--> <% my @colors = qw(Red Green Blue); my %defaults = ( bgcolor => 'ffffff', text => '000000', link => '0000ff', alink => 'ff0000', vlink => 'aa0000', ); my @attr_names = keys %defaults; if ($Request->Form('submit')) { $Response->Include('rgb2hex.html', \@attr_names, \@colors, \%defaults); } else { $Response->Include('form.html', \@attr_names, \@colors, \%defaults); } %> <!--#include file="footer.html"--> -
The header and footer files would look the same as the header and footer templates shown in the CGI::Application example application above, but they'd be called header.html and footer.html.
-
The table used to display the attributes and colors would be another html file, called form.html, with this code:
<% my ($attr_names, $colors, $hex) = @_; my @headings = ('Attribute', @$colors, 'Hex'); my ($attributes, %values); foreach my $attr_name (@$attr_names) { # Set up the body attributes. $attributes .= qq!$attr_name="#$hex->{$attr_name}" !; # Create the RGB chooser table elements. my @rgb = map {hex} unpack "a2a2a2", $hex->{$attr_name}; foreach my $index (0 .. 2) { $values{$attr_name . $colors->[$index]} = $rgb[$index]; } } %> <body <% =$attributes %>> <h3>Color Chooser</h3> Enter an RGB value (each between 0 and 255) for the attributes below, and press "<i>Try it!</i>" to see the results. <form method="post" action="colors.html"> <table width="30%"> <tr> <% foreach my $heading (@headings) { %> <th align="left"><% =$heading %></th> <% } %> </tr> <% foreach my $attr_name (@$attr_names) { %> <tr> <td align="left"><% =$attr_name %></td> <% foreach my $color (@$colors) { %> <td align="left"> <input type="text" name="<% =$attr_name . $color %>" value="<% =$values{$attr_name . $color} %>" size="8"> </td> <% } %> <td align="left"><%=$hex->{$attr_name} %></td> </tr> <% } %> </table> <input type="submit" name="submit" value="Try it!"> <input type="reset" value="Clear"> </form> <a href="http://google.com/">Here is a to Google.</a> -
Finally, another file would be used to process the user's requested changed colors, called rgb2hex.html, with this code:
<% my ($attr_names, $colors, $defaults) = @_; my %hex; foreach my $attr_name (@$attr_names) { my $flag = 0; foreach my $color (@$colors) { my $value = $Request->Form("$attr_name$color"); $flag++ unless ($value =~ /^\d+$/ and $value >= 0 and $value < 256); } if ($flag) { # user supplied an unacceptable value $hex{$attr_name} = $defaults->{$attr_name}; } else { my @rgb; foreach my $color (@$colors) { push (@rgb, $Request->Form("$attr_name$color")); } $hex{$attr_name} = sprintf("%02x%02x%02x", @rgb); } } $Response->Include('form.html', $attr_names, $colors, \%hex); %>
Note how a PHP-style web application is harder to deal with in many ways. The code is spread among several files. The HTML is mixed with the code (in form.html), so when you want to change the layout of your table or make other HTML presentation changes you'll need to dig through a complicated file that has code interspersed with the HTML you want to change.
See also:
Originally transferred from http://cgi-app.org/index.cgi?ColorChooserExampleApp