# Perl

(Practical Extraction and Report Language)

### Also…CGI and Apache



# is a comment

#!/usr/bin/perl -w (first line also called the "shbang" line) indicates that this is a perl program and not a shell program.
The -w switch produces warnings for potentially dangerous constructs when developing.
It is the same as having use warnings; in your program.  For a complete list
of switches, which can be used at command line, please visit:
http://blob.perl.org/books/beginning-perl/3145_Chap09.pdf (p. 290).

print ("Hello, world!\n"); prints "Hello, world!" on a line and goes to next line.

NOTE: print qq(mystring); is print ("mystring");
qq puts double quotes around the string, which can get around having to "escape out"
double quotes, i.e., using the \ method. However, if you want to use an escape
character within the qq, you would have to use a different delimiter besides \.
Any non-alphanumeric character will do.

Here are some common escape codes:

$name = <STDIN>; gets a line from the terminal and assigns it to the scalar variable$name

chomp ($variablename); removes the newline \n from the end of the variable when obtained with <STDIN> print "Hello,$name!\n"; how to print a string containing the variable value

NOTE: Single-quoted strings differ from double-quoted strings in that they are not interpolated
(i.e., nothing is processed within single quotes). You can use special characters
without escaping them.  However, if I do  print '$name'; it will not print the value of the variable, but literally print$name.

Here's a "Here Document" (works like a double-quoted string):
print<<EOF;

blahblahblahblahblahblahblahblahblahblahblahblahblahblahblah
blahblahblahblahblahblahblahblahblahblahblahblahblahblahblahblah
blahblahblahblahblah

EOF

** exponential operator
% modulo
<=> returns 0 if equal, -1 if right hand side greater, 1 if left-hand side is greater.
x repetition operator;
print "RAH! "x3; would yield RAH! RAH! RAH!
ord("#") gives the ASCII value for the character #

Want to pause a program for 2 seconds?  sleep 2;

Conditional Statements & Loops [<<rewind]

Here's an if-then example:

my ($a,$b);
$b = 10; if (defined$a) { # checks to see if $a has a value assigned to it. print "\$a has a value.\n";
}
if (defined $b) { # checks to see if$b has a value assigned to it.
print "\$b has a value.\n"; } if ($name eq "Jamie") { eq is equals for strings
# some action here
} elsif ($name eq "James") { # some action here } else { # some action here } an if else-if else statement Use conditional operators like ||, !, && similar to JavaScript. You can also use and as well as or, which are the same as && and ||, respectively. Note that the "and" logical operators are of higher precedence than the "or" operators, though the symbols are higher precedence logical operators than the words. Note: There is a conditional test similar to if conditions, which is called unless. Basically, unless condition is similar to if not condition. unless can be used for looping, too. while ($var1 ne $var2) { ne is not equals for strings # actions } a while loop Note: You see eq and ne above for use with strings. For greater than, you would use gt. For greater than or equal to, you would use ge. For less than, use lt and for less than or equal to, use le. For numbers, the syntax is different than for strings, but it is identical to JavaScript syntax (except for the$variable format).

Final items related to  loops:

do { <actions> } while (<condition>)

last in the loop body will end the program or break out of the loop. You can set it up also conditionally:
last if $_ eq "QUIT"; next in a loop will go to the next iteration of the loop. redo will allow you to go back to the top of the loop without testing the current condition. You can label loops and use the label to skip parts of a loop if a certain condition is met: OUTER: while (...) { ... INNER: for ... { .... last OUTER if <condition>; } ... } Avoid multiple if-elsif-elsif-...-else using something similar to case statements: my$choice=<STDIN>;
for ($choice) {$_ == 1 && some action;
$_ == 2 && some action;$_ == 3 && some action;
$_ == 4 && some action;$_ == 5 && some action;
...
}

You can see a good use of case statements in the Param Section.

Arrays & Loops [<<rewind]

While not an array in the traditional sense, one can consider the following use of print
like an array:

print (
);

The [2] points to the 3rd element (Remember: starts at 0) in the list passed to the print function: knees.
Note: we could have just left out the double quotes and sent the list with the element index.
Here's the output:

Get on your knees and pray!

Now onto what we usually consider when thinking of arrays:

@presidents = ("Washington", "Madison", "Lincoln"); array with 3 elements

push(@presidents, "Washington"); Putting Washington into an empty presidents array.

push(@presidents, ("Washington", "Madison", "Lincoln")); Putting multiple persons into an empty presidents array.

my $first = shift(@presidents); Sets$first to Washington and *removes* Washington from the above array.

my $last = pop(@presidents); Sets$last to Lincoln and *removes* Lincoln from the above array.

push @presidents, "Eisenhower"; would put Eisenhower at the end of the list.
pop @presidents; would remove Eisehower - the last element - from the list.

push/pop work in a LILO fashion where push puts in a last element and pop takes out the last element.
unshift/shift work in a FIFO fashion where unshift puts in a first element and shift takes out the first element.

my $preslen = scalar(@presidents);$preslen is the number of elements in the array.
A shorthand way of doing this: my $preslen=@presidents; Since$preslen is scalar,
as designated by $it won't pull in the elements, but just count them. print$preslen; will print the number of elements in the array @presidents.
print scalar @presidents; is another way to print the number of elements in the array.
The Perl motto holds true: "There's more than one way to do it."

$presidents[0] is Washington and shows how to reference elements of the above array$presidents[$preslen-1] OR$presidents[$#presidents] Gives the last element of the array. my @presidents = ("Washington","Madison","Lincoln"); foreach my$i (@presidents) {
print "$i\n"; } #a foreach loop which will print the contents of the array. Here's a shorthand version of the above: foreach (@presidents) { print "$_\n"; # $_ is the current array element, an implicit part Perl, needs no declaration. } Move to the next iteration in a foreach loop using next; Break out of a foreach loop using last; but note that by default, this only affects the loop where it occurs when considering nested loops. If you add labels such as MYLOOP: foreach … you can break the specific loop using last MYLOOP; my @presidents = ("Washington", "Madison", "Lincoln"); foreach my$i (0..$#presidents) { print "President$i is $presidents[$i]\n";
} #Notice the use of the range in the foreach loop.

For loops have syntax like JavaScript or Java, except for the $variable format. If you need to change the iterator, make a local copy: foreach (1, 2, 3) { my$i = $_;$i++;
}

my @slice = @presidents[0..1]; sets @slice to ("Washington", "Madison").
NOTE: The .. signifies a range.  Another convention is to use discrete elements.

You can print slices based on discrete elements as follows:

print (@presidents[0,1]);

my @found = grep(/Regex for pattern you want/,@presidents); Search an array
For example: my @found = grep(/on/,@presidents); will return Washington and Madison, but not Lincoln.
For an exact match, use /^string$/ since ^ marks the beginning of the string and$ marks the end.

my @ABCpresidents = sort(@presidents); @ABCpresidents is an alphabetically sorted @presidents array.
my @backwdpresidents = reverse(@presidents); Reverse the order of the array and save it into @backwdpresidents.
Combine these with  @presidents = reverse(sort(@presidents));
NOTE: In the above line, I rewrite the original array since I store the reverse/sort in @presidents.

If you are doing this with numbers, be careful to note that a first-character comparison
would put 10 before 3, etc. So you have to do this:
my @numbers = (7, 2, 6, 16, 5, 8, 14);
my @orderednumbers = sort( {$a <=>$b;} @numbers);
Double them:  for (@array) { $_ *= 2 } Merge the @presidents array into a single string (with each element separated by a comma and a space) like this: my$prezstring = join(", ",@presidents);
which will make $prezstring become "Washington, Madison, Lincoln". For many of these, you can substitute a list of values for an array. Look at the following examples: my$president = ("Washington", "Adams", "Jefferson")[1];
# $president is "Adams" my$prezstring = join(", ", ("Washington", "Adams", "Jefferson"));
# $prezstring is now "Washington, Adams, Jefferson" my ($first, $second,$third) = sort("Washington", "Adams", "Jefferson");
# $first is "Adams",$second is "Jefferson", $third is "Washington" @presidents = qw(Washington Madison Lincoln); array with 3 elements without needing to type commas and quotes Here is helpful information about stacks and queues: Stacks and Queues by Mark W. Naylor with comment editing by James A. Johnson #! /usr/bin/env perl use strict; use warnings; # Comments in the code and prints when run provide explanations. #Examples of stacks, Last In First Out data structures. my @leftStack = (); my @rightStack = (); print("Load the two stacks.\n"); for (my$i = 1; $i <= 15; ++$i) {
unshift(@leftStack, $i); push(@rightStack,$i);
}

print("@leftStack\n");
print("@rightStack\n\n");

print("Get the last 3 values from the \"right-hand\" stack.\n");
print(pop(@rightStack) . "\n");
print(pop(@rightStack) . "\n");
print(pop(@rightStack) . "\n");

print("Get the last 3 values from the \"left-hand\" stack.\n");
print(shift(@leftStack) . "\n");
print(shift(@leftStack) . "\n");
print(shift(@leftStack) . "\n");

print("\nState of the stacks after popping\n");
print("@leftStack\n");
print("@rightStack\n\n");

# As demonstrated, either the push/pop or the unshift/shift pairs can be used to
# implement stacks in Perl.  Personally, I would stick with the push/pop way,
# since these are the terms traditionally used with stacks.  It even holds for
# the stack-based language Forth and in assembly language programming where
# return addresses and actual parameters are pushed prior to jumping to the
# address of the function code.

#Examples a queue, First In First Out data structure.
print("-" x 30 . "\n\n");

my @queue = ();
for (my $i = 5;$i <= 100; $i += 5) { push(@queue,$i);
}
print("@queue\n");

print("\nGet the first 3 entries of the queue.\n");
print(shift(@queue) . "\n");
print(shift(@queue) . "\n");
print(shift(@queue) . "\n");

print("\nNew state of the queue.\n");
print("@queue\n");

# I could have loaded the queue by unshift and taking elment by pop, but then the
# line would have formed formed "backwards" with the end at the left and the
# beginning at the right.  The method I used has the natural left-to-right order
# when the whole list is printed.  Maybe if I was Hebrew or Arabic, I would have
# chosen the other method :-)

# Stacks tend to get more attention than queues in Comp Sci.  Perhaps it is
# because stacks go hand-in-hand with recursion.  Look up "depth first
# search/traversal" in relation to tree (often binary tree) traversal.  Queues
# are excellent for doing a "breadth first search/traversal".  Maybe this is not
# addressed as much because you can do breadth first via looping constructs,
# which aren't as sexy/cool as recursion.

The output looks like this:

15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Get the last 3 values from the "right-hand" stack.
15
14
13
Get the last 3 values from the "left-hand" stack.
15
14
13

State of the stacks after popping
12 11 10 9 8 7 6 5 4 3 2 1
1 2 3 4 5 6 7 8 9 10 11 12

------------------------------

5 10 15 20 25 30 35 40 45 50 55 60 65 70 75 80 85 90 95 100

Get the first 3 entries of the queue.
5
10
15

New state of the queue.
20 25 30 35 40 45 50 55 60 65 70 75 80 85 90 95 100

Hashes & Loops [<<rewind]

You can develop a hash from an array:

@array = qw (Redskins NFL Capitals NHL Orioles MLB);
%teams = @array;
This gives you the following hash:
Redskins NFL
Capitals NHL
Orioles  MLB

Say you have a hash called  %batters arranged as such ($name =>$average):

"Jamie Johnson" => 416
Casey => 800
.
.
.

What do you do if a user inputs to read from the hash and inputs an average or batter not in the hash?

