Beginner's Introduction to Perl 5.10, Part 2
by chromatic, Doug Sheppard
|
Pages: 1, 2, 3
Subs
So far, the example Perl programs have been a bunch of statements in series. This is okay if you're writing very small programs, but as your needs grow, you'll find it limiting. This is why most modern programming languages allow you to define your own functions; in Perl, we call them subs.
A sub, declared with the sub keyword, adds a new function to your program's capabilities. When you want to use this new function, you call it by name. For instance, here's a short definition of a sub called boo:
use 5.010;
sub boo {
say 'Boo!';
}
boo(); # Eek!
Subs are useful because they allow you to break your program into small, reusable chunks. If you need to analyze a string in four different places in your program, it's much easier to write one analyze_string sub and call it four times. This way, when you make an improvement to your string-analysis routine, you'll only need to do it in one place, instead of four.
In the same way that Perl's built-in functions can take parameters and can return values, your subs can, too. Whenever you call a sub, any parameters you pass to it appear in the special array @_. You can also return a single value or a list by using the return keyword.
use 5.010;
sub multiply {
my (@ops) = @_;
return $ops[0] * $ops[1];
}
for my $i (1 .. 10) {
say "$i squared is ", multiply($i, $i);
}
There's an interesting benefit from using the the my keyword in multiply? It indicates that the variables are private to that sub, so that any existing value for the @ops array used elsewhere in our program won't get overwritten. This means that you'll evade a whole class of hard-to-trace bugs in your programs. You don't have to use my, but you also don't have to avoid smashing your thumb when you're hammering nails into a board. They're both just good ideas.
You can also assign to multiple lexical variables (declared with my) in a single statement. You can change the code within multiply to something like this without having to modify any other code:
sub multiply {
my ($left, $right) = @_;
return $left * $right;
}
If you don't expressly use the return statement, the sub returns the result of the last statement. This implicit return value can sometimes be useful, but it does reduce your program's readability. Remember that you'll read your code many more times than you write it!
Putting it all together
The previous article demonstrated a simple interest calculator. You can make it more interesting by writing the interest table to a file instead of to the screen. Another change is to break the code into subs to make it easier to read and maintain.
#! perl
# compound_interest_file.pl - the miracle of compound interest, part 2
use 5.010;
use strict;
use warnings;
# First, we'll set up the variables we want to use.
my $outfile = 'interest.txt'; # This is the filename of our report.
my $nest_egg = 10000; # $nest_egg is our starting amount
my $year = 2008; # This is the starting year for our table.
my $duration = 10; # How many years are we saving up?
my $apr = 9.5; # This is our annual percentage rate.
my $report_fh = open_report( $outfile );
print_headers( $report_fh );
interest_report( $report_fh, $nest_egg, $year, $duration, $apr );
report_footer( $report_fh, $nest_egg, $duration, $apr );
sub open_report {
my ($outfile) = @_;
open my $report, '>', $outfile or die "Can't open '$outfile': $!";
return $report;
}
sub print_headers {
my ($report_fh) = @_;
# Print the headers for our report.
say $report_fh "Year\tBalance\tInterest\tNew balance";
}
sub calculate_interest {
# Given a nest egg and an APR, how much interest do we collect?
my ( $nest_egg, $apr ) = @_;
return int( ( $apr / 100 ) * $nest_egg * 100 ) / 100;
}
sub interest_report {
# Get our parameters. Note that these variables won't clobber the
# global variables with the same name.
my ( $report_fh, $nest_egg, $year, $duration, $apr ) = @_;
# Calculate interest for each year.
for my $i ( 1 .. $duration ) {
my $interest = calculate_interest( $nest_egg, $apr );
my $line =
join "\t", $year + $i, $nest_egg, $interest, $nest_egg + $interest;
say $report_fh $line;
$nest_egg += $interest;
}
}
sub report_footer {
my ($report_fh, $nest_egg, $duration, $apr) = @_;
say $report_fh "\n Our original assumptions:";
say $report_fh " Nest egg: $nest_egg";
say $report_fh " Number of years: $duration";
say $report_fh " Interest rate: $apr";
}
Notice how much clearer the program logic becomes when you break it down into subs. One nice quality of a program written as small, well-named subs is that it almost becomes self-documenting. Consider these four lines:
my $report_fh = open_report( $outfile );
print_headers( $report_fh );
interest_report( $report_fh, $nest_egg, $year, $duration, $apr );
report_footer( $report_fh, $nest_egg, $duration, $apr );
Code like this is invaluable when you come back to it six months later and need to figure out what it does -- would you rather spend your time reading the entire program trying to figure it out or read four lines that tell you the program 1) opens a report file, 2) prints some headers, 3) generates an interest report, and 4) prints a report footer?
Play around!
This article has explored files (filehandles, open(), close(), and <>), string manipulation (substr(), split() and join()) and subs. Here's a pair of exercises -- again, one simple and one complex:
- You have a file called dictionary.txt that contains dictionary definitions, one per line, in the format "word
spacedefinition". (Here's a sample.) Write a program that will look up a word from the command line. (Hints:@ARGVis a special array that contains your command line arguments and you'll need to use the three-argument form ofsplit().) Try to enhance it so that your dictionary can also contain words with multiple definitions in the format "wordspacedefinition:alternate definition:alternate definition, etc...". - Write an analyzer for your Apache logs. You can find a brief description of the common log format at http://www.w3.org/Daemon/User/Config/Logging.html. Your analyzer should count the total number of requests for each URL, the total number of results for each status code and the total number of bytes output.
Happy programming!
You must be logged in to the O'Reilly Network to post a talkback.
Showing messages 1 through 7 of 7.
- dictionary.pl
2009-10-04 11:43:11 Meltin' [Reply]
Great article, yet again! Loved it, very informative as well...
######################################
use 5.010;
# dictionary.pl - A script that takes a word (up to 3 sepparated by spaces), and gives the definition.
# Made by Caleb Melton.
# Prints output number one.
print_output();
sub print_output{
open my $file, 'dictionary.txt' or die "Could not access $file because:: $!";
while (<$file>) {
my @line = split(/ /,$_,2);
if (@line[0] eq @ARGV[0]){
my $join = join(': ', @line);
print $join;
}
close 'dictionary.txt';
}
};
# Prints output number two.
print_output2();
sub print_output2{
open my $file2, 'dictionary.txt' or die "Could not access $file2 because:: $!";
while (<$file2>) {
my @line2 = split(/ /,$_,2);
if (@line2[0] eq @ARGV[1]){
my $join2 = join(': ', @line2);
print $join2;
}
close 'dictionary.txt';
}
};
# Prints output number three.
print_output3();
sub print_output3{
open my $file3, 'dictionary.txt' or die "Could not access $file2 because:: $!";
while (<$file3>) {
my @line3 = split(/ /,$_,2);
if (@line3[0] eq @ARGV[2]){
my $join3 = join(': ', @line3);
print $join3;
}
close 'dictionary.txt';
}
}
- Numerical and String Equality
2009-08-11 01:25:57 kurhula.com [Reply]
I don't know if it's just me but I failed to run this code successfully:
1 use 5.010;
2
3 my $five = 5;
4
5 say "Numeric equality!" if $five == " 5 ";
6 say "String equality!" if $five eq " 5 ";
It always returns true for both statements.
Changing "5" into '$five' in line 6, returns the correct results.
- Oops - figured it out
2009-06-26 22:20:51 Vikram Reddy [Reply]
I'm sorry, it seems the mistake was the second while loop, i didnt put $i++
-Vikram
- additional info to above post
2009-06-26 21:28:36 Vikram Reddy [Reply]
I have installed Active Perl on Windows XP machine and am running from cmd
Have 3 GB RAM and Intel Core2Duo
regards,
Vikram
- I am a beginner - problem with program
2009-06-26 21:26:16 Vikram Reddy [Reply]
Hello all,
I am a beginner and would appreciate it if anyone can answer my question, thought it may seem silly to you :)
my code for 1st part of simple exercise. it seemed to work
*************************
my @args = @ARGV;
use 5.010;
open my $file, 'dictionary.txt' or die $!;
while (<$file>)
{
my @splitline = split(/ /,$_,2);
if ($args[0] eq $splitline[0])
{
@wordndef = @splitline;
#print "\n$wordndef[0]\t$wordndef[1]";
}
}
my $linetoprint = join(' = ',@wordndef);
print "\n",$linetoprint;
********************************************
I tried to write a code for the "enhanced dictionary" where there can be multiple entries for a word. I understood it as there are multiple iterations of a word in the txt file and the code has to detect them all and display all the defs for a word.
*************************
my @args = @ARGV;
#use 5.010;
#split each line and match word to argv[0],
#if they are the same then print 'word = ''meaning' (1st part = 2nd part of split, which is in an array)
#if length of array is 2 then only 1 [1] to join, if 4 then 2 to join [1] [3] ... [1][3][5] to join
open my $file, 'dictionary.txt' or die $!;
my @wordndef = ();
my @arrayofwordsndeftojoin = ();
my $linetoprint = 0;
my $i = 0;
while (my $line = <$file>)
{
my @splitline = split(/ /,$line,2);
if ($args[0] eq $splitline[0])
{
push(@wordndef,@splitline);
$length = @wordndef;
$num = ($length/2);
}
}
while ($i<=$num)
{
push(@array,@wordndef[(2*$i)-1]);
}
$arrayofdefs = join(' :',@array);
close $file;
print "\n$wordndef[0] = $arrayofdefs";
*********************************************
I added a few definitions of net to the dictionary file
But for this code I keep getting "Out of memory!".
I would appreciate any help or advice
regards,
Vikram
- dictionary.pl just a simple logic
2008-12-11 00:44:02 kanthaa [Reply]
my @args = @ARGV;
for my $i (@args) {
open $file,'dictionary.txt';
while (my $line=<$file>)
{
my @word=split(/ /,$line);
print $line if $word[0] eq $i;
}
close $file;
};
- Reference dictionary.pl & apacheloganalyzer.pl with apachelog.txt attached
2008-10-16 07:51:27 Devil's Advocate [Reply]
#! perl
# dictionary.pl - look up a word from the command line, part 2
# Author: Mickey Meng
use 5.010;
use strict;
use warnings;
# First, we'll set up the variables we want to use.
my $dictionryfile = 'dictionary.txt'; # This is the filename of dictionary.
# Second, open the dictionary file to look up the target word
if (scalar(@ARGV) != 1) {
die "please follow the usage of dictionary.pl: perl dictionary.pl apple";
}
my $report_fh = open_dictionary( $dictionryfile );
say lookup_dictionary( $report_fh, $ARGV[0] );
close_dictionary( $report_fh );
sub open_dictionary {
my ($dictionryfile) = @_;
open my $fh, $dictionryfile or die "Can't open '$dictionryfile': $!";
return $fh;
}
sub close_dictionary {
my ($report_fh) = @_;
close($report_fh);
}
sub lookup_dictionary {
my ($report_fh, $target_word) = @_;
my @filecontents = <$report_fh>;
for my $i (0..scalar(@filecontents)-1) {
my @linecontents = split(/ /, $filecontents[$i], 2);
if ($linecontents[0] eq $target_word) {
my @definations = split(":", $linecontents[1]);
return join("\n", @definations);
}
}
return "$target_word is not found in the dictionary";
}
#################################################
#! perl
# apacheloganalyzer.pl - an analyzer for your Apache logs, part 2
# Author: Mickey Meng
use 5.010;
use strict;
use warnings;
# First, we'll set up the variables we want to use.
my $totalbytes = 0;
my %requestnum_url = ();
my %resultnum_statuscode = ();
# Second, analyze the log file and statistics some key info
if (scalar(@ARGV) != 1) {
die "please follow the usage of apacheloganalyzer.pl: perl apacheloganalyzer.pl apachelog.txt";
}
my $log_fh = open_log( $ARGV[0] );
analyze_log( $log_fh );
close_log( $log_fh );
print_statistics();
sub open_log {
my ($logfile) = @_;
open my $fh, $logfile or die "Can't open '$logfile': $!";
return $fh;
}
sub close_log {
my ($log_fh) = @_;
close($log_fh);
}
sub analyze_log {
my ($log_fh, $target_word) = @_;
my @filecontents = <$log_fh>;
for my $i (0..scalar(@filecontents)-1) {
my @linecontents = split(/ /, $filecontents[$i], 4);
$requestnum_url{$linecontents[0]}++;
my $stripdate = substr($linecontents[3], 22);
my @rightmost3 = split(/ /, $stripdate, 3);
$resultnum_statuscode{$rightmost3[1]}++;
$totalbytes += $rightmost3[2];
}
}
sub print_statistics {
say "the total number of requests for each URL is below";
for my $url (keys %requestnum_url) {
say "$url", "\t", "$requestnum_url{$url}";
}
say "the total number of results for each status code is below";
for my $statuscode (keys %resultnum_statuscode) {
say "$statuscode", "\t", "$resultnum_statuscode{$statuscode}";
}
say "the total number of bytes output is below";
say "$totalbytes";
}
################################################
testmachine rfc931-windows authuser [2008,10,16 10:29:10 "get" 400 1024
10.96.228.85 rfc931-linux authuser [2008,10,16 12:33:10 "post" 401 2048
10.96.228.86 rfc3230-mac authuser [2008,10,16 22:29:15] "get" 401 4096



