Chapter 2
<HTML>
<HEAD>
<TITLE>Example start page</TITLE>
</HEAD>
<BODY>
<FORM METHOD=POST ACTION="wrapper.cgi">
Enter up to 20 characters, no spaces:
<INPUT TYPE=TEXT NAME="sometext">
<INPUT TYPE="submit" VALUE="Submit"><br>
</FORM>
</BODY>
</HTML>
#!/usr/local/bin/perl
# wrapper.cgi
# Generate a response to a form submission.
#
use CGI;
# Get the parameter passed into the script
#
my $query = new CGI;
my $text = $query->param('sometext');
print <<EndHeadSection;
Content-type: text/html;
<HTML>
<HEAD>
<TITLE>An example of a wrapper script</TITLE>
</HEAD>
<BODY>
EndHeadSection
# Do some basic range checking
#
if ((length($text) > 20) | ($text =~ / /)) {
print "<H2>20 chars max with no spaces, please...</H2>";
} else {
# The makeimage.cgi script creates the GIF image
print "<H2>Here's your text as a GIF:</H2>";
print "<IMG SRC=\"makeimage.cgi?text=$text\">";
print "<BR>";
}
# Note that the action string in the form tag refers to this very script
#
print <<EndBodySection;
<FORM METHOD=POST ACTION="wrapper.cgi">
Enter up to 20 characters, no spaces:
<INPUT TYPE=TEXT NAME="sometext">
<INPUT TYPE="submit" VALUE="Submit"><br>
</FORM>
</BODY>
</HTML>
EndBodySection
#!/usr/local/bin/perl
# makeimage.cgi
# Generate an image given a string.
#
use strict;
use CGI;
use GD;
my $query = new CGI;
# Get the parameter and its length
my $text = $query->param('text');
my $length = length($text);
# Each character is 9 pixels wide and 15 pixels high
my $image = new GD::Image(9*$length,15);
$image->colorAllocate(0, 0, 0); # allocate a black background
my $yellow=$image->colorAllocate(255, 255, 0); # the text color
# Draw the string on the image
$image->string(gdGiantFont, 0, 0, $text, $yellow);
# Let the CGI module print the content-type header
print $query->header('image/gif');
# Write the image to STDOUT as a GIF
binmode(STDOUT);
print $image->gif();
#!/usr/local/bin/perl -w
# ListImgInfo.pl
# This script will print a list of the attributes of all of the images
# in the document given as a parameter on the command line.
#
use HTML::LinkExtor;
use Image::Magick;
use strict;
my $filename = $ARGV[0];
my @rates = ( 14.4, 28.8, 33.3, 56.0, 1000);
my %totaltime = ();
foreach (@rates) {
$totaltime{$_} = 0;
}
# The LinkExtor (link extractor) module takes a callback routine as
# an argument; this routine is called for each link tag that the
# parse_file method recognizes.
#
my $p = HTML::LinkExtor->new(\&getImgSize);
if ($filename) {
print "..........................................................";
print "Information for images in the file $filename";
print "..........................................................";
# The parse_file function finds all of the links within a document.
#
$p->parse_file($filename);
print "Total estimated time to download all images in this document:\n";
foreach (@rates) {
print " $_ Kbps : ". ( sprintf "%.2f", $totaltime{$_}) ." seconds\n";
}
print "..........................................................\n";
} else {
print "You must specify a filename.\n\r";
}
# This routine defines our callback action.
#
sub getImgSize {
# Each time the callback is invoked, it is sent the tag name and a hash of
# arguments. In this case we are looking for 'img' tags, and the hash will
# contain the attributes of the image (src, alt, etc.).
#
my($tag, %links) = @_;
return if $tag ne 'img'; # Ignore other types of links
my $info = Image::Magick->Ping($links{'src'});
if ($info) {
# Ping() returns the info as a comma-delimited string
#
my ($width, $height, $filesize, $format) = split /,/, $info;
# People are used to seeing the filesize in Kbytes
#
$filesize = $filesize / 1000;
print "$format Image: $links{'src'} ($filesize K)";
print " WIDTH = $width HEIGHT = $height\n";
print " Estimated download times:\n";
downloadTimes($filesize); # print a section with estimated
# download times for this image
print "\n";
} else {
# In this case, the image is of a type not recognized by the
# ImageMagick library (could be an esoteric format, in which case
# most browsers couldn't view it, or an external library may not be
# installed).
#
print "Unrecognized image format: $links{'src'}\n";
}
}
sub downloadTimes {
my $size = $_[0];
foreach my $rate (@rates) {
my $time = $size * 8 / $rate; # size in Kb, rate in Kbit
print " $rate Kbps : ". ( sprintf "%.2f", $time) ." seconds\n";
$totaltime{$rate} += $time;
}
}
#!/usr/local/bin/perl -w
# AddImgInfo.pl
# This script will try to add width and height information to the
# img tags in the document given as a parameter on the command line.
# It will output the modified web page to a file called modified.filename.
use HTML::TreeBuilder;
use Image::Magick;
use strict;
my $filename = $ARGV[0];
my $p = HTML::TreeBuilder->new;
if ($filename) {
my $html = $p->parse_file($filename);
open OUTFILE, ">modified.$filename";
$html->traverse(\&analyzeHtml);
close OUTFILE;
} else {
print "You must specify a filename.\n";
}
# This routine defines our callback action.
#
sub analyzeHtml {
my ($node, $startbool, $depth) = @_;
if (ref $node) {
# In this case, the node is some sort of markup tag; use the startbool
# flag to determine if it is a start tag or end tag
#
if ($startbool) {
if ($node->tag eq 'img') {
# In this case we have an image tag on our hands.
# Use the Ping() method to find the information
# and add it to the end of the attribute string...
#
my $info = Image::Magick->Ping($node->attr('src'));
if ($info) {
# Ping() returns the info as a comma-delimited string
#
my ($width, $height, $filesize, $format) = split /,/, $info;
$node->attr('width', $width);
$node->attr('height', $height);
#####
# Alternately, you can use...
# use Image::Size;
# my $filename = "someimage.png";
# Use the imgsize method to find the dimensions of the image
# my ($x, $y) = imgsize($filename);
# The html_imgsize will return the geometry as a string
# ready to be included in an HTML tag...
# my $size = html_imgsize($filename); # returns the string
# "HEIGHT=y WIDTH=x"
}
}
print OUTFILE $node->starttag;
} else {
print OUTFILE $node->endtag;
}
} else {
# In this case the node is just text; print it as is.
#
print OUTFILE $node;
}
print OUTFILE "\n"; # add a new line
return 1; # continue analyzing the children of this node
}
#!/usr/bin/perl -w
# WebSafeColor.pl
# Returns the closest color in the 216 color web-safe palette.
#
use strict;
unless (@ARGV) {
print "Usage: perl WebSafeColor.pl r g b\n";
exit;
}
my ($red, $green, $blue) = @ARGV;
my (@returnlist, $max, $hex);
# Find closest value in the 6x6x6 "web-safe" color cube,
# algorithm described below.
#
foreach my $number ($red, $green, $blue) {
LOOP: for ($max = 25; $max < 281; $max += 51) {
if ($number <= $max) {
push @returnlist, ($max - 25);
$hex .= sprintf("%02X", $max - 25);
last LOOP;
}
}
}
print "In decimal: ", join(",", @returnlist), "\n";
print "In hex: #$hex\n";
exit;