if (not exists $batters{$name} {
die "I don't know anything about $name as a batter.\n"; } if (not exists$batters{$average} { die "I don't have a batter with$average as a batting average.\n";
}

Here's another example:

%heroes = qw(
ObiWan     Ben_Kenobi
Superman     Clark_Kent
Batman     Bruce_Wayne
Spiderman     Peter_Parker
); This is a hash where each item in the first column corresponds to one item in the second column.

Or it could be done this way:
my %heroes = ( "ObiWan", "Ben Kenobi",
"Superman",       "Clark Kent",
"Batman",         "Bruce Wayne",
"Spiderman",      "Peter Parker");

Or it could be done this way:
my %heroes = ( ObiWan => "Ben Kenobi",
Superman       => "Clark Kent",
Batman         => "Bruce Wayne",
Spiderman      => "Peter Parker");

In the above, the first column consists of keys while the second column consists of values.

$secret_identity =$heroes{$name}; # get the secret identity of the hero Use curly brackets, not parentheses. So, if$name is "Batman", then $heroes{$name}
is the value associated with that key, which is  "Bruce Wayne" or you could reference it
directly with $heroes{'Batman'} or$heroes{Batman} if there are no special characters.

foreach my $hero (keys %heroes) { print "$heroes{$hero}=$hero\n";
} #prints out all the values, but in random order.

foreach my $hero ("Obi Wan Kenobi","Superman","Batman","Spiderman") { print "$heroes{$hero}=$hero\n";
} #print out the hash in exact order.

To add a new hero to a hash, do the following:
$heroes{Tankman} = "Napoleon Dynamite"; heroes is the hash name, Tankman is the new key, and Napoleon Dynamite is the new value. if (exists$heroes{Ironman}) {
print "Ironman is in the hash.<br />\n";
} else {
$heroes{Ironman} = "Tony Edward Stark"; } Looks for Ironman in the heroes hash and if not there, it adds him. Say the Ironman key is in the hash, you can delete him like this: delete$heroes{Ironman};
or you could kill off all the heroes with a swift %heroes = ();

my @keyslice = keys %heroes; a list in random order of the heroes' keys (Batman, et. al.).
my @valueslice = values %heroes; a list in random order of the heroes' values (Bruce Wayne, et. al.).

Are there any heroes? scalar ($heroes); yields a true or false depending on if there are any pairs. How many heroes? scalar(keys(%heroes)); References [<<rewind] A reference points to where data is located in memory. To create a reference for a variable, just put \ in front of the variable like this: \$name or \@presidents or \%heroes.
References can be treated like scalar variables but cannot be hash keys. Using references is what
allows you to do things such as store arrays in an array (a matrix) or hashes inside of hashes.
CAREFUL: Arrays and references to those same arrays point at the same data. Now, let's look at
an example:

my @presidents = (\@eighteenthCentury, \@nineteenthCentury, \@twentiethCentury, \@twentyFirstCentury);

If you did this:  my $presidentsRef = ["Washington", "Madison", "Lincoln"]; using square brackets [] then you directly deal with a reference. For a hash, you would use the curly brackets {} instead of parentheses to do likewise. Say you had this reference: my$presidentsRef = \@presidents; and you wanted to dereference it.
Do so using the curly brackets: my @prezArray = { $presidentsRef }; If you have this:${$presidentsRef}, you can use this instead:$presidentsRef->

To finally remove a reference: undef $presidentsRef; Matrices If you want to get as complex as matrix, this is a good way to do it:$array[$row]->[$column]

↓Row
0→012
1→012
2→012

To get the element referenced by 1, you would use this: $arrayname[1]->[1] That is, the row 1, column 1. Now say that each element represented a car. You could populate it like this: #!/usr/bin/perl use warnings; use strict; my @carlot; # my array for (0..2) {$carlot[0]->[$_] = "Honda "; # 3 Hondas in Row 0$carlot[1]->[$_] = "Chevy "; # 3 Chevies in Row 1$carlot[2]->[$_] = "Dodge "; # 3 Dodges in Row 2 } Roughly, your data could be conceptualized like this: ↓Row 0→HondaHondaHonda 1→ChevyChevyChevy 2→DodgeDodgeDodge You could then add the following to print it out: for my$i (0..2) { # Rows 0 to 2
for my $j (0..2) { # Columns 0 to 2 print$carlot[$1]->[$j];
}
print "\n"; # New line at end of row
}

And here's the output:
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge

More discussion about references appears here.

Regular Expressions (regex) [<<rewind]

Let's play some with regex (Regular Expressions)...

if ($name =~ /Batman/) { Action if the regex pattern 'Batman' is found. } Or a simpler example:$_ = "I'm Batman.";
if (/Batman/) { actions }

Not equals for regex is as follows: !~ as in if ($name !~ /Batman/) { actions } if ($name =~ /^Bat/) { regex used with the slashes
# Bat is at the begining of the string using the ^ anchor
}

/^bat\b/i bat is at the beginning of the string with a boundary (meaning no letter or digit following
as denoted by b in the regex) irregardless of case (i)

if ($name =~ /$man/) {
# man is at the end of the string using the $anchor }$name =~ s/\W.*//; s followed by regex (substitute) followed by make the contents of $name find the first nonword character (\W) and erase from there to the end like wildcard (.*) and then slashes for regex. This kills all after first word.$name =~ tr/A-Z/a-z/; transliterate A to Z to a to z; i.e., make all lower-case
The above uses transliteration, which follows tr/what to change/what to change it to/;

If you are just wanting to return the upper-case or lower-case use uc or lc, respectively.
For example:
my $stuff = "STOP SCREAMING!"; my$otherstuff = "get tough!";
print (lc $stuff); # NOTE: lc is the lower-case of LC print "\n"; print (uc$otherstuff);

This will print the following:
stop screaming!
GET TOUGH!

You will have to escape out (\) the following
characters if you want to use them literally
since they have meaning in regex:
. * ? + [ ] ( ) { } ^ $| \ - Or you can use \Q to turn off special meanings, rendering the above as their literal selves. \E or the end of the regex will turn off \Q. For example: if (/\Q$mystring\/E) { actions }

if /\.$/ match a full stop, then the end of the string using the$ anchor.

if /B[aeiou]tman/ looks for Batman, Betman, Bitman, Botman, or Butman.

if /B[^eiou]tman/ looks for B followed by anything except e, i, o, or u then tman.

You can also do a range in the above using numbers [0-9] or letters [a-z]
and you can have multiple brackets within a regex.

| is or.  For example: /Badman|Batman/ searches for Badman or Batman or you could do it this way:
/Ba(d|t)man/ And you can use ranges and other regex within this method.

Qualifiers:
/Bat?man/ matches Baman or Batman. The t may or may not be in it (0 or 1).
/Bat+man/ matches Batman, Battman, Batttman, … The t is in it 1 or more times.
/Bat*man/ matches Baman, Batman, Battman, Batttman, … The t is in it 0 or more times.

/o{x,y}/ looks for o repeated at least x times in a row, but no more than y times in a row.
/o{2}/ looks for 2 o's in a row.

Let's walk through this regex condition:

if($myvalue=~/^[a-z|A-Z|'|"|~||\.|,|\-| |\*]+$/) { ... }

For the condition to be true, the variable $myvalue must match the regex expresion (=~/.../) from beginning (^) to have any of these characters ([...]): lower-case a to z (a-z) or (|) capitalized A to Z (A-Z) or a single quote (') or a double-quote (") or a tilde (~) or a left single quote () or a literal (escaped \) period (.) or a comma (,) or a literal (escaped \) hyphen (-) or a space ( ) or a literal (escaped \) asterisk (*) and there will be 1 or more (+) of these characters to the end stop per the expression ($/)

Backreference Variables keep track of what is found given a regex pattern.
Say you have the following:

$_ = 'When in the course of human events, it becomes necessary to dissolve a political band.'; When you run a regex pattern in parentheses against it, the$1 backreference variable
will equal what stores the result of the first regex pattern, the $2 backreference variable will equal what stores the result of the second regex pattern, and so on. Say you have the following program: #!/usr/bin/perl/ # Regex.pl$_ = 'When in the course of human events, it becomes necessary to dissolve a political band.';
print "Enter a regular expression: ";
my $pattern = <STDIN>; chomp ($pattern);
if (/$pattern/) { print "The text matches the pattern '$pattern'.\n";
print "\$1 is '$1'\n" if defined $1; print "\$2 is '$2'\n" if defined$2;
print "\$3 is '$3'\n" if defined $3; } else { print "'$pattern' was not found.\n";
}

Then say you run the following iterations of it:
>c:\perl\bin\perl Regex.pl
Enter a regular expression: ([a-z]+)
The text matches the pattern ’([a-z]+)’.
$1 is ’hen’ Why not When? Because you only regexed for one or more lower-case letter(s). Where's W? Try this: >c:\perl\bin\perl Regex.pl Enter a regular expression: ([A-Z])([a-z]+) The text matches the pattern ’([A-Z])([a-z]+)’.$1 is ’W’
$2 is ’hen’ The two sets of parentheses set what$1 and $2 are. You searched for one upper-case letter and then searched for one or more lower-case letter(s). Let's see if we can search and get When as the result for$1:

>c:\perl\bin\perl Regex.pl
Enter a regular expression: ([A-Z|a-z]*)
The text matches the pattern ’([A-Z|a-z]*)’.
$1 is ’When’ And yes, you could have used ([A-Z|a-z]+) instead in this prior example. In the example you searched for 0 or more upper-case or lower-case letters. If you used + instead of *, you would have searched for 1 or more of such a pattern. Let's go for it all now: >c:\perl\bin\perl Regex.pl Enter a regular expression: ([A-Z|a-z|\W]+) The text matches the pattern ’([A-Z|a-z|\W]+)’.$1 is ’When in the course of human events, it becomes necessary to dissolve a
political band.’

You searched for the same as the above example, but this time also had
"or non-word characters" as designated by \W. And that pretty much
captures it all.

Let's do one more and utilize $1 through$3:

>c:\perl\bin\perl Regex.pl
Enter a regular expression: (\bn[a-z]+)(\Wto?)(\Wdis{2}[a-z]*)
The text matches the pattern ’(\bn[a-z]+)(\Wto?)(\Wdis{2}[a-z]*)’.
$1 is ’necessary’$2 is ’to’
$3 is ’dissolve’ This example is not an efficient use of regex, but plays with it to show functionality. I searched for a boundary between a non-word and word character followed by n with one or more lower-case letter(s), giving a value to$1. Then, I searched for a non-word
value followed by the letter t and 0 or 1 o, giving a value to $2. Finally, I searched for a non-word character followed by di, 2 s characters, and 0 or more lower-case letters. Look at this example, which uses backreference variables and Regex: #!/usr/bin/perl # MyNumbers.pl by Jamie Johnson # This finds 2 numbers between and including 1 and 9 # and sets the first as$first and second as $second else it returns 99. # If the first number is within range and the second is not, # then the second gets the value of the first. # Finally, it prints out the results for each array element. use warnings; use strict; my$first = "99";
my $second = "99"; my$element = -1;
my @myNumbers = (
"Your Momma don't dance and your daddy don't rock and roll",
"1-6",
"3",
"2 or 6",
"3or6",
"4 to 6",
"5to6",
"6 - 6",
"Howdy7 to 9",
"8 to 6 to 9",
"23",
"1 or 23",
"23 or 1",
"0",
"-1",
"867-5309",
"1-800-CALL-STEVE",
"4 -9",
"5--7"
);

foreach my $i (@myNumbers) {$element++;
print "Element $element ($i):  ";
$_ =$i;
if (m/^(\d+)$/) { # Only one number if ($1>=1&&$1<10) {$first = $1;$second = $1; } else {$first=$second="99"; } } elsif (m/(\d+)(\D+)(\d+)/) { # first numeric, non-numeric, numeric if ($1>=1&&$1<10) {$first = $1; if ($3>=1&&$3<10) {$second = $3; } else {$second = $first; } } } else {$first = "99"; $second = "99"; } print "first:$first    second: $second\n"; } Modifiers allow one to treat strings in certain ways. Some have already been demonstrated. Here are some modifiers: Modifier What it does /i ignore case /g apply globally substitution OR apply in multiple matches where \G anchors the beginning of the regex /m treat as multiple lines /s treat as a single lines /x "breaks down" complex regex so that whitespace and comments are allowed in formulating the regex Split and Join split - just think of this as you would in JavaScript as applied to a string, but with a regex flavor, and think of join as applied to an array: my$quote = "Oh:my:horses";
my @words = split /:/, $quote; print "$words[0] $words[1]$words[2]";
my $requote = join " ", @words; #join it together with spaces between the words print$requote;

(?# This is an inline comment which is ignored within regex)

(?i) Ignores case when within a regex pattern, e.g.,  /(?i)Biblical/
This matches Biblical or biblical.
/One nation under ((?-i)God)/ only matches God with a capital G.
You can do this with other modifiers above.

(?:some expression) groups only instead of putting it into a backreference variable

/Dark(?= Knight)/ This optimizes regex matching in that
it only considers the word Dark if the next word is Knight.

/Dark(?! Knight)/ This only considers the word Dark if the
next word is NOT Knight.

/(?<=Dark )Knight/ This only considers the word Knight if
the word before it is Dark.

/(?<!Dark )Knight/ This only considers the word Knight if
the word before it is NOT Dark.

Here are some helpful shortcuts and references from http://blob.perl.org/books/beginning-perl/3145_Chap05.pdf:

Example of more Regex (Regular Expression) use

Additional use of regex is seen in the next section below.

Routines, etc. (more arrays, input, routines, etc.)  [<<rewind]

Let's play some arrays, input, and routines...

sub subroutine_name {
my($somehero,$someID) = @_; # name the parameters which are passed into @_
#stuff here
} A subroutine, similar to a Java method or a JavaScript function where the my() defines the
parameters with a block scope and for this subroutine, they are placed in the array @_. You can
also use return statements similar to what you do in JavaScript or Java. One convention is to
prefix the subroutine with the & sign. However, it is worth mentioning that in the world of Perl,
a function is usually something built into the programming language while a subroutine is defined
by the programmer. Call a subroutine, like this:
subroutine_name(myhero, myheroID);

You can also specify the amount and type of data to be passed.  In the example subroutine
below, 2 scalars are passed to the subroutine, each represented by $. sub calculator($$) { … } Conventionally, the subroutine calls from the main section of the program are placed at the top of the code and then the subroutines themselves follow. You can pass a single array to a subroutine, but there are special considerations if you are passing multiple parameters. For an array called myarray and a hash called <ôt>myhash, you would do as follows: subroutine_name(\@myarray, \%myhash); # Note the use of references and then you would structure the subroutine as such: sub subroutine_name { my($myarrayref, $myhashref) = @_; } Notice that within the subroutine, the "refs" are references to the array and hash, respectively, but realize that if you change a reference element, you are altering that element in the original array or hash. In the example above, to change a reference element, you would use the following for array and hash, respectively:$myarrayref->[1]
$myhashref->[1] If I wanted to dereference my array or hash in the subroutine, I could use the following respectively: my @derefarray = @{$myarrayref};
my @derefhash = %{$myhashref}; Since these would be localized to the subroutine, changing the values of @derefarray and @derefhash will not change the values in the original array and hash, respectively. Find more information about references here. Now back to our hero example: What if the empty string <IDLIST> is undefined? while ( defined ($hero = <IDLIST>) ) { takes care of this problem. You could also use die function to break the program as needed.

What is  $! for? It is a variable with a system error message. Perl Operator -M retruns how many days since file modification. You can set a program to mail you, too: open MAIL, "|mail email@server.com"; The pipe symbol opens a command line. print MAIL "Some message and you can put$variables in it, also.\n\nSincerely, \nYour Perl Mail Porgram";
close MAIL;

Here's a simple and fun little program I wrote in PERL:

#!/usr/bin/perl
init_arrays();
$arraysize = 15;$quitter = false;
print "\n\nWhat hero or villain are you? ";
$heroname = <STDIN>; chomp$heroname;
if ($heroname=~ /^beacon deacon\b/i) { print "Hello, Jamie!\n"; } else { print "Hello,$heroname!\n";
}
$arrayindex = 0;$found = 0;
while ($found eq 0) {$findheroname = $heroname; while ($arrayindex < $arraysize) {$comparefindheroname = $heroes[$arrayindex];
$findheroname =~ s/\W.*//;$findheroname =~ tr/A-Z/a-z/;
$comparefindheroname =~ s/\W.*//;$comparefindheroname =~ tr/A-Z/a-z/;
if ($findheroname eq$comparefindheroname) {
$found =$found + 1;
}
$arrayindex =$arrayindex + 1;
}
if ($found eq 0) {$found = 0;
$arrayindex = 0; print "\n\nNot on record! Try again!\nWhat hero or villain are you? ";$heroname = <STDIN>;
chomp $heroname; if ($heroname=~ /^beacon deacon\b/i) {
print "Hello, Jamie!\n";
} else {
print "Hello, $heroname!\n"; } } } print "What is your secret identity (Type 'quit' to quit the program)? ";$guess = <STDIN>;
chomp ($guess); while (! good_ID($heroname,$guess)) { print "Invalid!\nWhat is your secret identity (Type 'quit' to quit the program)? ";$guess = <STDIN>;
chomp ($guess); } if (good_ID($heroname,$guess)) { if ($quitter ne true) {
print "\n\n$guess, a.k.a.$heroname, your access has been granted!\n\n";
$indx = 0; while ($indx < $arraysize) { print "The secret identity of$heroes[$indx] is$IDs[$indx].\n";$indx = $indx + 1; } print "\n"; } else { print "\nExitting Program. Goodbye.\n\n"; } } ## subroutines from here down sub init_arrays { @heroes = ("Batman", "Spiderman", "Destro", "Superman", "Darth Vader", "Beacon Deacon", "Captain America", "Wonder Woman", "Hulk", "Green Hornet", "Green Arrow", "Judge Dredd", "Lone Ranger", "Robin", "Stormshadow"); @IDs = ("Bruce Wayne", "Peter Parker", "James McCullen", "Clark Kent", "Anakin Skywalker", "Jamie Johnson", "Steve Rogers", "Diana Prince", "Robert Bruce Banner", "Britt Reid", "Oliver Queen", "Joe Dredd", "John Reid", "Dick Grayson", "Thomas Arashikage"); } sub good_ID { my($somename,$someguess) = @_; # name the parameters$somename =~ s/\W.*//;    # delete everything after first word
$somename =~ tr/A-Z/a-z/; # lower-case everything$someguess =~ s/\W.*//;
$someguess =~ tr/A-Z/a-z/;$idx = 0;
if ("quit" eq $someguess) {$quitter = true;
return 1;
}
while ($idx ne$arraysize) {
$comparehero =$heroes[$idx];$comparehero =~ s/\W.*//;
$comparehero =~ tr/A-Z/a-z/;$compareID = $IDs[$idx];
$compareID =~ s/\W.*//;$compareID =~ tr/A-Z/a-z/;
if ($somename eq$comparehero) {
if ($someguess eq$compareID) {
return 1;                 # return value is true
}  else {
return 0;                 # return value is false
}
}
$idx =$idx + 1;
}
}
↓ externalize a subroutine ↓
Do you have a subroutine you use often and would like to repeat its use in other scripts?
Consider externalizing it as shown below. So, what about external subroutines, such as where you
want to call a perl routine from an external .pl file from your .cgi script?
Do this in your CGI where myfctn.pl is the arbitrarily-named external file containing the
subroutine, somefctn is the arbitrarily-named subroutine (notice that & is not
required in front of the subroutine name) in the file, and  $myparam is an arbitrarily-named variable you pass as a parameter to the subroutine: if(-e -r -s "myfctn.pl"){ # check that there -exists a -readable -system file over 0 bytes do "myfctn.pl"; # "read" in the external script file with the function somefctn($myparam); # call the function - no & needed
}
And then your subroutine is in an executable perl script (the myfctn.pl file) set up similar to this:
#!/usr/bin/perl
use strict;
sub myfctn {
$_[0] =~ s/&lt;/</g; # where$_[0] is the parameter you passed.
}
1;
I am just running a simple RegEx line, but you have at your disposal a perl script to do all sorts
of things in a centralized way!

Apache and CGI.pm [<<rewind]

CGI is the Common Gateway Interface - scripts web servers use to run scripts.

For Apache server, don't forget to enable CGI in the httpd.conf with the following: ExecCGI

For Apache server 2.2, DO NOT use the following in the httpd.conf file: UserDir

CGI.pm

In Perl, if you are using print <<EndOfHTML to print a section of HTML, then make sure you
put a return after the final EndOfHTML.  If it is the end of the program, you can put exit;

The shbang line might be #!/usr/bin/perl -w OR #!/perl/bin/perl -wT but it needs proper path.

CGI.PM: (After shbang line - allows use of functions from the module): use CGI qw(:standard);
Functions in CGI.PM:
start_html;
end_html;

print start_html("Hello World");

will print out the following:

<html>
<title>Hello World</title>
<body>

You can also set the page colors and background image with start_html:

print start_html(-title=>"Hello World",
-bgcolor=>"#cccccc", -text=>"#999999",
-background=>"bgimage.jpg");

Notice that with multiple arguments, you have to specify the name of each argument
with -title=>, -bgcolor=>, etc. This example generates the same HTML as above,
only the body tag indicates the page colors and background image:

<body bgcolor="#cccccc" text="#999999"  background="bgimg.jpg">

The end_html function prints out the closing HTML tags:

</body>
</html>

Check Syntax and Logs [<<rewind]

use CGI::Carp qw(warningsToBrowser fatalsToBrowser); Use the Carp Module in CGI.pm.

perl -cwT myscript.cgi Use this to test from command line to check syntax without running myscript.cgi.

I've also noticed that checking syntax will work when using CGI qw standard and what makes it
work is perl -c.

/usr/local/etc/httpd/logs/error_log
/var/log/httpd/error_log

In Unix, view the end of the log file (which contains the error message in the final line) using the following:
tail /var/log/apache/error_log

Using Perl/CGI to redirect a web page is described here.

More on CGI:
http://search.cpan.org/dist/CGI.pm/
http://blob.perl.org/books/beginning-perl/3145_Chap12.pdf

Environment Variables [<<rewind]
Thanks to http://www.cgi101.com/book/ch3/text.html

Key                        Value
DOCUMENT_ROOT 	The root directory of your server
HTTP_HOST 	The hostname of the page being attempted
HTTP_REFERER 	The URL of the page that called your program
HTTP_USER_AGENT 	The browser type of the visitor
HTTPS 	"on" if the program is being called through a secure server
PATH 	The system path your server is running under
QUERY_STRING 	The query string (see GET, below)
REMOTE_HOST 	The hostname of the visitor (if server has reverse-name-lookups on; otherwise IP address)
REMOTE_PORT 	The port the visitor is connected to on the web server
REMOTE_USER 	The visitor's username (for .htaccess-protected pages)
REQUEST_METHOD 	GET or POST
REQUEST_URI 	The interpreted pathname of the requested document or CGI (relative to the document root)
SCRIPT_FILENAME 	The full pathname of the current CGI
SCRIPT_NAME 	The interpreted pathname of the current CGI (relative to the document root)
SERVER_NAME 	Your server's fully qualified domain name (e.g. www.cgi101.com)
SERVER_PORT 	The port number your server is listening on
SERVER_SOFTWARE 	The server software you're using (e.g. Apache 1.3)

print "Caller = $ENV{HTTP_REFERER}\n"; # print URL of the page that called the program. Print all environment variables! Check this out! #!/usr/bin/perl -w # PRINT ALL ENVIRONMENT VARIABLES use strict; use CGI qw(:standard); use CGI::Carp qw(warningsToBrowser fatalsToBrowser); print header; print start_html("Environment"); foreach my$key (sort(keys(%ENV))) {
print "$key =$ENV{$key}<br />\n"; } print end_html; Remote Host Program: #!/usr/bin/perl -w use CGI qw(:standard); use CGI::Carp qw(warningsToBrowser fatalsToBrowser); use strict; use Socket; print header; print start_html("Remote Host"); my$hostname = gethostbyaddr(inet_aton($ENV{REMOTE_ADDR}), AF_INET); print "Welcome, visitor from$hostname!<p>\n";
print end_html;

Browser Detection Program:  [<<rewind]

#!/usr/bin/perl -w
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use strict;
print start_html("Browser Detect");
my($ua) =$ENV{HTTP_USER_AGENT};
print "User-agent: $ua<p>\n"; if (index($ua, "MSIE") > -1) {
print "Your browser is Internet Explorer.<p>\n";
} elsif (index($ua, "Netscape") > -1) { print "Your browser is Netscape.<p>\n"; } elsif (index($ua, "Safari") > -1) {
} elsif (index($ua, "Opera") > -1) { print "Your browser is Opera.<p>\n"; } elsif (index($ua, "Mozilla") > -1) {
print "Your browser is probably Mozilla.<p>\n";
} else {
print "unknown browser<p>\n";
}
print end_html;

Look!  I've been having fun with some of this.  I made a form which accepts your name and then makes a certificate.
Here's the form:
<html>
<title>Certifiable</title>
<body>

<form action="/cgi-bin/computing/johns2ja/certifiable.cgi" method="GET">
Your First and Last names below:  <br />
First Name: <input type="text" name="first_name" size=30 /><br />
Last Name: <input type="text" name="last_name" size=30 /><br />
<input type="submit"><p>
</form>

</body>
</html>
Here's the cgi script:
#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);

print start_html("Environment");

my @values = split(/&/,ENV{QUERY_STRING}); print "<div align=\"center\">\n"; print "<div align=\"center\" style=\"padding:50px;border:3px solid navy;background-image:url(http://www.beacondeacon.com/brightsky.jpg);width:500px;\">\n"; print "<span style=\"font-family:cambri;color:navy;font-size:50px;\">"; myname;

foreach my $j (@values) { my($fieldname, $data) = split(/=/,$j);
$name = "$data";
$name =~ s/\+/ /g; # in case someone inputs multiple names in a field, this substitutes the + with a space. print "$name&nbsp;";
}
print "</span>\n";
print "<br /><p style=\"font-style:italic;font-family:times;font-size:20px;\">is successfully serving as Chairman of the Crazy Klub!</p><p></p>\n";
print "<div style=\"float:right;font-size:50px;color:blue;\">~~~~~~~~~~~~~~~<br />~~~~~~~~~~~~~~~</div><br />\n";
print "<div align=\"left\">\n";
print "<div align=\"center\" style=\"padding:5px; width:50px; background-color:blue;font-size:35px;color:white;\">&nbsp;&#1758;&nbsp;\n<br /><span style=\"font-size:11px;\">Seal of Insanity</span></div>\n";
print "</div>\n";
print "<div style=\"clear:right;\"> </div>\n";
print "</div>\n";
print "</div>\n";
print end_html;

param [<<rewind]

Here is some useful information regarding param  from http://www.cgi101.com/book/ch3/text.html:

If you're sending more than one value in the query string, it's best to use CGI.pm to parse it. This requires that your query string be of the form:

fieldname1=value1

For multiple values, it should look like this:

fieldname1=value1&fieldname2=value2&fieldname3=value3

This will be the case if you are using a form, but if you're typing the URL directly then you need to be sure to use a fieldname, an equals sign, then the field value.

CGI.pm provides these values to you automatically with the param function:

param('fieldname');

This returns the value entered in the fieldname field. It also does the URL-decoding for you, so you get the exact string that was typed in the form field.

You can get a list of all the fieldnames used in the form by calling param  with no arguments:

my @fieldnames = param();

param  is NOT a Variable!

param  is a function call. You can't do this:

print "$p = param($p)<br />\n";

If you want to print the value of param($p), you can print it by itself: print param($p);

Or call param  outside of the double-quoted strings:

print "$p = ", param($p), "<br />\n";

You won't be able to use param('fieldname') inside a here-document. You may find it easier to assign the form values to individual variables:

my $firstname = param('firstname'); my$lastname = param('lastname');

Another way would be to assign every form value to a hash:

my(%form);
foreach my $p (param()) {$form{$p} = param($p);
}

You can achieve the same result by using CGI.pm's Vars function:

use CGI qw(:standard Vars);
my %form = Vars();

The Vars function is not part of the "standard" set of CGI.pm functions, so it must be included specifically in the use statement.

Either way, after storing the field values in the %form hash, you can refer to the individual field names by using $form{'fieldname'}. (This will not work if you have a form with multiple fields having the same field name.) A couple more things to remember with param: use CGI; And for params using post use the name attribute from the passing script. *********************************************************************************** *** For the above form examples: Avoid using GET for sending confidential data. *** *** One can see the entry as part of the URL. Use POST instead. *** *********************************************************************************** Passing parameters via links and processing with a case statement: If you are interested in passing parameters via a link so that the "page" processes itself and displays information in the format URL/file?param=value, you can do something like shown below (and it shows good use of a case statement): #!/usr/bin/perl -w # cgi-bin/ani: program to answer choice use CGI qw(param); use Switch; my$choice = param("option");
print <<END_of_Start;
Content-type: text/html

<html>
<title>Anakin Skywalker Info</title>
<body>
<h1>Anakin Skywalker Information</h1>
<p>Click a link for more info:</p>
<p><a href="?option=early">early years</a></p>
<p><a href="?option=middle">middle years</a></p>
<p><a href="?option=later">later years</a></p>
END_of_Start

if ($choice ne '') { print "<h2>Anakin Skywalker - the$choice years</h2>";
switch ($choice) { case "early" { print "<p>Anakin was a slave on Tatooine, son of Shmi Skywalker. He was brought to the Jedi by Qui-Gon Jinn.</p>"; } case "middle" { print "<p>Anakin became a powerful Jedi. He married Padm&eacute; Amidala of Naboo and she became pregnant with twins (Luke and Leia). He was later seduced by Emperor Palpatine/Darth Sidious and became the Sith Lord Darth Vader. He then proceeded to destroy the Jedi.</p>"; } case "later" { print "<p>As Darth Vader, he discovered that he had a son Luke Skywalker and later a daughter Princess Leia Organa. He tried to turn his son to the Dark Side, but it was Luke who turned Darth Vader back to Anakin Skywalker - to the Light Side. While Palpatine was on the verge of killing Luke, Vader killed Palpatine and sacrificed himself for his son.</p>"; } else { print "<p>Make a choice!</p>"; } } } print "</body></html>"; Note that the link showing ?option=early is short for ani.cgi?option=early (assuming the program file is called ani.cgi). This may mean that say you have another page where you have the phrase "When Anankin was younger", you could link the word younger to the following: ani.cgi?option=early Processing Forms [<<rewind] When parsing form code for decoding, use CGI.pm. To upgrade an older program, do the following: my %FORM; foreach my$field (param()) {
$FORM{$field} = param($field); } Or use the Vars function: use CGI qw(:standard Vars); my %FORM = Vars(); Make sure you have unique identifiers for fields for this to function properly! Also make sure to validate your forms. Say you have a mail form. You could validate it with something like the following: if (param('from') eq "" or param('to') eq "") { &dienice("Please fill out the fields for your email address and the recipient\'s email address."); } # NOTE: dienice is a function. Note the use of the ampersand. Checkboxes <strong>Mission Commander, choose your crew:</strong><br /> <form action="commander.cgi" method="POST"> <input type="checkbox" name="Han Solo" id="Han Solo" value="1"> Han Solo<br /> <input type="checkbox" name="Luke Skywalker" id="Luke Skywalker" value="1"> Luke Skywalker<br /> <input type="checkbox" name="Chewbacca" id="Chewbacca" value="1"> Chewbacca<br /> <input type="checkbox" name="Obi-Wan Kenobi" id="Obi-Wan Kenobi" value="1"> Obi-Wan Kenobi<br /> <input type="submit" /> </form> And here is the script commander.cgi: #!/usr/bin/perl -w use strict; use CGI qw(:standard); use CGI::Carp qw(warningsToBrowser fatalsToBrowser); print header; print start_html("Mission Commander"); print "<h1>Mission Commander</h1>"; my @commanders = ("Han Solo","Luke Skywalker","Chewbacca","Obi-Wan Kenobi"); foreach my$commander (@commanders) {
if (param($commander)) { print "$commander will join the assault on the Death Star.<br />\n";
}
}
print end_html;

NOTE: In the above form, you could have the name and id attributes the same and vary the value attribute as shown below:.

<form action="commander2.cgi" method="POST">
<input type="checkbox" name="commander" id="commander" value="Han Solo"> Han Solo<br />
<input type="checkbox" name="commander" id="commander" value="Luke Skywalker"> Luke Skywalker<br />
<input type="checkbox" name="commander" id="commander" value="Chewbacca"> Chewbacca<br />
<input type="checkbox" name="commander" id="commander" value="Obi-Wan Kenobi"> Obi-Wan Kenobi<br />
<input type="submit" />
</form>

However, you will then need to change the CGI script, ensuring that the name/id is commander as referenced in the script:

#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);

print start_html("Mission Commander");
print "<h1>Mission Commander</h1>";

my @commanders = param('commander');
foreach my $commander (@commanders) { print "$commander will join the assault on the Death Star.<br />\n";
}
print end_html;

Say you don't want to pick the crew, but the one commander, then you wouuld use radio buttons.
Here's the form:

<h1>Mission Commander</h1>
<strong>Choose the Mission Commander</strong><br />
<form action="commander3.cgi" method="POST">
<input type="radio" name="commander" id="commander" value="Han Solo"> Han Solo<br />
<input type="radio" name="commander" id="commander" value="Luke Skywalker"> Luke Skywalker<br />
<input type="radio" name="commander" id="commander" value="Chewbacca"> Chewbacca<br />
<input type="radio" name="commander" id="commander" value="Obi-Wan Kenobi"> Obi-Wan Kenobi<br />
<input type="submit" />
</form>

Here's the script commander3.cgi:

#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);

print start_html("Mission Commander");
print "<h1>Mission Commander</h1>";

my $commander = param('commander'); # Notice how the param commander matches the name/id in the form print "$commander will lead the assault on the Death Star.<br />\n";

print end_html;

You could add some validation to ensure that the user actually selected a value in the above:

if (exists $commanders{$commander}) {
# Your Code to Output the result here
} else {
print "The Imperialists will win if you fail to choose!";
}

Drop-Downs

HTML Form:

<strong>Choose the Mission Commander</strong><br />
<form action="commander4.cgi" method="POST">
<select name="commander" size="4">
<option value="Han Solo"> Han Solo</option>
<option value="Luke Skywalker"> Luke Skywalker</option>
<option value="Chewbacca"> Chewbacca</option>
<option value="Obi-Wan Kenobi"> Obi-Wan Kenobi</option>
</select>
<input type="submit" />
</form>

CGI Script:

#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);

print start_html("Mission Commander");
print "<h1>Mission Commander</h1>";

my @commanders = param('commander');
foreach my $commander (@commanders) { print "$commander will lead the assault on the Death Star.<br />\n";
}

print end_html;

CAUTION! Anyone can send data to your CGI script!

YouTube Code Converter by Jamie Johnson [<<rewind]

YouTube's code to embed videos is not standard. So, I wrote a converter using form processing and

Here's the HTML form:

<br /><br /><br />
<h2>Paste your code here:</h2>
<form action="/cgi-bin/computing/utubeconv.cgi" enctype="application/x-www-form-urlencoded" method="post">
<br />
<input type="submit" value="Convert Code" /><input type="reset" value="Clear" />
</form>

And here's script which does the magic:

#!/usr/bin/perl
# utube.cgi by Jamie Johnson
use warnings;
use strict;
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
my $height=0; my$width=0;
my $url="ERROR"; my$change="init";
my %form;
$form{'YouTubeHTML'} = param('YouTubeHTML');$change = param('YouTubeHTML');
# BEGIN FOR STRING TEST ONLY!
# You will have to comment out the above param line when you uncomment the next line.
# $change = "<object width=\"425\" height=\"344\"><param name=\"movie\" value=\"http://www.youtube.com/v/GxibToE1S7A&hl=en&fs=1\"></param><param name=\"allowFullScreen\" value=\"true\"></param><embed src=\"http://www.youtube.com/v/GxibToE1S7A&hl=en&fs=1\" type=\"application/x-shockwave-flash\" allowfullscreen=\"true\" width=\"425\" height=\"344\"></embed></object>"; # END FOR STRING TEST ONLY! chomp($change);
$_ =$change;
if (m/height=\"(\d+)/) { # match one or more digits only after height=" and before "
$height =$1;
}
if (m/width=\"(\d+)/) { # match one or more digits only after width=" and before "
$width =$1;
}
if (m/src=\"(.+)\&/) { # match one or more of any character only after src=" and before &
$url =$1;
}
$url =~ s/&.+//; # Remove the & and all after it from the URL if it still exists. print header; print start_html("Your converted code"); print h1("Thank you for using the YouTube Code Converter.<br />Here is your converted code:"); print "\n\n"; if ($height==0||$width==0||$url eq "ERROR") { $change="ERROR"; } if ($change eq "ERROR") {
}
else {
print "&lt;object type=&quot;application/x-shockwave-flash&quot; width=&quot;$width&quot; height=&quot;$height&quot; data=&quot;$url&quot;&gt;<br /> &lt;param name=&quot;movie&quot; value=&quot;$url&quot;&gt;&lt;/param&gt;<br />
&lt;param name=&quot;wmode&quot; value=&quot;transparent&quot;&gt;&lt;/param&gt;<br />
}
print end_html;

HTML to Entity Converter by Jamie Johnson [<<rewind]

I decided to take some of the above concepts and make myself a tool,
which will actually help with this page.  Basically, I can paste HTML
code into a form and it will convert it to use entities so I can have
the code show up in the browser.  Note the use of Regex (Regular Expressions).
Here's my form:

<h1>HTML to Entity Converter</h1>
<h2>by Jamie Johnson</h2>
<p>This converts HTML code to entities so you can display it on a web page.</p>
<form action="/cgi-bin/computing/johns2ja/convHTML.cgi" method="POST">
<textarea name="convHTML" id="convHTML" rows="20" cols="100"></textarea><br />
<input type="submit" value="Convert HTML to Entity" /><input type="reset" value="Clear" />
</form>

Here's my script convHTML.cgi:

#!/usr/bin/perl -w
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use strict;

print h1("Thank you for using the HTML to Entity Converter by Jamie Johnson.<br />Here is your converted code:");

my %form;
foreach my $p (param()) {$form{$p} = param($p);
my $change =$form{$p};$change =~ s/\&/\&amp;amp;/g; # substitute &amp; for & globally (/g) in the string.
$change =~ s/ /\&amp;nbsp;/g; # substitute &nbsp; for a space globally (/g) in the string.$change =~ s/\"/\&amp;quot;/g; # substitute &quot; for " globally (/g) in the string.
$change =~ s/</\&amp;lt;/g; # substitute &lt; for < globally (/g) in the string.$change =~ s/>/\&amp;gt;/g; # substitute &gt; for > globally (/g) in the string.
$change =~ s/\'/\&amp;#39;/g; # substitute &#39; for ' globally (/g) in the string.$change =~ s/\n/\<br \/>\&lt;br \/\&gt;/g; # substitute both an actual and rendered <br /> for \n globally (/g) in the string.
print "$change<br />\n"; } print "<p><a href=\"http://www.jmu.edu/computing/jamie/convHTML.html\"><span style=\"color:blue;text-decoration:none;\">HTML to Entity Converter</span></a></p>"; print end_html; See it in action! There is already a module in Perl called HTML::Entities, which can do this for you. To learn about it, visit http://search.cpan.org/dist/HTML-Parser/lib/HTML/Entities.pm. File I/O [<<rewind] Opening Files open(MYF, "myfile.txt") or &dienice("myfile.txt cannot be opened for reading:$!"); # opens myfile.txt for reading and the $! stores the error code. open(MYF, ">myfile.txt") or &dienice("myfile.txt cannot be opened for writing:$!"); # opens myfile.txt for overwriting as designated by > Use print
open(MYF, ">>myfile.txt") or &dienice("myfile.txt cannot be opened for appending: $!"); # opens myfile.txt for appending as designated by >> open(MYF, "+<myfile.txt") or &dienice("myfile.txt cannot be opened for reading/writing:$!"); # opens existing myfile.txt reading/writing as designated by +<

MYF is an arbitrary name.  It is a filehandler just like <STDIN>.
You can also use directory handle similarly when using the opendir command to open a directory.
NOTE: You would use then use the following with a directory handle:
while ($_ = readdir(directoryHandle)) { actions } If you use _ in the loop, since you are reading one directory, this will refer to the current file or sub-directory in the directory referenced by the directory handle. In some cases, you may have to use the full path of the file instead of just the filename. If you wanted to specify a path in the above, in the double quotes, you could put the path as shown here: open(MYF,"c:\perldata\myfile.txt"). Remember that the \ does not need to be escaped in double quotes. Also remember in the above that$! is
perl's special variable for holding error messages. Note for the above, also, you could do
this instead: open MYF, "myfile.txt" or die "Houston, we have a problem: $!"; or simply (but not as nice): open MYF, "myfile.txt" or die$!;

use Fcntl qw(:flock); This is used to lock files so that the file won't lose data.

Use LOCK_SH shared lock when reading a file and LOCK_EX exclusive lock when writing a file.

After you open a file using:
open(MYF, "myfile.txt") or &dienice("Cannot open file myfile.txt: $!"); You then use flock(MYF, LOCK_SH); to lock (shared) the file. The file will remain locked until the program terminates or the file is closed. Ensure that the program doing the file I/O uses flock. If another user is writing a file, you should reset the file pointer so that you won't pick up where the other user left off. Here's how you would do it using the example above: seek(MYF,0,2) places pointer at end of file seek(MYF,0,0) places pointer at beginning of file However if you include use Fcntl qw(:flock :seek); you can do the following instead: seek(MYF,0,SEEK_SET) Beginning of File seek(MYF,0,SEEK_CUR) Current Position in File seek(MYF,0,SEEK_END) End of File Finally, you simply close the file using the filehandle (MYF in the example): close(MYF); Reading & Closing Files After you open the file, using open(MYF,"myfile.txt") or &dienice("Cannot open myfile.txt:$!");
you do the following (using the MYF filehandler in the example above:

my $myfileline = <MYF>; # reads one line from the file into the scalar variable$myfileline
my @mywholefile = <MYF>;     # reads the whole file into the array @mywholefile

Then you close the file as so:

close(MYF);      # closes the file referenced by the filehandler MYF

If you wanted the read the file line-by-line, you would do as follows:

open(MYF,"myfile.txt") or &dienice("Cannot open myfile.txt: $!"); my @mywholefile = <MYF>; close(MYF); foreach my$line (@mywholefile) {
print $line; } OR to use less memory: open(MYF,"myfile.txt") or &dienice("Cannot open myfile.txt:$!");
while (my $line = <MYF>) { print$line;
}
close(MYF);

Or even less...
while (<MYF>) {
print $_; } One can do as follows if using the command-line to refer to the file: >perl myfileprocessor.pl myfile.txt while (<>) { actions } # <> is an abbreviation for <ARGV>, which refers to myfile.txt This uses ARGV to work. Refer to ARGV for more information. sort and shift files similarly to how you do with arrays. *MYF = *STDIN The * allows the filehandle STDIN's referred contents to be put in to MYF's reference. This is part of glob("*.extension") which lists filenames matching the *.ext name and uses * like a wildcard just as you would in a command-line environment. Likewise, ? is the wildcard for a single character. For example: my @dirlist=glob("*"); is like doing ls * in Unix shell or dir *.* in DOS commmand-line and feedingit into the array @dirlist. File tests check the status of files so one can program in a manner that prevents problems during the execution of a program that utilizes file I/O. The following chart is a helpful resource from http://blob.perl.org/books/beginning-perl/3145_Chap06.pdf: Usage: if (Test$variableContainingFileName) { actions }

Gravity Petition by Jamie Johnson [<<rewind]

Here's a fun example of File I/O -- a petition.  Here's the form:

<html>
<title>Gravity Petition</title>
<body>
<h1>Gravity Petition&hellip;Keeping things down to earth</h1>

<p>By entering your first and last name below, you are supporting the Law of Gravity!</p>

<p>Gravity... while it might get you down, respect it for it shows no favoritism!</p>

<p>Gravity keeps you down to earth.</p>

<form action="gravity.cgi" method="GET">
Enter your First and Last names below: <br />
First Name: <input type="text" name="first_name" size=30 /><br />
Last Name: <input type="text" name="last_name" size=30 /><br />
<input type="submit"><p>
</form>

</body>
</html>

And here's the CGI script:

#!/usr/bin/perl -w
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use strict;

print start_html("Results");

print "<h2>Thank You</h2>";

# now write (append) to the file

open(OUT, ">>petition.txt") or &dienice("Couldn't open output file: $!"); my$i = 0;

foreach my $p (param()) { print OUT param($p), " ";
$i++; # counting the params if ($i==2) {
$i = 0; print "\n"; # After every 2 params, a break is put in the file (new line) } } print OUT "\n"; close(OUT); print "<p>Here are the supporters of Gravity:</p><tt>"; open(OUT,"petition.txt") or &dienice("Cannot open petition.txt:$!");

my @mywholefile = <OUT>;

my $counter = 0; foreach (@mywholefile) {$counter++; # I added this variable so the lines of the file would show up numbered.
print "$counter. "; if ($counter < 10) {
print "&nbsp;"; # This line puts in an extra space for 1-9 show that things line up nicely.
}
print"$_\n<br />"; #$_ is the current array element, an implicit part Perl, needs no declaration.
}

print "</tt>";
print <<EndHTML;

EndHTML

print end_html;

sub dienice {
my($errmsg) = @_; print "<h2>Error</h2>\n"; print "<p>$errmsg</p>\n";
print end_html;
exit;
}

DBI [<<rewind]

The rundown - some pseudocode:

Database handler - $dbh - set up connection [cartridge] OBDC, CSV, Oracle, etc. Statement handler -$sth [SQL Clipboard]
$query = "SELECT * FROM mytable"; prepare($query);
execute (loop & do)
finish sth
disconnect dbh
exit;

Imagine a table called redskins arranged as such:

lastnamefirstnamejersey
MoseleyMark3
TheismannJoe7
GreenDarrell28
RigginsJohn44
ButzDave65
JacobyJoe66
MonkArt81

The actual file looks like this:

Moseley,Mark,3
Theismann,Joe,7
Green, Darrell,28
Riggins,John,44
Butz,Dave,65
Jacoby,Joe,66
Monk,Art,81

There is a necessary carriage return after Monk,Art,81 so that if another entry is made,
the program knows it is on a new line.

Now the script to read, insert, or delete data:

#!/usr/bin/perl -w
use DBI; # loads the DBI module
my $dbh = DBI->connect('DBI:CSV:n_dir=/af/it/johns2ja/wip/browsers/browse~1/perl/redskins') or die "Cannot connect: " . DBI->errstr; # redskins is the database name and it is at N:\af\it\johns2ja\wip\browsers\browse~1\perl\$dbh->{'csv_tables'}->{'redskins'} = { 'col_names' => ["lastname","firstname","jersey"]};
# the column names are set in the above statement
$query = "SELECT * FROM redskins WHERE lastname = ?"; # The ? will receive data from user input my$sth = $dbh->prepare($query) or die "Couldn't prepare statement: " . $dbh->errstr; print "\n\nEnter last name of player or command (newskin, cleanup, or exit): "; my @data; # This array holds the data while ($lastname = <>) {
# Get data from user
chomp $lastname; # remove \n from the end of the input my$cmd = $lastname;$cmd =~ tr/A-Z/a-z/;
if ($cmd eq ""||$cmd eq " "||$cmd eq "exit"||$cmd eq "quit") {
$sth->finish;$dbh->disconnect;
print "\n\nThank you for checking out the 'Skins!\n\n";
exit;
}
my $dataentry = 0; # There is no data entry occuring my$datadel = 0; # There is no data deletion occuring
if ($cmd eq "cleanup") {$datadel = 1; # data deletion is occurring
clearskin(); # calling the subroutine to delete non-original data
}
if ($cmd eq "newskin") { my$ln;
my $fn; my$jnum;
print "Enter last name of player: ";
$ln = <>; chomp$ln;
print "Enter first name of player: ";
$fn = <>; chomp$fn;
print "Enter jersey number of player: ";
$jnum = <>; chomp$jnum;
my $query2 = "INSERT INTO redskins VALUES ('$ln','$fn','$jnum')";
my $sth2 =$dbh->prepare($query2) or die "Couldn't prepare statement: " .$dbh->errstr;
$sth2->execute();$sth2->finish;
$dataentry = 1; }$sth->execute($lastname) # Run the query - think of sth as an SQL Clipboard - looking for lastname or die "Couldn't execute statement: " .$sth->errstr;
my $no_rows=1; while (@data =$sth->fetchrow_array()) {
# fetchrow_array is built-in and returns the elements that have matching data as per query
$no_rows=0; my$firstname = $data[1]; my$jersey = $data[2]; print "\n\n$firstname $lastname wore jersey number$jersey for the Washington Redskins.\n\n";
}
if ($no_rows==1&&$dataentry==0&&$datadel==0) { print "That name is not in the database.\n\n"; } print "\n\nEnter last name of player or command (newskin, cleanup, or exit): "; } sub clearskin { my$query3 = "DELETE FROM redskins WHERE jersey <> 3 AND jersey <> 7 AND jersey <> 28 AND jersey <> 44 AND jersey <> 65 AND jersey <> 66 AND jersey <> 81";
# The above query deletes any entries which were not in the original file
my $sth3 =$dbh->prepare($query3) or die "Couldn't prepare statement: " .$dbh->errstr;
print "\n\nAre you sure you want to clean the database? (y/n):";
my $rusure = <>; chomp$rusure; # Have to chomp it so it clears the end and the next statement works
if ($rusure eq "y") {$sth3->execute();
$sth3->finish; print "\n\nDatabase cleaned up.\n\n"; } else {$sth3->finish;
}
}
$sth->finish;$dbh->disconnect;
exit;

A shortcut

$dbh->do('DELETE FROM redskins WHERE jersey > 85'); This above statement prepares, executes, and finishes the statement. If you want an automatic commit after each successful query, do the following: my$dbh = DBI->connect('redskins',
{AutoCommit => 1},
)
or die "Couldn't connect to database: " . DBI->errstr;

If you want to abort your program when an error occurs, do this:

my $dbh = DBI->connect('redskins', {RaiseError => 1}, ) or die "Couldn't connect to database: " . DBI->errstr; And finally, some very useful code for CGI with databases: # Initialize connection to the "database" # *** NOTE *** This assumes that$pkey is already defined.
# *** This also assumes that ~ is used as the separator character for the CSV file mydb.txt instead of a comma
my $dbh = DBI->connect(qq{DBI:CSV:csv_eol=\n;csv_sep_char=\\~}); # Database Handler$dbh->{'csv_tables'}->{'MYDB'} = {'file' => 'mydb.txt','col_names' => ["PrimaryKey","First","Last"]};
#	Setup error variables
$dbh->{'RaiseError'} = 1;$@ = '';

#Setup query for bulk of data
my $dbquery = "SELECT First,Last FROM MYDB WHERE PrimaryKey = '$pkey'"; # or whatever SQL Query you need to do
my $sth =$dbh->prepare($dbquery); # Statement Handler$sth->execute( );

while (my $row =$sth->fetchrow_hashref)
{ # START FETCH FROM MYDB and while fetching, it defines the variables with the values obtained from the query
$pkey =$row->{'PrimaryKey'};
my $first =$row->{'First'};
my $last =$row->{'Last'};
}
$sth->finish();$dbh->disconnect();

HTML::Template [<<rewind]

#!/usr/bin/perl -w
use CGI qw( :standard :html3 );
use strict;
use HTML::Template;

#Notice how it mimics attributes and tags in HTML for title, bgcolor, script, Doctype, head, and link
#Note, print header is shorthand for print "Content-Type: text/html\n\n";
print header, start_html(-title=>'This shows up in the title tag', -BGCOLOR=>'#FFFFFF',
-script=>({-language=>'javascript', -src=>'myscript.js'}),
-dtd=>'-//W3C//DTD HTML 4.01 Transitional//EN',
]
);

#HTML TEMPLATES - These are just files with HTML
my $header = HTML::Template->new(filename => 'header_begin.shtml'); my$nav = HTML::Template->new(filename => 'nav.shtml');
my $headerend = HTML::Template->new(filename => 'header_end.shtml'); my$leftcontent_index = HTML::Template->new(filename => 'leftcontent_index.shtml');
my $footer = HTML::Template->new(filename => 'footer.shtml'); #---------------------- HTML Content Starts Here ------------------------------------------------ print$header->output;
print "<h1>My page</h1>";
print $nav->output; print$headerend->output;
print $leftcontent_index->output; print <<MyHTML; <p>This is where your page content goes.</p> MyHTML print$footer->output;
exit;

Calling/embedding Perl in HTML [<<rewind]

Calling or embedding Perl in HTML is rather simple if you have Apache on your server.  Simply use SSI.
For example, if you use CGI scripts to execute Perl on you server, then in your HTML code, put an include
statement to your Perl script where you want it to execute:

<!--#include virtual="/cgi-bin/myscript.cgi"-->

That's it!

Cookies can be set and read using Perl.  Below are two scripts, which accomplish this:

#!/usr/bin/perl

# Jamie Johnson 17 August 2009
use strict;
use CGI;
use CGI qw( :standard :html3 );

my $fut_time=gmtime(time()+60)." GMT"; # Add 1 minute my$mydata="Oreo".",".$fut_time; print "Set-Cookie: KEEBLER=$mydata; expires=$fut_time\n"; #PRINT HEADER FOR HTML File # Example of print header... print header, start_html(-title=>'C is for Cookie', -BGCOLOR=>'tan', -style => "body { font-weight:bold;font-family:arial; } ",-dtd=>'-//W3C//DTD HTML 4.01 Transitional//EN', -head=>[Link({-rel=>'stylesheet',-href=>''})]); print <<StartHTML; <!-- CONTENT AREA BEGINS HERE--> <div class="content"> StartHTML print <<MainHTML; <!-- CONTENT BLOCK START --> <p> Hello! <br /> ---------------<br />$mydata cookie has been set.
<hr />
</p>
<!-- CONTENT BLOCK END -->
<!-- CONTENT AREA ENDS HERE-->
MainHTML
print <<CloseOfHTML;
</div>
</body>
</html>
CloseOfHTML
exit;

Sample Output:

Hello!
---------------
Oreo,Mon Aug 17 20:37:52 2009 GMT cookie has been set.

#!/usr/bin/perl

# Jamie Johnson 17 August 2009
use strict;
use CGI;
use CGI qw( :standard :html3 );

my $outputString; my$querystr = new CGI;
my $Ceid =$querystr->cookie('KEEBLER');
my @cookieData = split /,/, $Ceid; my$CexpDate=$cookieData[1]; my$CeidName = $cookieData[0]; my$currDate = gmtime(time())." GMT"; # Current Date
if (($CeidName eq 'Oreo')&&($CexpDate gt $currDate)) {$outputString="Yummy!" } else { $outputString="NO COOKIE FOR YOU!"; } print <<StartHTML; <!-- CONTENT AREA BEGINS HERE--> <div class="content"> StartHTML print <<MainHTML; <!-- CONTENT BLOCK START --> cookie:$Ceid
<br />
NAME: $CeidName <br /> EXPIRE:$CexpDate
<br />
CURRENT: $currDate <p> Hello! <br /> ---------------<br />$outputString;
<br />
<p>You can <a href="readMyCookie.cgi">refresh</a> this screen to see the current time at any moment.  When current time exceeds one minute beyond the cookie set time, the cookie expires.  if you keep refreshing, you will see the cookie disappear.</p>
<hr />
</p>
<!-- CONTENT BLOCK END -->
<!-- CONTENT AREA ENDS HERE-->
MainHTML
print <<CloseOfHTML;
</div>
</body>
</html>
CloseOfHTML
exit;

Sample Output:

cookie: Oreo,Mon Aug 17 20:37:52 2009 GMT
NAME: Oreo
EXPIRE: Mon Aug 17 20:37:52 2009 GMT
CURRENT: Mon Aug 17 20:37:44 2009 GMT

Hello!
---------------
Yummy!;

You can refresh this screen to see the current time at any moment. When current time exceeds
one minute beyond the cookie set time, the cookie expires. if you keep refreshing, you will

ARGV [<<rewind]

ARGV is another special perl feature that holds what comes after it.
<ARGV> is a filehandler that holds the file after it such as if you ran
>perl myfileprocessor.pl myfile.txt and in this case,
<ARGV> would contain myfile.txt. Note that <ARGV> can be
abbreviated as <>. When used in this manner, the variable $ARGV holds the filename, which can be printed, etc. Refer to File I/O for more information about file input and output. @ARGV @ARGV holds the text after the command on command-line. In away in the above, the text in question is the filename. #!/usr/bin/perl #addup.pl use warnings; use strict; my$sum=0;
$sum +=$_ for @ARGV;
print "Total Summation = $sum\n"; Now run it like this: >perl addup.pl 8 6 7 5 3 0 9 Total Summation = 38 > @INC & Modules[<<rewind] @INC is yet another special feature of Perl which is an array containing the locations of modules. However, if you are developing your own modules, you may want to add to this array. You can do so using the I switch: perl -Ipathname program do is a module that reminds me of using call in a DOS batch script where one batch script would call another. do does the same thing! do "myperlapp.pl" If you have a Perl program called myperlapp.pl, then you can use do within another Perl program too run myperlapp.pl. require Same as do, but can only be used with one file one time in the program; otherwise, it's ignored. However, you can use barewords with require like this: require myperlapp; which means it would be looknig for myperlapp.pm in the paths of @INC. You can also be even more specific like this: require Yo::Joe; which will look for Yo.pm in the Joe directory. This can be handy for organizing modules both in calling them and in storing them. use This is used (no pun intended) throughout the examples on this page! use works just like require but consider how it is used on the examples on this page. It is used in a manner that shows how it differs from require: What is used is done before the rest of the program executes, while require occurs in the order in which it is encountered as the program runs. If someone wants to add to @INC before the program proceeds with executing, then one could use lib like this: use lib "module_path"; use mymodule; BEGIN use is not the only thing that runs before the rest of the program executes. BEGIN allows this as well. If you wanted to put something in the @INC array when the program is compiling as opposed to when the rest of the program executes. Now all of this is nice and all, but let's show it in action. Say you have your Perl program in a directory that also contains a subdirectory called Yo, which contains a module for the program. How do you tell the program about the module and use the functions from the module? The code below shows a program that does just that: #!/usr/bin/perl use strict; use warnings; use lib "Yo/"; # Yo/ is the directory we want to use. require Joe; # Joe.pm is the module in the Yo/ directory. breaker(); # This is a subroutine defined below (following convention) print "Contents of the \@INC array:\n\n"; # I had to escape the @ foreach my$element (@INC) {
print "$element\n"; } breaker(); my$mydir = $INC[0]; # Let's look at the directory I just put in the @INC array, i.e. Yo/ print "Contents of$mydir directory:\n\n";
opendir DH, $mydir or die "Couldn't open the$mydir directory: $!"; while ($_ = readdir(DH)) {
if ($_ !~ /^\./) { # Don't consider . or .. (. at the beginning of the filename). print$_;
print "\n";
}
}
breaker();
print "Now, let's use a function from the module Joe.pm:";
cobra(); # Look at the module below to see what this function contains.
breaker();
print "Let's use another function from the module Joe.pm:";
GIJoe(); # Look at the module below to see what this function contains.

# Subroutine
sub breaker {
print "\n-------------------------------\n";
}

Now here's the module Joe.pm in the Yo/ directory:

#!/usr/bin/perl
use strict;
use warnings;
my $mystr=" "; # I put in the above string that is not used to prevent the error when the # main program is run that "Joe.pm did not return a true value..." # Essentially, this dummy line allows Joe.pm to pass a true value to the # main program. sub cobra { print "\n"; print " ____\n"; print ' @____@'; print "\n"; print " /=' v__v '=\\\n"; print " /==|______|==\\\n"; print " /===|______|===\\\n"; print " (====|______|====)\n"; print " \\===|______|===/\n"; print " \\==|______|==/\n"; print " \\=| |=/\n"; print " \\| |/\n"; print "  '\n\n"; print " COBRA!!!"; } sub GIJoe { print "\n"; print " ________________________________________________________\n"; print " / ___|| |_/\\_ | | / _ \\ | ___/ ////////////////////////\n"; print "| / __ | |\\ / | | | | | | | |_ ////////////////////////\n"; print "| ||_ || ||/\\| | | | | | | | _| / /\n"; print " \\ \\_||| | | |_| | | |_| | | |__/ /\n"; print " \\___||_| \\_____/ \\___/ |___////////////////////////\n"; print "//////////////////////////////////////////////////////\n"; } Note the excercise in escaping out certain characters in the above! And when you run the main program, you will receive output looking something like this: ------------------------------- Contents of the @INC array: Yo/ C:/Perl/site/lib C:/Perl/lib . ------------------------------- Contents of Yo/ directory: Joe.pm ------------------------------- Now, let's use a function from the module Joe.pm: ____ @____@ /=' v__v '=\ /==|______|==\ /===|______|===\ (====|______|====) \===|______|===/ \==|______|==/ \=| |=/ \| |/  ' COBRA!!! ------------------------------- Let's use another function from the module Joe.pm: ________________________________________________________ / ___|| |_/\_ | | / _ \ | ___/ //////////////////////// | / __ | |\ / | | | | | | | |_ //////////////////////// | ||_ || ||/\| | | | | | | | _| / / \ \_||| | | |_| | | |_| | | |__/ / \___||_| \_____/ \___/ |___//////////////////////// ////////////////////////////////////////////////////// And remember: The use of a module allows its subroutines to be available to various Perl programs, much like an externalized JavaScript being available to various web documents. This is different from just a typical subroutine which is available at various times within the run of a single program only (unless that subroutine is in a module :) Detailed information about @INC and modules can be found at http://blob.perl.org/books/beginning-perl/3145_Chap10.pdf. Object Orientation [<<rewind] Hopefully, you have some familiarity with object orientation - encapsulation, inheritance, information hiding, and inheritance. Let's look at some code, which uses a class, constructor, objects, and accessors (Read the comments!): First, setting up a class (save as transformer.pm): #!/usr/bin/perl package Transformer; # class for storing Transformer data # transformer.pm use warnings; use strict; my$Robots=0;

sub new { # constructor
my $class = shift; #takes the class name passed from transformers.pl my$self = {@_}; # hash storing attributes we passed from transformers.pl
bless ($self,$class); # bless turns the $self reference into the object designated by the package$class
$Robots++; return$self; # returns the object
}

sub name { # accessor method to return the name
my $self = shift; unless (ref$self) {
print "ERROR: You should call name() with an object, not a class.";
}
return $self->{name} } sub surname { # accessor method to return the surname my$self = shift;
unless (ref $self) { print "ERROR: You should call surname() with an object, not a class."; } return$self->{surname}
}

sub alliance { # accessor method to return the alliance
my $self = shift; unless (ref$self) {
print "ERROR: You should call alliance() with an object, not a class.";
}
return $self->{alliance} } sub position { # accessor method to return the position my$self = shift;
unless (ref $self) { print "ERROR: You should call position() with an object, not a class."; } return$self->{position}
}

# The above Object accessor methods could have been written as follows:
# sub position { $_[0]->{position }=$_[1]; $_[0]->{position } } # Class accessor method sub tally {$Robots }

# If transformer.pl's sub output was here, it would be a utility method

1; # return a true so this .pm file works, i.e., is known to have loaded correctly.

Next, setting up the program, which creates objects, accesses them, and produces output
(save as transformers.pl):

#!/usr/bin/perl
# transformers.pl
use warnings;
use strict;
use Transformer; # This uses the package Transformer in transformer.pm
# Get ready for the attributes below
my $optimus = Transformer->new ( # object designated by$optimus
name => "Optimus",
surname  => "Prime",
alliance => "Autobot",
position  => "Commander"
);

my $megatron = Transformer->new ( # object designated by$megatron
name => "Megatron",
surname  => "",
alliance => "Decepticon",
position  => "Commander"
);

print "Databank:\n\n";

output($optimus); # if below sub was in transformer.pm as utility method, you'd use$optimus->output;
output($megatron); # if below sub was in transformer.pm as utility method, you'd use$megatron->output;

sub output { # if this were in transformer.pm, it would be a utility method
print "------------------------------------------------------\n";
my $logo = ""; my ($robot) = @_; # parameter passed to @_
print $robot->name; # this follows the accessor syntax of$object->attribute
if ($robot->surname) { print " ",$robot->surname;
}
print " is the ", $robot->position, " of the "; my$side = $robot->alliance; if ($side eq "Autobot") {
print "heroic ";
$logo = "\n_____________\n\\== \\ / ==/\n |<o\>| |<o\>|\n | | |_| | |\n | | ___ | |\n \\|/___\\|/\n"; } if ($side eq "Decepticon") {
print "evil ";
$logo = "\n/\\__\\__/__/\\\n\\ _ \\/ _ /\n \\ \\| |/ /\n \\  ' /\n |\\\\ //|\n |_\\\\ //_|\n \\/\n"; } print$side,"s.";
print $logo; print "\n\n"; } # Transformer->name; # If the above item is uncommented, then you will receive the following error from transformer.pm: # ERROR: You shouuld call name() with an object, not a class. print "------------------------------------------------------\n"; my$verb="are";
my $noun="Transformers"; if (Transformer->tally==1) { # Allows grammar change if there is only 1 Transformer.$verb = "is";
$noun = "Transformer"; } print "There$verb ", Transformer->tally, " $noun.\n"; And here's the output: Databank: ------------------------------------------------------ Optimus Prime is the Commander of the heroic Autobots. _____________ \== \ / ==/ |<o>| |<o>| | | |_| | | | | ___ | | \|/___\|/ ------------------------------------------------------ Megatron is the Commander of the evil Decepticons. /\__\__/__/\ \ _ \/ _ / \ \| |/ / \  ' / |\\ //| |_\\ //_| \/ ------------------------------------------------------ There are 2 Transformers. Notice how you could set up all kinds of Transformers (objects). In the example above, I set up two. Copy and paste the code and create a few more. If you wanted to set up a subclass, you could do it like this: #!/usr/bin/perl package Targetmaster; # Targetmaster.pm use Transformer; use warnings; use strict; our @ISA = qw(Transformer); # @ISA is built into Perl This uses inheritance so we now inherit the methods of Transformer.pm. You can find more advanced topics about object orientation in Perl at http://blob.perl.org/books/beginning-perl/3145_Chap11.pdf. Encryption & Decryption [<<rewind] So how do you encrypt data, but also decrypt it? Here's a script showing how: #! /usr/bin/perl use Crypt::DES; # Include Perl DES encryption module use Crypt::CBC; # Include CBC interface use Getopt::Long; # Include Getoptions use strict; #------------------------Declare variables-------------------- my$action;                # what to do

my $data="My secret data"; my$key="12345789";
my $salt="12345678901"; my$hiddendata="";
my $hiddenkey=""; my$showndata="";
my $shownkey=""; #-----------------------Now Encrypt------------------------- # use CBC algorithm print "Data =$data|$key\n"; my$cipher = Crypt::CBC->new($salt,'DES') || die "Couldn't create CBC object";$action = "e"; # encrypt
print "Encrypted = \n";
$cipher->start($action);
$hiddendata =$hiddendata . $cipher->encrypt_hex($data);
$hiddenkey =$hiddenkey . $cipher->encrypt_hex($key);
print "  1:$hiddendata\n"; print " 2:$hiddenkey\n";

#-----------------------Now Decrypt-------------------------
$action = "d"; # decrypt print "Decrypted = \n";$cipher->start($action);$showndata = $cipher->decrypt_hex($hiddendata);
$shownkey =$cipher->decrypt_hex($hiddenkey); print " 1:$showndata\n";
print "  2:$shownkey\n";$showndata = $showndata .$cipher->finish;
exit;

Here's the output:

Data = My secret data|12345789
Encrypted =
1:53616c7465645f5f17b6d77910c2ef18960464c912cfd164fbfc239196c45aaa
2:53616c7465645f5f978eaf9093c6723838529e95f7a8481bd3b3a44e529a9012
Decrypted =
1:My secret data
2:12345789

Shell Scripts and Commands [<<rewind]

Sometimes, you may want to run a shell script or command from cgi using perl.  Here's how:

#!/usr/bin/perl -w
use strict;
use CGI qw( :standard :html3 );
use HTML::Template; # if needed

new CGI;

print header, start_html(-title=>'Shell Script or Command from Perl', -BGCOLOR=>'#FFFFFF', -style => "body {} ",
-dtd=>'html'
);
## OPTIONAL ,
#		]

open(MYFILE,"sh script.sh OR command |") || die "Failed: $!\n"; # using open to execute the shell script or command while ( ) { print$_; # print line from "file", i.e., a line of output
print "";
}

close (MYFILE);
print end_html;
exit;

Is my server down (404 error)? [<<rewind]

Do you want to see if your server is down?  Here's an example checking to see if the site http://beacondeacon.com is down:

#!/usr/bin/perl -w
use strict;
use CGI qw( :standard :html3 );
use HTML::Template; # if needed
use LWP::Simple;
print header, start_html(-title=>'Is a server down', -BGCOLOR=>'#FFFFFF',
-dtd=>'-//W3C//DTD XHTML 1.0 Strict//EN');
my $url="http://beacondeacon.com"; if (! head($url)) {
die "The Server $url is DOWN!!!!" } else { print "The Server$url is up!";
}
exit;

Optimization and Benchmarking [<<rewind]

Below is a quick (and basic) list of ideas I gleaned from http://perl.apache.org/docs/1.0/guide/performance.pdf:

Combine prints to avoid multiple calls to print.
Avoid global variables where possible.
Printing lists of strings to a file is faster than printing the interpolation of strings to a file, which is faster than concatenation of strings to a file as shown below:
use Benchmark;
use Symbol;
my $fh = gensym; open$fh, ">/dev/null" or die;
my ($one,$two, $three,$four) = map { $_ x 1000 } ('a'..'d'); # 1000 character strings timethese(500_000, { interp => sub { print$fh "$one$two$three$four";
},
list => sub {
print $fh$one, $two,$three, $four; }, conc => sub { print$fh $one.$two.$three.$four;
},
});
# source is sect 1.7.8 at http://perl.apache.org/docs/1.0/guide/performance.pdf

Double quotes are an operator in Perl which allows for interpolation.
For large files, "try to process a line at a time and print it back to the file. If you need to modify the file itself, use a temporary file. When finished, overwrite the source file. Make sure you use a locking mechanism!" (SOURCE: sect 1.9.1.1 at http://perl.apache.org/docs/1.0/guide/performance.pdf).
If your variable can grow large, use references to pass instead of the variable itself.
For relational DB, let SQL get the rows the program needs and only work with them. Say you are displaying DB contents.  Instead of getting the whole DB and then printing row by row, print each row right after it is fetched.
Replace prepare() with prepare_cached() in DBI use.
Source: http://perl.apache.org/docs/1.0/guide/performance.pdf

Here's a simple command-line benchmarking tool I wrote, which times a Perl program:

#!/usr/bin/perl
use Benchmark;
use Symbol;
use warnings;
use strict;
# benchmarkit.pl by James Arthur Johnson
# Use syntax: perl benchmarkit.pl filename.pl

print "Enter number of iterations:\n";
my $count = <STDIN>; # Read code from command-line: my$code;
my @codeArray = <>; # <> is an abbreviation for <ARGV> which reads the code specified by the filename in the command-line into an array.

foreach my $line (@codeArray) {$code=$code.$line;
}
chomp ($code);$/ = "END";

print "\nProcessing...\n";

# run code and display result

timethis($count,$code);

print "\n\nResult of running the program \$count times.\n\n";

And here's sample execution/output from the program using the carlot.pl
example from the References Section.

>perl benchmarkit.pl carlot.pl
Enter number of iterations:
100000
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
…
This repeats for many lines
…
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
Honda Honda Honda
Chevy Chevy Chevy
Dodge Dodge Dodge
timethis 100000
: 18 wallclock secs ( 1.95 usr + 0.66 sys = 2.61 CPU) @ 38314.18/s (n=100000)

Result of running the program 100000
times.

Perl Manual [<<rewind]

If at first you don't succeed, read the directions, right? :)

Remember using this command at a Unix prompt: man perl

Or you can do one of the items below after man

PERL(1)                Perl Programmers Reference Guide                PERL(1)

perl                Perl overview (this section)
perlintro           Perl introduction for beginners

Tutorials

perlreftut          Perl references short introduction
perldsc             Perl data structures intro
perllol             Perl data structures: arrays of arrays

perlrequick         Perl regular expressions quick start
perlretut           Perl regular expressions tutorial

perlboot            Perl OO tutorial for beginners
perltoot            Perl OO tutorial, part 1
perltooc            Perl OO tutorial, part 2
perlbot             Perl OO tricks and examples

perlstyle           Perl style guide

perlcheat           Perl cheat sheet
perltrap            Perl traps for the unwary
perldebtut          Perl debugging tutorial

perlfaq2          Obtaining and Learning about Perl
perlfaq3          Programming Tools
perlfaq4          Data Manipulation
perlfaq5          Files and Formats
perlfaq6          Regexes
perlfaq7          Perl Language Issues
perlfaq8          System Interaction
perlfaq9          Networking

Reference Manual

perlsyn             Perl syntax
perldata            Perl data structures
perlop              Perl operators and precedence
perlsub             Perl subroutines
perlfunc            Perl built-in functions
perlopentut       Perl open() tutorial
perlpacktut       Perl pack() and unpack() tutorial
perlpod             Perl plain old documentation
perlpodspec         Perl plain old documentation format specification
perlrun             Perl execution and options
perldiag            Perl diagnostic messages
perllexwarn         Perl warnings and their control
perldebug           Perl debugging
perlvar             Perl predefined variables
perlre              Perl regular expressions, the rest of the story
perlreref           Perl regular expressions quick reference
perlref             Perl references, the rest of the story
perlform            Perl formats
perlobj             Perl objects
perltie             Perl objects hidden behind simple variables
perldbmfilter     Perl DBM filters

perlipc             Perl interprocess communication
perlfork            Perl fork() information
perlnumber          Perl number semantics

perlport            Perl portability guide
perllocale          Perl locale support
perluniintro        Perl Unicode introduction
perlunicode         Perl Unicode support
perlebcdic          Considerations for running Perl on EBCDIC platforms

perlsec             Perl security

perlmod             Perl modules: how they work
perlmodlib          Perl modules: how to write and use
perlmodstyle        Perl modules: how to write modules with style
perlmodinstall      Perl modules: how to install from CPAN
perlnewmod          Perl modules: preparing a new module for distribution

perlutil            utilities packaged with the Perl distribution

perlcompile         Perl compiler suite intro

perlfilter          Perl source filters

perlglossary        Perl Glossary

Internals and C Language Interface

perlembed           Perl ways to embed perl in your C or C++ application
perldebguts         Perl debugging guts and tips
perlxstut           Perl XS tutorial
perlxs              Perl XS application programming interface
perlclib            Internal replacements for standard C library functions
perlguts            Perl internal functions for those doing extensions
perlcall            Perl calling conventions from C

perlapi             Perl API listing (autogenerated)
perlintern          Perl internal functions (autogenerated)
perliol             C API for Perl's implementation of IO in Layers
perlapio            Perl internal IO abstraction interface

perlhack            Perl hackers guide

Miscellaneous

perlbook            Perl book information
perltodo            Perl things to do

perldoc             Look up Perl documentation in Pod format

perlhist            Perl history records
perldelta           Perl changes since previous version
perl587delta        Perl changes in version 5.8.7
perl586delta        Perl changes in version 5.8.6
perl585delta        Perl changes in version 5.8.5
perl584delta        Perl changes in version 5.8.4
perl583delta        Perl changes in version 5.8.3
perl582delta        Perl changes in version 5.8.2
perl581delta        Perl changes in version 5.8.1
perl58delta         Perl changes in version 5.8.0
perl573delta        Perl changes in version 5.7.3
perl572delta        Perl changes in version 5.7.2
perl571delta        Perl changes in version 5.7.1
perl570delta        Perl changes in version 5.7.0
perl561delta        Perl changes in version 5.6.1
perl56delta         Perl changes in version 5.6
perl5005delta       Perl changes in version 5.005
perl5004delta       Perl changes in version 5.004

Language-Specific

perlcn              Perl for Simplified Chinese (in EUC-CN)
perljp              Perl for Japanese (in EUC-JP)
perlko              Perl for Korean (in EUC-KR)
perltw              Perl for Traditional Chinese (in Big5)

Platform-Specific

perlaix             Perl notes for AIX
perlamiga           Perl notes for AmigaOS
perlapollo          Perl notes for Apollo DomainOS
perlbeos            Perl notes for BeOS
perlbs2000          Perl notes for POSIX-BC BS2000
perlce              Perl notes for WinCE
perlcygwin          Perl notes for Cygwin
perldgux            Perl notes for DG/UX
perldos             Perl notes for DOS
perlepoc            Perl notes for EPOC
perlhpux            Perl notes for HP-UX
perlhurd            Perl notes for Hurd
perlirix            Perl notes for Irix
perllinux           Perl notes for Linux
perlmachten         Perl notes for Power MachTen
perlmacos           Perl notes for Mac OS (Classic)
perlmacosx          Perl notes for Mac OS X
perlmint            Perl notes for MiNT
perlmpeix           Perl notes for MPE/iX
perlnetware         Perl notes for NetWare
perlopenbsd         Perl notes for OpenBSD
perlos2             Perl notes for OS/2
perlos390           Perl notes for OS/390
perlos400           Perl notes for OS/400
perlplan9           Perl notes for Plan 9
perlqnx             Perl notes for QNX
perlsolaris         Perl notes for Solaris
perltru64           Perl notes for Tru64
perluts             Perl notes for UTS
perlvmesa           Perl notes for VM/ESA
perlvms             Perl notes for VMS
perlvos             Perl notes for Stratus VOS
perlwin32           Perl notes for Windows

Resources [<<rewind]

Primary Resource: http://www.cgi101.com/
Database Interface (DBI): http://www.perl.com/pub/a/1999/10/DBI.html
HTML::Template: http://www.sitepoint.com/article/introducing-html-template
Perl CGI Tutorial: http://inconnu.islug.org/~ink/perl_cgi/index.html
Beginning Perl by Simon Cozens: http://www.perl.org/books/beginning-perl/
Performance Tuning: http://perl.apache.org/docs/1.0/guide/performance.pdf
HTML::Entities: http://search.cpan.org/dist/HTML-Parser/lib/HTML/Entities.pm

AAA  LL LL                            BB                                 :):):):):)
AA AA LL LL                            BB                                :)        :)
AA AA LL LL   YY YY  OOO  UU UU RR R   BBBB   AAA   SSSS  EEE           :)  @    @  :)
AA AA LL LL   YY YY OO OO UU UU RRRR   BB BB    AA SS    EE EE          :)          :)
AAAAA LL LL   YY YY OO OO UU UU RR     BB BB  AAAA SSSSS EEEEE          :)          :)
AA AA LL LL    YYYY OO OO UU UU RR     BB BB AA AA    SS EE             :)  \____/  :)
AA AA LL LL      YY  OOO   UUUU RR     BBBB   AAAA SSSS   EEEE           :)        :)
YYY                                                        :):):):):)

BB          LL                     TT
BB          LL                     TT
AAA  RR R  EEE    BBBB   EEE  LL  OOO  NNNN   GGGG   TTT  OOO    UU UU  SSSS
AA RRRR EE EE   BB BB EE EE LL OO OO NN NN GG GG   TT  OO OO   UU UU SS
AAAA RR   EEEEE   BB BB EEEEE LL OO OO NN NN GG GG   TT  00 OO   UU UU SSSSS
AA AA RR   EE      BB BB EE    LL OO OO NN NN  GGGG   TT  OO OO   UU UU    SS
AAAA RR    EEEE   BBBB   EEEE LL  OOO  NN NN    GG    TT  OOO     UUUU SSSS
GGG