Perl Script notes
4.1. Installation
• On Microsoft Windows install ActivePerl from http://www.activestate.com/
• On UNIX/Linux you usually have it installed in /usr/bin/perl or install ActivePerl
4.2. Editors, IDEs
• Emacs http://www.gnu.org/software/emacs/
• vi, vim, gvim http://www.vim.org/
• Crimson Editor http://www.crimsoneditor.com/
• Notepad++ http://notepad-plus.sourceforge.net/
• Textpad http://www.textpad.com/
• Multi-Edit http://www.multiedit.com/
• Komodo of ActiveState http://www.activestate.com/
• Eclipse http://www.eclipse.org/
• SlickEdit http://www.slickedit.com/
4.3. Environment
On the command line one can type:
perl -e "print 42"
perl -v
perl -V
4
Chapter 4. First steps
Example 4-1. examples/intro/hello_world.pl
#!/usr/bin/perl
use strict;
use warnings;
print "Hello world\n";
print 42, "\n";
run it by typing perl hello_world.pl
On unix you can also make it executable: chmod u+x hello_world.pl and then run like: ./hello_world.pl
A couple of notes
• Strings and numbers
• Strings must be quoted, you can use special characters such as "\n"
• The print statement (Output) - gets comma delimitered list of things
• ; after every statement
4.4. Safety net
#!/usr/bin/perl
use strict;
use warnings;
You should always use them as they are a safety net helping reduce mistakes.
It is usually very hard to add this safety net after you already have some code.
If the warnings you get don’t make sense add
use diagnostics;
line and you will get more verbose warnings.
Why are use warnings and use strict so important even in small (< 100 lines) scripts ?
• Helps avoiding trouble with recoursive functions
• Helps avoiding typos in variable names
• Disables unintentional symbolic references
• Reduces debugging time
• Enables/enforces better coding standard => cleaner code, maintainability
Chapter 4. First steps
4.5. Comments
# Comments for other developers
print 42; # the answer
4.6. Perl documentation
perldoc perl
perldoc perlsyn
perldoc perlfunc
perldoc -f print
perldoc -q sort
perldoc perlrun
perldoc strict
perldoc warnings
An index: http://www.szabgab.com/articles/perlindex.html
Web based: http://perldoc.perl.org/
4.7. POD - Plain Old Documentation
Example 4-2. examples/intro/documentation.pl
#!/usr/bin/perl
use strict;
use warnings;
print "Hello, there is no more code here\n";
=head1 Explaining how PODs work
Documentation starts any time there is a =tag
at the beginning of a line (tag can be any word)
and ends where there is a =cut at the beginning
of a line.
Around the =tags you have to add empty rows.
A =tag can be anything but there are some tags
that actually have meaning:
=head1 Main heading
Chapter 4. First steps
=head2 Subtitle
=over 4 start of indentation
=item * element
=back end of indentation
Documentation of PODs can be found in B
See a few examples:
=head1 Main heading
text after main heading
=head2 Less important title
more text
some text shown verbatim
more verbatim text typed in indented to the right
=over 4
=item *
Issue
=item *
Other issue
=back
documentation ends here
=cut
print "Just documentation\n";
perl examples/intro/documentation.pl
perldoc examples/intro/documentation.pl
4.8. Exercise: Hello world
Try your environment:
Chapter 4. First steps
• Make sure you have access to the right version of Perl (5.8.x)
• Check you can read the documentation.
• Check if you have a good editor with syntax highlighting
• Write a simple script that prints Hello world
• Add comments to your code
• Add user documentation to your code
8
Chapter 5. Scalars
A single piece of data either a number or a string is called a ’scalar’ in Perl.
5.1. Numbers - integers, real or floating-point
integer (decimal)
26
1_234_567_890
integer (hex/oct/binary)
0x1a # hex also written as hex("1a");
032 # oct also written as oct("32");
0b11010 # binary also written as oct("0b11010");
# all 3 equal to 26 decimal
real or floating-point
3.5e+3 # 3500
5.2. Scalar variables (use my)
• Scalar variables always start with a $ sign, name is alphanumeric (a-zA-Z0-9) and underscore (_)
• A scalar variable can hold either a string or a number
• Value assignment to varaible is done by the = sign
• Use the my keyword to declare variables (optional but recommended)
$this_is_a_long_scalar_variable
$ThisIsAlsoGoodButWeUseItLessInPerl
$h
$H # $h and $H are two different variables
Example 5-1. examples/scalars/scalar_variables.pl
#!/usr/bin/perl
use strict;
use warnings;
my $greeting = "Hello world\n";
my $the_answer = 42;
print $greeting;
9
Chapter 5. Scalars
print $the_answer, "\n";
A scalar can hold either string or numerical value. They can be changed any
time. If a value was not given it holds the special value ’undef’.
my $x; # the value is a special value called ’undef’
5.3. Greeting with a name, Variable interpolation
Example 5-2. examples/scalars/variable_interpolation.pl
#!/usr/bin/perl
use strict;
use warnings;
my $name = "Foo";
print "Hello ", $name, " - how are you ?\n";
print "Hello $name - how are you ?\n";
5.4. User Input
Example 5-3. examples/scalars/read_from_stdin.pl
#!/usr/bin/perl
use strict;
use warnings;
print "Enter your name, please: ";
my $name =
print "Hello $name, how are you ?\n";
• STDIN - Standard Input (usually it is the keyboard)
• Reading one line (till ENTER) from STDIN
$ perl examples/read_from_stdin.pl
Enter your name, please: Foo
Hello Foo
, how are you ?
There is this problem of the newline
10
Chapter 5. Scalars
5.5. chomp
Example 5-4. examples/scalars/read_from_stdin_chomp.pl
#!/usr/bin/perl
use strict;
use warnings;
print "Enter your name, please: ";
my $name =
chomp $name;
print "Hello $name, how are you ?\n";
chomp will remove the new line "\n" character from the end of the string if there was one.
5.6. Numerical Operators
Example 5-5. examples/scalars/numerical_operators.pl
#!/usr/bin/perl
use strict;
use warnings;
my $x = 3;
my $y = 11;
my $z = $x + $y;
print "$z\n"; # 14
$z = $x * $y;
print "$z\n"; # 33
print $y / $x, "\n"; # 3.66666666666667
$z = $y % $x; # (modulus)
print "$z\n"; # 2
$z += 14; # is the same as $z = $z + 14;
print "$z\n"; # 16
$z++; # is the same as $z = $z + 1;
$z--; # is the same as $z = $z - 1;
$z = 23 ** 2; # exponentiation
print "$z\n"; # 529
11
Chapter 5. Scalars
Example 5-6. examples/scalars/autoincrement.pl
#!/usr/bin/perl
use strict;
use warnings;
my $x = 7;
# Postfix ++ increments AFTER the OLD value was used
my $y = $x++;
print "y = $y, x = $x\n"; # y = 7, x = 8,
$x = 7;
$y = ++$x;
print "y = $y, x = $x\n"; # y = 8, x = 8
See also perldoc perlop for all the operators.
5.7. String Operators
Example 5-7. examples/scalars/string_operators.pl
#!/usr/bin/perl
use strict;
use warnings;
my $x = "Hello";
my $y = "World";
# . is the concatenation operator, ataching ons string after the other
my $z = $x . " " . $y; # the same as "$x $y"
print $z, "\n"; # Hello World
my $w = "Take " . (2 + 3); # you cannot write "Take (2 + 3)" here
print "$w\n"; # Take 5
$z .= "! "; # the same as $z = $z . "! ";
print "’$z’\n"; # ’Hello World! ’
# x is the string repetition operator
my $q = $z x 3;
print "’$q’\n"; # ’Hello World! Hello World! Hello World! ’
See also perldoc perlop for all the operators.
12
Chapter 5. Scalars
5.8. Dividing two numbers given by the user
Ask the user for two numbers and divide the first by the second number.
Example 5-8. examples/scalars/divide.pl
#!/usr/bin/perl
use strict;
use warnings;
print "First number: ";
my $x =
chomp $x;
print "Second number: ";
my $y =
chomp $y;
my $z = $x / $y;
print "The result is $z\n";
$ perl examples/divide.pl
First number: 27
Second number: 3
9
$ perl examples/divide.pl
First number: 27
Second number: 0
Illegal division by zero at examples/divide.pl line 9,
5.9. Fixing the problem: Conditional statements: if
Sometimes based on some condition a piece of code has to be executed or not.
Example 5-9. examples/scalars/if_conditional.pl
#!/usr/bin/perl
use strict;
use warnings;
print "First number: ";
my $x =
chomp $x;
print "Second number: ";
my $y =
chomp $y;
13
Chapter 5. Scalars
if ($y == 0) {
print "Cannot divide by zero\n";
} else {
my $z = $x / $y;
print "The result is $z\n";
}
5.10. Syntax of if statement
{} are always required
if (COND) {
STATEMENTs;
}
if (COND) {
STATEMENTs;
} else {
STATEMENTs;
}
if (COND_1) {
A_STATEMENTs;
} else {
if (COND_2) {
B_STATEMENTs;
} else {
if (COND_3) {
C_STATEMENTs;
} else {
D_STATEMENTs;
}
}
}
if (COND_1) {
A_STATEMENTs;
} elsif (COND_2) {
B_STATEMENTs;
} elsif (COND_3) {
C_STATEMENTs;
} else {
D_STATEMENTs;
}
14
Chapter 5. Scalars
5.11. Comparison operators
Table 5-1. Comparison operators
Numeric String (ASCII) Meaning
== eq equal
!= ne not equal
< lt less than
> gt greater than
<= le less than or equal
>= ge greater then or equal
5.12. String - Number conversion
Example 5-10. examples/scalars/string_number.pl
#!/usr/bin/perl
use strict;
use warnings;
print 3 . "", "\n";
print 3.1 . "", "\n";
print "3" + 0, "\n";
print "3.1" + 0, "\n";
print "3x" + 0, "\n"; # warning: Argument "3x" isn’t numeric in addition (+)
print "3\n" + 0, "\n";
print "3x7" + 0, "\n"; # warning: Argument "3x7" isn’t numeric in addition (+)
print "" + 0, "\n"; # warning: Argument "" isn’t numeric in addition (+)
print "z" + 0, "\n"; # warning: Argument "z" isn’t numeric in addition (+)
print "z7" + 0, "\n"; # warning: Argument "z7" isn’t numeric in addition (+)
5.13. Compare values
Example 5-11. examples/scalars/compare_values.pl
#!/usr/bin/perl
use strict;
use warnings;
my $first =
chomp $first;
15
Chapter 5. Scalars
my $other =
chomp $other;
if ($first == $other) {
print "The two numbers are the same\n";
} else {
print "The two numbers are NOT the same\n";
}
if ($first eq $other) {
print "The two strings are the same\n";
} else {
print "The two strings are NOT the same\n";
}
if ($first > $other) {
print "First is a BIGGER number\n";
} else {
print "First is a smaller number\n";
}
if ($first gt $other) {
print "First is a BIGGER string\n";
} else {
print "First is a smaller string\n";
}
5.14. Compare values - examples
Table 5-2. Compare values
Expression Value
"12.0" == 12 TRUE
"12.0" eq 12 FALSE
2 < 3 TRUE
2 lt 3 TRUE
12 > 3 TRUE
12 gt 3 FALSE !
"" == "hello" TRUE ! (Warning)
"" eq "hello" FALSE
"hello" == "world" TRUE ! (Warning)
"hello" eq "world" FALSE
When reading from STDIN you can always expect a string
16
Chapter 5. Scalars
Example 5-12. examples/scalars/is_empty_string.pl
#!/usr/bin/perl
use strict;
use warnings;
my $input =
chomp $input;
if ($input == "") { # wrong! use eq
# empty string
}
5.15. Boolean expressions (logical operators)
Table 5-3. Logical operators
and &&
or ||
not !
if (COND and COND) {
}
if (COND or COND) {
}
if (not COND) {
}
See also perldoc perlop for precedence and associativity tables and/or use () to define the order of
evaluation.
5.16. TRUE and FALSE
The FALSE values:
undef
""
0 0.0 00000 0e+10
"0"
Other values such as the following are TRUE
1
"00"
17
Chapter 5. Scalars
"0\n"
if ($z) {
# $z is true
}
if (defined $x) {
# $x is defined (not undef)
}
5.17. Your Salary is in Danger - Short-Circuit
If perl already knows the final value of a boolean expression after computing
only part of it, perl will NOT calculate the rest of the expression:
if ($my_money > 1_000_000 or $my_salary > 10_000) {
# I can live well
}
if ($my_money > 1_000_000 or $my_salary++ > 10_000) {
# I can live well
}
5.18. String functions
• length STRING - number of characters
• lc STRING - lower case
• uc STRING - upper case
• index STRING, SUBSTRING - the location of a substring given its content
Example 5-13. examples/scalars/string_functions.pl
#!/usr/bin/perl
use strict;
use warnings;
my $s = "The black cat jumped from the green tree";
print index $s, "ac"; # 6
print "\n";
print index $s, "e"; # 2
print "\n";
print index $s, "e", 3; # 18
18
Chapter 5. Scalars
print "\n";
print index $s, "dog"; # -1
print "\n";
print rindex $s, "e"; # 39
print "\n";
print rindex $s, "e", 38; # 38
print "\n";
print rindex $s, "e", 37; # 33
print "\n";
5.19. String functions
substr STRING, OFFSET, LENGTH - the content of a substring given its location
Example 5-14. examples/scalars/string_functions_substr.pl
#!/usr/bin/perl
use strict;
use warnings;
my $s = "The black cat climbed the green tree";
my $z;
$z = substr $s, 4, 5; # $z = black
print "$z\n";
$z = substr $s, 4, -11; # $z = black cat climbed the
print "$z\n";
$z = substr $s, 14; # $z = climbed the green tree
print "$z\n";
$z = substr $s, -4; # $z = tree
print "$z\n";
$z = substr $s, -4, 2; # $z = tr
print "$z\n";
$z = substr $s, 14, 7, "jumped from"; # $z = climbed
print "$z\n";
print "$s\n"; # $s = The black cat jumped from the green tree
5.20. Strings - Double quoted
print "normal string"; # normal string
print "two\nlines"; # two
# lines
print "another ’string’"; # another ’string’
my $name = "Foo";
19
Chapter 5. Scalars
print "Hello $name, how are you?"; # Hello Foo, how are you?
print "His "real" name is Foo"; # ERROR
print "His \"real\" name is Foo"; # His "real" name is Foo
print "His \"real\" name is \"$name\""; # His "real" name is "Foo"
print qq(His "real" name is "$name"); # His "real" name is "Foo"
print qq(His "real" name is ($name)); # His "real" name is (Foo)
print qq{His "real" name is ($name)}; # His "real" name is (Foo)
In double quoted strings you can use the following:
Backslash escapes sequences like \n \t
see in perldoc perlop
Variable interpolation
5.21. Strings - Single quoted
print ’one string’; # one string
print ’a\n’; # a\n
print ’a $name’; # a $name
print ’another "string"’; # another "string"
There are only two special characters in this kind of string the ’
and the \ at the end of the string
print ’a’b’; # ERROR - perl will see the string ’a’
# and something attached to it
print ’a\’b’; # a’b
print ’ab\’; # ERROR - perl will not see the closing ’
# as it will think it was escaped
print ’ab\\’; # ab\
print q(His "variable" name ’$name’\n); # His "variable" name is ’$name’\n
5.22. Scope of variables
Variables defined within a block {} are hiding more global
variables with the same name.
They are descrutced when leaving the block.
20
Chapter 5. Scalars
Example 5-15. examples/scalars/scope.pl
#!/usr/bin/perl
use strict;
use warnings;
my $fname = "Foo";
my $lname = "Bar";
print "$fname\n"; # Foo
print "$lname\n"; # Bar
{
my $email = ’foo@bar.com’;
print "$email\n"; # foo@bar.com
print "$fname\n"; # Foo
print "$lname\n"; # Bar
my $lname = "Moo";
print "$lname\n"; # Moo
}
# $email does not exists
print "$fname\n"; # Foo
print "$lname\n"; # Bar
5.23. Random numbers
Example 5-16. examples/scalars/random.pl
#!/usr/bin/perl
use strict;
use warnings;
my $num = rand(); # returns a random number: 0 <= NUMBER < 1
my $n = rand(100); # returns a number: 0 <= NUMBER < 100
my $i = int(3.12); # returns the whole part of the number (3 in this case)
my $number = int(rand(100)); # returns a whole number: 0 <= NUMBER < 100
5.24. Exercises: Simple Calcualtor
Write a script that will ask for a number, an operator (+,*,-,/)
and another number. Compute the result and print it out.
21
Chapter 5. Scalars
5.25. Number Guessing game
Using the rand() function the computer thinks about a number.
The user has to guess the number. After the user types in
his guess the computer tells if this was bigger or smaller than
the number it generated.
At this point there is no need to allow the user to guess several times.
5.26. Solution: Simple Calulator
Example 5-17. examples/scalars/basic_calculator.pl
#!/usr/bin/perl
use strict;
use warnings;
print "Type in 2 numbers and an operator and I’ll print the results\n\n";
print "First number: ";
my $first =
chomp($first);
print "Second number: ";
my $other =
chomp($other);
print "The operator: ";
my $oper =
chomp($oper);
my $result;
if ($oper eq "+") { $result = $first + $other; }
if ($oper eq "-") { $result = $first - $other; }
if ($oper eq "*") { $result = $first * $other; }
if ($oper eq "/") {
if ($other == 0) {
print "\nCannot divide by 0\n";
$result = "ERROR";
} else {
$result = $first / $other;
}
}
print "\nResult of $first $oper $other = $result\n";
# What if the given operator is not one of the 4 ?
22
Chapter 5. Scalars
5.27. Solution: Simple Calulator (using eval)
Example 5-18. examples/scalars/basic_calculator_eval.pl
#!/usr/bin/perl
use strict;
use warnings;
print "Type in 2 numbers and an operator and I’ll print the results\n\n";
print "First number: ";
my $first =
chomp($first);
print "Second number: ";
my $other =
chomp($other);
print "The operator: ";
my $oper =
chomp($oper);
my $result = eval "$first $oper $other";
print "\nResult of $first $oper $other = $result\n";
23
Chapter 6. Files
6.1. die, warn, exit
exit() - exits from the program
warn() - writes to STDERR
die() - writes to STDERR and exits from the program
warn "This is a warning";
This is a warning at script.pl line 132.
If no \n at the end of the string both warn and die add the
name of file and line number and possibly the chunk of the input.
6.2. Opening file for reading
While working over most of the operating systems today, no program can
access a file directly. This is in order to allow the Operaring System
to apply user rights.
Before you can read from a file you have to ask the Operating System to "open"
it for you. When opening a file you provide a variable that will become your
handle to the opened file. It is called a filehandle.
my $filename = "input.txt";
open(my $fh, "<", $filename);
close $fh;
6.3. Opening a file
my $filename = "some_filename");
open(my $fhb, "<", $filename); # read
open(my $fhc, ">", $filename); # write
open(my $fhd, ">>", $filename); # append
open(my $fhe, "+<", $filename); # read and write
6.4. Opening a file - error handling
• $! - error message from the Operating system
24
Chapter 6. Files
Example 6-1. examples/files/open_with_if.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "input.txt";
if (open my $in, "<", $filename) {
# do your thing here
# no need to explicitly close the file
} else {
warn "Could not open file ’$filename’. $!";
}
# here the $in filehandle is not accessible anymore
A more Perlish way to open a file and exit with error message if you could not open the file:
Example 6-2. examples/files/open_with_die.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "input.txt";
open(my $fh, "<", $filename) or die "Could not open file ’$filename’. $!";
# do your thing here
close $fh;
6.5. Opening a missing file
Example 6-3. examples/files/open_missing_file.pl
#!/usr/bin/perl
use strict;
use warnings;
if (open my $fh, ’<’, "nosuch") {
# should do here something
} else {
warn $!;
}
The error message we get:
No such file or directory at examples/files/open_missing_file.pl line 7.
25
Chapter 6. Files
6.6. Read one line from a file
Example 6-4. examples/files/read_line.pl
#!/usr/bin/perl
use strict;
use warnings;
# Reading a line from a file (or rather from a filehandle)
my $filename = "input.txt";
if (open my $data, "<", $filename) {
my $line = <$data>;
print $line;
} else {
warn "Could not open file ’$filename’: $!";
}
6.7. Process an entire file line by line (while, cat)
• while - executes as long as there is something in $line, as long as there are lines in the file
• Loop over file (name hardcoded) and print every line (UNIX cat)
Example 6-5. examples/files/cat.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "input.txt";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
print $line;
}
Instead of printing the line you could do anything with it.
6.8. Write to a file
Example 6-6. examples/files/write_file.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "report.txt";
26
Chapter 6. Files
open my $fh, ’>’, $filename or die "Could not open file ’$filename’ $!";
print $fh "Report by: Foo Bar\n";
print $fh "-" x 20;
print $fh "\n";
6.9. Sum of numbers in a file
Example 6-7. examples/files/count_sum_write.pl
#!/usr/bin/perl
use strict;
use warnings;
# given a file with a number on each row, print the sum of the numbers
my $sum = 0;
my $filename = "numbers.txt";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
$sum += $line;
}
print "The total value is $sum\n";
6.10. Analyze the Apache log file
Example 6-8. examples/files/apache_access.log
127.0.0.1 - - [10/Apr/2007:10:39:11 +0300] "GET / HTTP/1.1" 500 606 "-" "Mozilla/5.0 (X11; U; 127.0.0.1 - - [10/Apr/2007:10:39:11 +0300] "GET /favicon.ico HTTP/1.1" 200 766 "-" "Mozilla/139.12.0.2 - - [10/Apr/2007:10:40:54 +0300] "GET / HTTP/1.1" 500 612 "-" "Mozilla/5.0 (X11; 139.12.0.2 - - [10/Apr/2007:10:40:54 +0300] "GET /favicon.ico HTTP/1.1" 200 766 "-" "Mozilla/127.0.0.1 - - [10/Apr/2007:10:53:10 +0300] "GET / HTTP/1.1" 500 612 "-" "Mozilla/5.0 (X11; U; 127.0.0.1 - - [10/Apr/2007:10:54:08 +0300] "GET / HTTP/1.0" 200 3700 "-" "Mozilla/5.0 (X11; 127.0.0.1 - - [10/Apr/2007:10:54:08 +0300] "GET /style.css HTTP/1.1" 200 614 "http://pti.local/" 127.0.0.1 - - [10/Apr/2007:10:54:08 +0300] "GET /img/pti-round.jpg HTTP/1.1" 200 17524 "http://127.0.0.1 - - [10/Apr/2007:10:54:21 +0300] "GET /unix_sysadmin.html HTTP/1.1" 200 3880 "http://217.0.22.3 - - [10/Apr/2007:10:54:51 +0300] "GET / HTTP/1.1" 200 34 "-" "Mozilla/5.0 (X11; U; 217.0.22.3 - - [10/Apr/2007:10:54:51 +0300] "GET /favicon.ico HTTP/1.1" 200 11514 "-" "Mozilla/217.0.22.3 - - [10/Apr/2007:10:54:53 +0300] "GET /cgi/pti.pl HTTP/1.1" 500 617 "http://contact.127.0.0.1 - - [10/Apr/2007:10:54:08 +0300] "GET / HTTP/0.9" 200 3700 "-" "Mozilla/5.0 (X11; 217.0.22.3 - - [10/Apr/2007:10:58:27 +0300] "GET / HTTP/1.1" 200 3700 "-" "Mozilla/5.0 (X11; 217.0.22.3 - - [10/Apr/2007:10:58:34 +0300] "GET /unix_sysadmin.html HTTP/1.1" 200 3880 "http://217.0.22.3 - - [10/Apr/2007:10:58:45 +0300] "GET /talks/Fundamentals/read-excel-file.html HTTP/ 27
Chapter 6. Files
Example 6-9. examples/files/apache_log_hosts.pl
#!/usr/bin/perl
use strict;
use warnings;
my $file = "examples/files/apache_access.log";
open my $fh, ’<’, $file or die "Could not open ’$file’: $!";
my $good;
my $bad;
while (my $line = <$fh>) {
chomp $line;
my $length = index ($line, " ");
my $ip = substr($line, 0, $length);
if ($ip eq "127.0.0.1") {
$good++;
} else {
$bad++;
}
}
print "$good $bad\n";
6.11. Open files in the old way
In old version of perl (before 5.6) we could not use scalar variabsles as file
handles so we used uppercase letters such as XYZ or INPUT, QQRQ or FILEHANDLE.
Also the function had only 2 parameters.
Example 6-10. examples/files/open_file_old.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "data.txt";
open(FH, $filename);
my $line =
close FH;
open(FH, ">$filename");
print FH "data";
close FH;
Security problems.
28
Chapter 6. Files
Being global, difficult to pass as parameter to functions.
6.12. Exercise: Add more statistics
Take the script from the previous example (count_sum_write.pl)
and in addition to the sum of the numbers print also
minimum
maximum
average
median and standard deviation are probably too difficult for now.
6.13. Exercise: Write report to file
Take the exercise creating statistics of the numbers.txt file and
write the results to the numbers.out file.
minimum: -17
maximum: 98
total: 126
count: 6
average: 21
You might need to look up the documentation of the printf
in order to have align the columns.
6.14. Exercise: Analyze Apache - number of successful
hits
In the Apache log file after the "GET something HTTP/1.1" part there is the
result code of the requests. 200 is OK the rest might be some failure.
Please create a report showing how many of the hits were successful (200)
and how many were something else.
Could you put all the lines in either of the categories?
29
Chapter 6. Files
6.15. Solution: Add more statistics
Example 6-11. examples/files/statistics.pl
#!/usr/bin/perl
use strict;
use warnings;
my $total = 0;
my $count = 0;
my $min;
my $max;
my $filename = "numbers.txt";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
chomp $line;
$total += $line;
if (not $count) {
$min = $line;
$max = $line;
}
$count++;
if ($line < $min) {
$min = $line;
}
if ($line > $max) {
$max = $line;
}
}
if (not defined $min) {
print "No values were given\n";
} else {
print "Min: $min Max: $max Total: $total count: $count Average: ",
$total / $count, "\n";
}
6.16. Solution: Analyze Apache - number of successful
hits
Example 6-12. examples/files/apache_log_result_code.pl
#!/usr/bin/perl
use strict;
use warnings;
30
Chapter 6. Files
my $file = "examples/files/apache_access.log";
open my $fh, ’<’, $file or die "Could not open ’$file’: $!";
my $good = 0;
my $bad = 0;
my $ugly = 0;
while (my $line = <$fh>) {
chomp $line;
my $request = q( HTTP/1.1" );
my $start_request = index ($line, $request);
my $result;
if ($start_request >= 0) {
my $end_request = index($line, " ", $start_request + length($request));
$result = substr($line, $start_request + length($request), $end_request-$start_request #print "$start_request, $end_request ’$result’\n";
} else {
my $request = q( HTTP/1.0" );
my $start_request = index ($line, $request);
if ($start_request >= 0) {
my $end_request = index($line, " ", $start_request + length($request));
$result = substr($line, $start_request + length($request), $end_request-$start_request #print "$start_request, $end_request ’$result’\n";
} else {
#print "ERROR: Unrecognized Line: $line\n";
}
}
if (defined $result) {
if ($result eq "200") {
$good++;
} else {
$bad++;
}
} else {
$ugly++;
}
}
print "Good: $good\n";
print "Bad: $bad\n";
print "Ugly: $ugly\n";
# Disclaimer: this is not an optimal solution.
# We will see a much better one after learning functions, regular expressions
31
Chapter 6. Files
6.17. Solution: Write report to file
Example 6-13. examples/files/write_report_to_file.pl
#!/usr/bin/perl
use strict;
use warnings;
my $total = 0;
my $count = 0;
my $min;
my $max;
my $filename = "examples/files/numbers.txt";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
chomp $line;
$total += $line;
if (not $count) {
$min = $line;
$max = $line;
}
$count++;
if ($line < $min) {
$min = $line;
}
if ($line > $max) {
$max = $line;
}
}
open my $out, ’>’, ’numbers.out’;
if (not defined $min) {
print $out "No values were given\n";
} else {
printf($out "Minimum: %5s\n", $min);
printf($out "Maximum: %5s\n", $max);
printf($out "Total: %5s\n", $total);
printf($out "Count: %5s\n", $count);
printf($out "Average: %5s\n", $total / $count);
}
32
Chapter 7. Lists and Arrays
7.1. List Literals, list ranges
Things in () separated by commas are called a list of things.
A list is an ordered set of scalar values.
Examples of lists:
(1, 5.2, "apple") # 3 values
(1,2,3,4,5,6,7,8,9,10) # nice but we are too lazy, so we write this:
(1..10) # same as (1,2,3,4,5,6,7,8,9,10)
(’a’..’z’) # all the lowercase letters
("apple", "banana", "peach", "blueberry") # is the same as
qw(apple banana peach blueberry) # quote word
($x, $y, $z) # We can also use scalar variables as elements of a list
7.2. List Assignment
my ($x, $y, $z);
($x, $y, $z) = (2, 3, 7); # nearly the same as $x=2; $y=3; $z=7;
($x, $y) = (8, 1, 5); # ignore 5
($x, $y, $z) = (3, 4); # $z will be undef
A regular question on job interviews:
How can we swap the values of 2 variables, let say $x and $y?
7.3. loop over elements of list with foreach
• list
• foreach ITEM (LIST) {BLOCK}
• my - in the foreach loop
Example 7-1. examples/arrays/list_colors.pl
#!/usr/bin/perl
use strict;
use warnings;
33
Chapter 7. Lists and Arrays
foreach my $color ("Blue", "Yellow", "Brown", "White") {
print "$color\n";
}
Blue
Yellow
Brown
White
7.4. Create an Array, loop over with foreach
Example 7-2. examples/arrays/list_colors_array.pl
#!/usr/bin/perl
use strict;
use warnings;
my @colors = ("Blue", "Yellow", "Brown", "White");
print "@colors\n";
foreach my $color (@colors) {
print "$color\n";
}
Blue Yellow Brown White
Blue
Yellow
Brown
White
7.5. Array Assignment
You can also mix the variables on the right side and if there are arrays on the right side the whole thing
becomes one flat array !
my $owner = "Moose";
my @tenants = qw(Foo Bar);
my @people = ($owner, ’Baz’, @tenants); # Moose Baz Foo Bar
my ($x, @y, @z);
($x, @y) = (1, 2, 3, 4); # $x is 1; @y is (2, 3, 4)
($x, @y, @z) = (1, 2, 3, 4); # $x is 1; @y is (2, 3, 4) @z is empty: ()
@y = (); # Emptying an array
34
Chapter 7. Lists and Arrays
7.6. foreach loop on numbers
foreach my $i (1..10) {
print "$i\n";
}
1
2
3
4
5
6
7
8
9
10
7.7. Array index (menu)
• $#array - the largest index
• $array[1] - array elements are scalar
Example 7-3. examples/arrays/color_menu.pl
#!/usr/bin/perl
use strict;
use warnings;
my $color;
my @colors = ("Blue", "Yellow", "Brown", "White");
print "Please select a number:\n";
foreach my $i (0..$#colors) {
print "$i) $colors[$i]\n";
}
my $num =
chomp($num);
if (defined $colors[$num]) {
$color = $colors[$num];
} else {
print "Bad selection\n";
exit;
}
print "The selected color is $color\n";
35
Chapter 7. Lists and Arrays
7.8. Command line parameters
• @ARGV - all the arguments on the command line
• $ARGV[0] - the first argument
• $0 - name of the program
• perl read_argv.pl blue
Example 7-4. examples/arrays/read_argv.pl
#!/usr/bin/perl
use strict;
use warnings;
my $color;
if (defined $ARGV[0]) {
$color = $ARGV[0];
}
my @colors = ("Blue", "Yellow", "Brown", "White");
if (not defined $color) {
print "Please select a number:\n";
foreach my $i (0..$#colors) {
print "$i) $colors[$i]\n";
}
my $num =
chomp($num);
if (defined $colors[$num]) {
$color = $colors[$num];
} else {
print "Bad selection\n";
exit;
}
}
print "The selected color is $color\n";
7.9. Process command line parameters, use modules
• use Module;
• scalar reference
Example 7-5. examples/arrays/process_command_line.pl
#!/usr/bin/perl
use strict;
use warnings;
36
Chapter 7. Lists and Arrays
use Getopt::Long qw(GetOptions);
my $color;
GetOptions("color=s" => \$color) or die "Usage: $0 [--color COLOR]\n";
my @colors = ("Blue", "Yellow", "Brown", "White");
if (not defined $color) {
print "Please select a number:\n";
foreach my $i (0..$#colors) {
print "$i) $colors[$i]\n";
}
my $num =
chomp($num);
if (defined $colors[$num]) {
$color = $colors[$num];
} else {
print "Bad selection\n";
exit;
}
}
print "The selected color is $color\n";
7.10. Module documentation
perldoc Getopt::Long
http://perldoc.perl.org/Getopt/Long.html
perldoc Cwd
http://perldoc.perl.org/Cwd.html
7.11. process csv file
• split
Example 7-6. examples/arrays/process_csv_file.csv
Foo,Bar,10,home
Orgo,Morgo,7,away
Big,Shrek,100,US
Small,Fiona,9,tower
37
Chapter 7. Lists and Arrays
Example 7-7. examples/arrays/process_csv_file.pl
#!/usr/bin/perl
use strict;
use warnings;
my $file = ’process_csv_file.csv’;
if (defined $ARGV[0]) {
$file = $ARGV[0];
}
my $sum = 0;
open(my $data, ’<’, $file) or die "Could not open ’$file’\n";
while (my $line = <$data>) {
chomp $line;
my @columns = split ",", $line;
$sum += $columns[2];
}
print "$sum\n";
7.12. process csv file (short version)
Example 7-8. examples/arrays/process_csv_file_short.pl
while (<>) {
$sum += (split ",")[2];
}
print "$sum\n";
Use the following command to run the script:
perl examples/arrays/process_csv_file_short.pl examples/arrays/process_csv_file.csv
See also the oneliners
7.13. process csv file using Text::CSV_XS
What if there is a field called: "Foo, Bar" ?
Example 7-9. examples/arrays/process_csv_file_module.csv
Foo,Bar ,10,home
Orgo,"Morgo, Hapci",7,away
Big,Shrek,100,US
Small,Fiona,9,tower
38
Chapter 7. Lists and Arrays
Example 7-10. examples/arrays/process_csv_file_module.pl
#!/usr/bin/perl
use strict;
use warnings;
use Text::CSV_XS;
my $csv = Text::CSV_XS->new();
my $file = ’process_csv_file_module.csv’;
if (defined $ARGV[0]) {
$file = $ARGV[0];
}
my $sum = 0;
open(my $data, ’<’, $file) or die "Could not open ’$file’\n";
while (my $line = <$data>) {
chomp $line;
if ($csv->parse($line)) {
my @columns = $csv->fields();
$sum += $columns[2];
} else {
warn "Line could not be parsed: $line\n";
}
}
print "$sum\n";
7.14. Join
my @fields = qw(Foo Bar foo@bar.com);
my $line = join ";", @fields;
print "$line\n"; # Foo;Bar;foo@bar.com
7.15. Exercise: improve the color selector
Take the process_command_line.pl script improve in several ways:
- Check if the value given on the command line is indeed one
of the possible values and don’t let other colors pass.
- Allow a --force flag that will disregard the previously implemented restriction.
- Read the names of the colors from a file called colors.txt
- Let the user pass the name of the color file using the --filename FILENAME option.
39
Chapter 7. Lists and Arrays
7.16. Improve the Number Guessing game from the
earlier chapter
Let the user guess several times (with responses each time) till he finds
the hidden number.
Allow the user to type
n - skip this game and start a new one
s - show the hidden value
x - exit
Now I can tell you that what you have is actually a 1 dimensional space fight
and you are trying to guess the distance of the enemy space ship.
As it is not a sitting duck, after every shot the spaceship can randomly move +2-2.
For trainng purposes you might want to limit the outer spaces to 0-100.
Make sure the enemy does not wander off the training field.
Give warning if the user shoots out of space.
Keep track of the minimum and maximum number of hits (in a file).
7.17. Solution: improved color selector
Example 7-11. examples/arrays/color_selector.pl
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
my $color;
my $filename = "examples/colors.txt";
my $force;
GetOptions(
"color=s" => \$color,
"filename=s" => \$filename,
"force" => \$force,
) or exit;
open(my $fh, "<", $filename)
or die "Could not open ’$filename’ for reading: $!";
my @colors;
while (my $color = <$fh>) {
chomp $color;
40
Chapter 7. Lists and Arrays
@colors = (@colors, $color);
}
# we will have a much better solution than the above 5 lines
# but we have not learned it yet
if ($color and not $force) {
my $valid_color;
foreach my $c (@colors) {
if ($c eq $color) {
$valid_color = 1;
next;
}
}
if (not $valid_color) {
print "The color ’$color’ is not valid.\n";
$color = ”;
}
}
if (not $color) {
print "Please select a number:\n";
foreach my $i (0..$#colors) {
print "$i) $colors[$i]\n";
}
my $num =
chomp($num);
if (defined $colors[$num]) {
$color = $colors[$num];
} else {
print "Bad selection\n";
exit;
}
}
print "The selected color is $color\n";
41
Chapter 8. Advanced Arrays
8.1. The year 19100
First, let’s talk about time.
$t = time(); # 1021924103
# returns a 10 digit long number,
# the number of seconds since 00:00:00 UTC, January 1, 1970
$x = localtime($t); # returns a string like Thu Feb 30 14:15:53 2002
$z = localtime(); # returns the string for the current time
$z = localtime(time - 60*60*24*365);
# returns the string for a year ago, same time, well almost
@y = localtime($t); # an array of time values:
# 53 15 14 30 1 102 4 61 0
# the 9 values are the following:
# 0 1 2 3 4 5 6 7 8 (the index)
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
# The localtime function is aware of what is on the left side of the = sign !!!!
# OK but where does that 19100 come from ?
$mon 0..11
$min 0..59
$sec 0..60
$year YEAR-1900 # for example 2000-1900 = 100
# but people used "19$year" instead of 1900 + $year
# which is 19100 instead of 2000
gmtime is the same just gives the time as it is in Greenwich.
8.2. SCALAR and LIST Context
my @a = ("zero", "one", "two", "three");
my @b = @a; # LIST context
my $c = @a; # SCALAR context
if (@a) {
}
while (@a) {
42
Chapter 8. Advanced Arrays
}
8.3. Context Sensitivity
Every operator creates a ’context’ let’s see a few examples
Assignment to a scalar variable creates SCALAR context:
$x = localtime();
$x = @z;
$x = SCALAR
Assignment to an array creates LIST contex:
@y = localtime();
@y = @z;
@y = LIST
# Expressions providing SCALAR context
$x = SCALAR;
$y[3] = SCALAR;
8 + SCALAR
"Foo: " . SCALAR
if (SCALAR) { ... }
while (SCALAR) { ... }
scalar(SCALAR)
# Expressions providing LIST context:
@a = LIST;
($x, $y) = LIST;
($x) = LIST;
foreach $x (LIST) {...}
join ";", LIST
print LIST
# example
@a = qw(One Two Three);
print @a; # OneTwoThree" print LIST
print 0+@a; # 3 SCALAR + SCALAR
print scalar(@a); # 3 scalar(SCALAR)
see also perldoc -f function-name
8.4. Filehandle in scalar and list context
Example 8-1. examples/arrays/filehandle_in_context.pl
#!/usr/bin/perl
43
Chapter 8. Advanced Arrays
use strict;
use warnings;
my $file = "numbers.txt";
open(my $fh, ’<’, $file) or die "Could not open ’$file’";
# reading in SCALAR context (line by line) and processing each line
while (my $row = <$fh>) {
chomp $row;
print "READ: $row\n";
}
open (my $other_fh, ’<’, $file) or die "Could not open ’$file’";
# reading in LIST context all the lines at once
my @rows = <$other_fh>;
chomp @rows;
print "READ " . @rows . " lines\n";
8.5. slurp mode
Example 8-2. examples/arrays/slurp.pl
#!/usr/bin/perl
use strict;
use warnings;
my $file = "numbers.txt";
# slurp mode
my $all;
{
open(my $fh, ’<’, $file) or die "Could not open ’$file’\n";
local $/ = undef;
$all = <$fh>;
}
8.6. File::Slurp
Example 8-3. examples/arrays/file_slurp.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Slurp qw(slurp);
44
Chapter 8. Advanced Arrays
my $filename = shift or die "Usage: $0 FILENAME\n";
my $text = slurp($filename);
8.7. pop, push
There are several functions working on arrays:
pop and push implement a LIFO stack.
pop fetches the last element of the array
returns that value and the array becomes one shorter
if the array was empty pop returns undef
LAST = pop ARRAY;
push is the opposite of pop it adds element(s) to the end of the array
It returns number of elements after the push.
PUSH ARRAY, SCALAR, ... (more SCALARs);
Example:
Example 8-4. examples/arrays/pop_push.pl
#!/usr/bin/perl
use strict;
use warnings;
my @names = ("Foo", "Bar", "Baz");
my $last_name = pop @names;
print "$last_name\n"; # Baz
print "@names\n"; # Foo Bar
push @names, "Moo";
print "@names\n"; # Foo Bar Moo
8.8. stack (pop, push)
Example 8-5. examples/arrays/reverse_polish_calculator.pl
#!/usr/bin/perl
use strict;
45
Chapter 8. Advanced Arrays
use warnings;
my @stack;
while (1) {
print ’$ ’;
my $in =
chomp $in;
if ($in eq "x") { last; }
if ($in eq "q") { last; }
if ($in eq "c") {
pop @stack;
next;
} # fetch the last value
if ($in eq "*") {
my $x = pop(@stack);
my $y = pop(@stack);
push(@stack, $x*$y);
next;
}
if ($in eq "+") {
my $x = pop(@stack);
my $y = pop(@stack);
push(@stack, $x + $y);
next;
}
if ($in eq "/") {
my $x = pop(@stack);
my $y = pop(@stack);
push(@stack, $y / $x);
next;
}
if ($in eq "-") {
my $x = pop(@stack);
my $y = pop(@stack);
push(@stack, $y - $x);
next;
}
if ($in eq "=") {
print pop(@stack), "\n";
next;
}
push @stack, $in;
}
46
Chapter 8. Advanced Arrays
8.9. shift, unshift
shift and unshift are working on the beginning (left side) of the array.
shift fetches the first element of an array.
It returns the fetched element and the whole array becomes one shorter and moved
to the left. Returns undef if the array was empty.
unshift adds element(s) to the beginning of an array
returns number of elements in the array after the addition
Example:
Example 8-6. examples/arrays/shift_unshift.pl
#!/usr/bin/perl
use strict;
use warnings;
my @names = ("Foo", "Bar", "Baz");
my $first = shift @names;
print "$first\n"; # Foo
print "@names\n"; # Bar Baz
unshift @names, "Moo";
print "@names\n"; # Moo Bar Baz
FIRST = shift ARRAY;
unshift ARRAY, VALUEs;
8.10. queue (shift, push)
Example 8-7. examples/arrays/queue.pl
#!/usr/bin/perl
use strict;
use warnings;
my @people = ("Foo", "Bar");
while (@people) {
my $next_person = shift @people;
print "$next_person\n"; # do something with this person
print "Type in more people:";
while (my $new =
47
Chapter 8. Advanced Arrays
chomp $new;
push @people, $new;
}
print "\n";
}
8.11. shift
Example 8-8. examples/arrays/shift_argv.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "Usage: $0 FILENAME\n";
shift defaults to shift @ARGV
Another usage of the short circuit
Slight bug (what of the first argument is 0 or the empty string ?
Does it matter?
8.12. sort, reverse
my @reverses_names = reverse @names;
my @sorted_names = sort @names;
8.13. Advanced sort
Example 8-9. examples/arrays/sort.pl
#!/usr/bin/perl
use strict;
use warnings;
my @data = (11, 23, 12);
my @sorted = sort @data;
my @sorted_ascii = sort {$a cmp $b} @data;
my @sorted_numeric = sort {$a <=> $b} @data;
48
Chapter 8. Advanced Arrays
my @sorted_by_length
= sort {length($a) <=> length($b)} @data;
my @sorted_by_length_and_ascii
= sort {
length($a) <=> length($b)
or
$a cmp $b
} @data;
my @sorted_by_abc = sort {lc($a) cmp lc($b)} @data;
my @sorted_abc_ascii
= sort {
lc($a) cmp lc($b)
or
$a cmp $b
} @data;
8.14. Ternary operator
my $var;
if (T) {
$var = A;
} else {
$var = B;
}
my $var = T ? A : B;
8.15. Count digits
Example 8-10. examples/arrays/count_digits.txt
23 34 9512341
3 34 2452345 5353 67 22
42136357013412
42 5 65 64
Example 8-11. examples/arrays/count_digits.pl
#!/usr/bin/perl
use strict;
use warnings;
49
Chapter 8. Advanced Arrays
my $filename = shift or die "Usage: $0 filename\n";
my @count;
open(my $fh, "<", $filename)
or die "Could not open ’$filename’: $!";
while (my $line = <$fh>) {
chomp $line;
my @chars = split "", $line;
foreach my $c (@chars) {
if ($c ne " ") {
$count[$c]++;
}
}
}
foreach my $i (0..9) {
print "$i ", ($count[$i] ? $count[$i] : 0), "\n";
}
8.16. $_
Default variable
foreach my $name (@people) {
print $name;
}
foreach (@people) {
print;
}
foreach $_ (@people) {
print $_;
}
8.17. Diamond operator
Example 8-12. examples/arrays/diamond.pl
#!/usr/bin/perl
use strict;
use warnings;
while (my $line = <>) {
print $line;
50
Chapter 8. Advanced Arrays
}
8.18. Exercise: median and standard deviation
Now compute the median and the standard deviation of the numbers given in the earlier example.
Median:
if there are odd number of values then - after sorting them - pick the one in the middle.
if there are even number of values, took the 2 in the middle and compute their average
Standard deviation:
sum (for each i) (Xi-average) * (Xi-average)
divide by n (the number of elements)
take the square root of the result
8.19. Exercise: sort mixed string
In a file we have the following strings: A1 A27 A38 B1 ...
each string has a letter at the beginning and then a number.
Sort them first based on the first letter and among values with the same
leading letter sort them according to the numbers.
File:
Example 8-13. examples/arrays/sort_mixed_strings.txt
A1
A27
C1
B1
B12
A38
B3
A3
8.20. Solution: median and standard deviation
Example 8-14. examples/arrays/statistics_more.pl
#!/usr/bin/perl
use strict;
use warnings;
51
Chapter 8. Advanced Arrays
my @data =
chomp @data;
@data = sort { $a <=> $b } @data;
if (not @data) {
print "No values were given\n";
exit;
}
my $total = 0;
foreach my $v (@data) {
$total += $v;
}
my $average = $total / @data;
my $median = @data % 2 ? $data[(@data-1)/2]
: ($data[@data/2-1]+$data[@data/2])/2
;
my $sqtotal = 0;
foreach my $v (@data) {
$sqtotal += ($average-$v) ** 2;
}
my $std = ($sqtotal / @data) ** 0.5;
print "Min: $data[0] Max: $data[-1] Total: $total count: "
. @data . " Average: $average\n";
print "Median: $median $sqtotal Standard deviation: $std\n";
8.21. Solution: sort mixed strings
Example 8-15. examples/arrays/sort_mixed_strings.pl
#!/usr/bin/perl
use strict;
use warnings;
my $file = ’sort_mixed_strings.txt’;
if (@ARGV) {
$file = shift;
}
open(my $fh, ’<’, $file) or die "Could not open ’$file’\n";
my @data = <$fh>;
chomp @data;
52
Chapter 8. Advanced Arrays
my @sorted = sort {
substr($a, 0, 1) cmp substr($b, 0, 1)
or
substr($a, 1) <=> substr($b, 1) } @data;
foreach my $v (@sorted) {
print "$v\n";
}
8.22. grep
Example 8-16. examples/arrays/grep_perl.pl
#!/usr/bin/perl
use strict;
use warnings;
my @numbers = (1..30);
my @odd_numbers = grep { $_ % 2 } @numbers;
foreach my $num (@odd_numbers) {
print "$num\n";
}
8.23. map
Example 8-17. examples/arrays/map_perl.pl
#!/usr/bin/perl
use strict;
use warnings;
my @numbers = (1..30);
my @doubles = map {$_ * 2} @numbers;
foreach my $num (@doubles) {
print "$num\n";
}
8.24. List::Util
List::Util provides functions such as
• max
53
Chapter 8. Advanced Arrays
• min
• sum
It resides in a distribution called Scalar::List::Utils http://search.cpan.org/dist/Scalar-List-Utils
8.25. Advanced: Multi dimensional array
Example 8-18. examples/arrays/matrix.pl
#!/usr/bin/perl
use strict;
use warnings;
my @matrix;
$matrix[0][0] = 0;
$matrix[1][1] = 11;
$matrix[1][2] = 12;
#print "$matrix\n";
print "$matrix[0]\n"; # ARRAY(0x814dd90)
print "$matrix[1][1]\n"; # 11
use Data::Dumper qw(Dumper);
print Dumper \@matrix;
Actually what we have is a simple array and each element of that
array can be another (anonymous) array (reference).
8.26. splice
Removes the elements designated by OFFSET and LENGTH (and returns them).
Replaces them with the content of the 4th parameter.
Example 8-19. examples/arrays/splice.pl
#!/usr/bin/perl
use strict;
use warnings;
my @names = qw(Foo Bar Baz Moo Qux Barney Hoppy Bammbamm Dino);
my @more_names = qw(Fred Wilma);
54
Chapter 8. Advanced Arrays
my @sublist = splice(@names, 2, 3);
print "@sublist\n"; # Baz Moo Qux
print "@names\n"; # Foo Bar Barney Hoppy Bammbamm Dino
my @zlist = splice(@names, 2, 3, @more_names);
print "@zlist\n"; # Barney Hoppy Bammbamm
print "@names\n"; # Foo Bar Fred Wilma Dino
55
Chapter 9. Functions and Subroutines
9.1. Subroutines
Example 9-1. examples/subroutines/subroutines.pl
#!/usr/bin/perl
use strict;
use warnings;
my $sum = add(2, 3);
print "$sum\n";
print add(5, 8), "\n";
my $result = add2(4, 7);
print "$result\n";
print sum(3, 7, 11, 21), "\n";
sub add {
my ($x, $y) = @_;
my $z = $x+$y;
return $z;
}
sub add2 {
my $x = shift;
my $y = shift;
return $x+$y;
}
sub add_ugly {
return $_[0]+$_[1];
}
sub sum {
my $sum = 0;
foreach my $v (@_) {
$sum += $v;
}
return $sum;
}
56
Chapter 9. Functions and Subroutines
9.2. Recoursive subroutines
Example 9-2. examples/subroutines/factorial.pl
#!/usr/bin/perl
use strict;
use warnings;
my $n = shift or die "Usage: $0 NUMBER\n";
my $result = factorial($n);
print $result;
sub factorial {
my ($n) = @_;
if ($n == 1) {
return 1;
}
my $prev = factorial($n - 1);
return $n * $prev;
}
Example 9-3. examples/subroutines/fibonacci_recoursive.pl
#!/usr/bin/perl
use strict;
use warnings;
sub fib {
my $n = shift;
if ($n == 0 or $n == 1) {
return 1
}
return (fib($n-1)+fib($n-2)); # recursive calling
}
print fib(10); # calling the function
9.3. Sort using a function
Example 9-4. examples/subroutines/sort_with_function.pl
#!/usr/bin/perl
use strict;
use warnings;
my @data = (23, 1, 12, 3, 48);
57
Chapter 9. Functions and Subroutines
my @sorted = sort by_number @data;
print "@data\n";
print "@sorted\n";
sub by_number {
return $a <=> $b;
}
9.4. Return a list
Perl allows us to return any number of values.
Example 9-5. examples/subroutines/fibonacci.pl
#!/usr/bin/perl
use strict;
use warnings;
my @numbers = fib(10);
print "@numbers\n";
sub fib {
my $num = shift;
my @fib;
if ($num == 1) {
return (1);
}
if ($num == 2) {
return (1, 1);
}
@fib = (1, 1);
foreach (3..$num) {
push @fib, $fib[-1]+$fib[-2];
}
return @fib;
}
9.5. Error handling with eval
Example 9-6. examples/subroutines/eval.pl
#!/usr/bin/perl
use strict;
use warnings;
58
Chapter 9. Functions and Subroutines
my $result;
my $x = 19;
my $y = 23;
eval {
$result = unstable_add_function($x, $y);
print "unstable done\n";
};
if ($@) {
chomp $@;
warn "Exception ’$@’ received\n";
$result = slow_but_stable_add($x, $y);
print "slow done\n";
}
print "Result: $result\n";
sub unstable_add_function {
if (rand() < 0.2) {
die "broken";
}
return $_[0]+$_[1];
}
sub slow_but_stable_add {
sleep (2);
return $_[0]+$_[1];
}
59
Chapter 10. Associative Arrays (Hashes)
10.1. What is a hash?
• Unordered group of key/value pairs where
• key is a unique string
• value is any scalar
10.2. Uses of hashes
Mapping of single feature of many similar items:
• phone book (name => phone number)
• worker list (ID number => name)
• CGI: (fieldname => field value)
Features of an object:
• Information about a person (fname, lname, email, phone, ...)
10.3. Creating hashes
my %user;
%user = ("fname", "Foo", "lname", "Bar");
my %user = (
"fname", "Foo",
"lname", "Bar",
);
my %user = (
fname => "Foo",
lname => "Bar",
);
print $user{fname}, "\n";
$user{fname} = ’Moo’;
$user{email} = ’foo@bar.com’;
60
Chapter 10. Associative Arrays (Hashes)
10.4. Create hash from an array
my @person = qw(fname Foo lname Bar);
my %user = @person;
my @foobar = %user;
print "@foobar\n"; # fname Foo lname Bar
$user{phone} = ’123-456’;
%user = (phone => ’123-456’); # removes all previous elements from the hash
10.5. Hash in scalar context
Previously we saw that a hash in LIST context returns its keys and values.
In SCALAR context:
if (%h) {
# the hash is not empty
}
10.6. Fetching data from hash
my @fields = keys %user;
foreach my $field (@fields) {
print "$field $user{$field}\n";
}
foreach my $field (keys %user) {
print "$field $user{$field}\n";
}
my @fields = keys %user;
my @sorted_fields = sort @fields;
foreach my $field (@sorted_fields) {
print "$field $user{$field}\n";
}
foreach my $field (sort keys %user) {
print "$field $user{$field}\n";
}
61
Chapter 10. Associative Arrays (Hashes)
10.7. exists, delete hash element
my %phones;
$phones{Foo} = ’111’;
$phones{Bar} = ’222’;
$phones{Moo} = undef;
if (exists $phones{Foo}) {
if (defined $phones{Foo}) {
}
}
delete $phones{Foo};
10.8. Multi dimensional hashes
Example 10-1. examples/hashes/grades.pl
#!/usr/bin/perl
use strict;
use warnings;
my %grades;
$grades{"Foo Bar"}{Mathematics} = 97;
$grades{"Foo Bar"}{Literature} = 67;
$grades{"Peti Bar"}{Literature} = 88;
$grades{"Peti Bar"}{Mathematics} = 82;
$grades{"Peti Bar"}{Art} = 99;
foreach my $name (sort keys %grades) {
foreach my $subject (keys %{$grades{$name}}) {
print "$name, $subject: $grades{$name}{$subject}\n";
}
}
10.9. Dumping hashes
use Data::Dumper qw(Dumper);
print Dumper \%grades;
$VAR1 = {
’Peti Bar’ => {
’Art’ => 99,
’Literature’ => 88,
’Mathematics’ => 82
},
62
Chapter 10. Associative Arrays (Hashes)
’Foo Bar’ => {
’Literature’ => 67,
’Mathematics’ => 97
}
};
10.10. Count words
• %hash, $hash{element}
• keys
Example 10-2. examples/hashes/count_words_hash.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "Usage: $0 filename\n";
my %count;
open(my $fh, "<", $filename)
or die "Could not open ’$filename’: $!";
while (my $line = <$fh>) {
chomp $line;
my @words = split " ", $line;
foreach my $word (@words) {
$count{$word}++;
}
}
foreach my $word (keys %count) {
print "$word : $count{$word}\n";
}
10.11. Exercise: Parse HTTP values
You get one line like the following:
fname=Foo&lname=Bar&phone=123&email=foo@bar.com
Build a hash table from it so:
print $h{fname}; # Foo
print $h{lname}; # Bar
...
63
Chapter 10. Associative Arrays (Hashes)
10.12. Exercise: Improve the color selector
In the external file where we defined the colors, for each color
keep also a character that will be used to display the menu:
File:
yellow y
brown z
black b
blue e
When displaying the menu show:
y) yellow
z) brown
b) black
e) blue
and wait till the user selects the appropriate letter.
10.13. Exercise: Display scores
Read in a file where on each line there is a name and a score
with a comma between them.
Print them sorted based on name.
Then also print sorted based on score.
Example 10-3. examples/hashes/score_data.txt
Foo,23
Bar,70
Baz,92
Bozo,17
Gozo,52
Dardon,20
Mekodra,23
10.14. Exercise: Analyze Apache log file
In the files section earlier we had a an example counting
how many hist came from localhost and from other places.
Please improve that analyzer to provide a report:
which client IP addresse were used and how many hits were from
64
Chapter 10. Associative Arrays (Hashes)
each IP adddress.
The log file can be found here:
examples/files/apache_access.log
10.15. Exercise: Parse variable width fields
Example 10-4. examples/hashes/variable_width_fields.log
# In a log file there are rows in which the first 16 and last 16 characters
# describe addresses while everything in between describes several commands
# Each command is built up by a leading character (A, B, C, D, etc) and a number
# of digits. The number of digits depend on the leading character.
#
# In this example we split up the data to commands and count how many times
# each command type was given.
#
1234567890123456A001B0002D00004C0000051234567890123456
1234567890123456A001A002D00004C0000051234567890123456
10.16. Solution: Parse HTTP values
Example 10-5. examples/hashes/split_http.pl
#!/usr/bin/perl
use strict;
use warnings;
my $str = ’fname=Foo&lname=Bar&email=foo@bar.com’;
my @pairs = split "&", $str;
my %data;
foreach my $p (@pairs) {
my ($k, $v) = split "=", $p;
$data{$k} = $v;
}
use Data::Dumper;
print Dumper \%data;
65
Chapter 10. Associative Arrays (Hashes)
10.17. Solution: Improve the color selector
Example 10-6. examples/hashes/color_selector_file.pl
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
my $color;
my $filename = "examples/color_map.txt";
my $force;
GetOptions(
"color=s" => \$color,
"filename=s" => \$filename,
"force" => \$force,
);
my %colors;
open(my $fh, "<", $filename)
or die "Could not open ’$filename’ for reading: $!";
while (my $line = <$fh>) {
chomp $line;
my ($color_name, $letter) = split " ", $line;
if ($colors{$letter}) {
warn
sprintf "%s appears to be allocated to both %s and %s\n",
$letter, $colors{$letter}, $color_name
} else {
$colors{$letter} = $color_name;
}
}
if ($color and not $force) {
my $valid_color;
foreach my $c (values %colors) {
if ($c eq $color) {
$valid_color = 1;
next;
}
}
if (not $valid_color) {
print "The color ’$color’ is not valid.\n";
$color = ”;
}
}
if (not $color) {
print "Please select a number:\n";
66
Chapter 10. Associative Arrays (Hashes)
foreach my $k (sort keys %colors) {
print "$k) $colors{$k}\n";
}
my $letter =
chomp($letter);
if ($colors{$letter}) {
$color = $colors{$letter};
} else {
print "Bad selection\n";
exit;
}
}
print "The selected color is $color\n";
10.18. Solution: Display scores
Example 10-7. examples/hashes/score_data.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "Usage: $0 FILENAME\n";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
my %score_of;
while (my $line = <$fh>) {
chomp $line;
my ($name, $score) = split ",", $line;
$score_of{$name} = $score;
}
foreach my $name (sort keys %score_of) {
printf "%-10s %s\n", $name, $score_of{$name};
}
print "--------------------------\n";
foreach my $name (sort {
$score_of{$b} <=> $score_of{$a}
} keys %score_of) {
printf "%-10s %s\n", $name, $score_of{$name};
}
67
Chapter 10. Associative Arrays (Hashes)
10.19. Solution: Analyze Apache log file
Example 10-8. examples/hashes/apache_log_hosts_hash.pl
#!/usr/bin/perl
use strict;
use warnings;
my $file = shift or die "Usage: $0 FILENAME (examples/files/apache_access.log)\n";
open my $fh, ’<’, $file or die $!;
my %count;
while (my $line = <$fh>) {
chomp $line;
my $length = index ($line, " ");
my $ip = substr($line, 0, $length);
$count{$ip}++;
}
foreach my $ip (keys %count) {
print "$ip $count{$ip}\n";
}
10.20. Solution: Parse variable width fields
Example 10-9. examples/hashes/parse_variable_width_fields.pl
#!/usr/bin/perl
use strict;
use warnings;
my %count;
my %length = (
A => 3,
B => 4,
C => 6,
D => 5,
);
my $filename = "examples/hashes/variable_width_fields.log";
if ($ARGV[0]) {
$filename = $ARGV[0];
}
open my $data, ’<’, $filename or die "Could not open ’$filename’ $!";
LINE:
while (my $line = <$data>) {
chomp $line;
68
Chapter 10. Associative Arrays (Hashes)
if (substr($line, 0, 1) eq "#") {
next;
}
#print $line;
my $cmds = substr($line, 16, -16);
#print $cmds;
while ($cmds) {
my $c = substr($cmds,0,1, "");
#print "$c\n";
#print "$cmds\n";
if (not defined $length{$c}) {
warn "....";
next LINE;
}
my $cmd = substr($cmds,0, $length{$c}, "");
$count{$c}++;
print "$c : $cmd\n";
}
}
print "-" x 80, "\n";
foreach my $c (keys %count) {
print "$c $count{$c}\n";
}
69
Chapter 11. Regular Expressions
11.1. What are regexes good for ?
• Decide if a string is part of a larger string
• Validate the format of some value (string) (e.g. is it a decimal number?, is it a hex?)
• Find if there are repetitions in a string
• Analyse a string and fetch parts of if given some loose description
11.2. Examples
Which one is a number: 23, 2.3 2.3.4 2.4e3 abc ?
Is there a word in the file that is repeated 3 or more times?
Replaces all occurances of Perl or perl by Java ...
... but avoid replacing Perla.
11.3. Introduction to Regexes
my $str = "Some string here";
if ($str =~ /ome/) {
print "There is a match\n";
}
if ($str !~ /s r/) {
print "No match\n";
}
11.4. Find a string in a file
Example 11-1. examples/regex/find_string.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "$0 FILENAME\n";
70
Chapter 11. Regular Expressions
open my $fh, ’<’, $filename or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
if ($line =~ /REGEX/) {
print $line;
}
}
11.5. Tools
Regex Coach: http://weitz.de/regex-coach/
11.6. Regex Examples: single character
Any line that has an ’x’ in it.
Regex: /x/
Input: "abcde"
Input: "abxcde"
Input: "xabcde"
Any line that starts with an ’x’.
Regex: /^x/
Input: "abcde"
Input: "abxcde"
Input: "xabcde"
Input: " xabcde"
^ at the beginning of the regular expression means, match at the beginning of the string.
11.7. Regex Examples dot (.)
Any line that has any of the xax, xbx, ..., that is any character between two x-es.
Regex: /x.x/
Input: "abcde"
Input: "abxcxbde"
Input: "xabcde"
Input: "xabxcxde"
1
Chapter 11. Regular Expressions
Any line that has x.x (A real . between two x-es.)
Regex: /x\.x/
The special characters are: . * + ? ^ $ \ ( ) [ ] | { } and the delimiter: /
Some of the characters change their special meaning based on position.
11.8. Regex Examples (character class)
Any line that has any of the -a-, -b-, -c-, -d-, -e-, -f-, -@- or -.-
Regex: /-[abcdef@.]-/
Input: "ab -q- "
Input: "ab -z-a- "
Input: "ab -.- "
Input: "ab -- "
Regex: /-[a-f@.]-/
11.9. Regex Examples (^ in character class)
^ as the first character in a character class means "a character that is not listed in this character class"
Regex: /-[^abc]-/
Input: "abc -a- z"
Input: "abc -z- z"
11.10. Regex Examples quantifiers
Any line with two - -es with anything in between.
Regex: /-.*-/
Input: "ab"
2
Chapter 11. Regular Expressions
Input: "ab - cde"
Input: "ab - qqqrq -"
Input: "ab -- cde"
Input: "--"
11.11. Quantifiers
Quantifiers apply to the thing in front of them
/ab*a/ # aa, aba, abba, abbba, ...
/ab+a/ # aba, abba, abbba, ...
/ab?a/ # aa, aba
/ab{2,4}a/ # abba, abbba, abbbba
/ab{3,}a/ # abbba, abbbba, ...
/ab{17}a/ # abbbbbbbbbbbbbbbbba
Table 11-1. Quantifiers
* 0-
+ 1-
? 0-1
{n,m} n-m
{n,} n-
{n} n
11.12. Quantifiers on character classes
Regex: /-[abc]-/
Input: "-a-" OK
Input: "-b-" OK
Input: "-x-"
Input: "-ab-"
Regex: /-[abc]+-/
Input: "-a-" OK
Input: "-b-" OK
Input: "-ab-" OK
Input: "-aa-" OK
Input: "-x-"
3
Chapter 11. Regular Expressions
11.13. Exercises: Regular expressions
Pick up a vocabulary. Based on the following template write a script that
prints out every word from the list of words
(see examples/regex/dict.txt ) that
• has an ’a’
• starts with an ’a’
• has ’th’
• has an ’a’ or an ’A’
• has a ’*’ in it
• starts with an ’a’ or an ’A’
• has both ’a’ and ’e’ in it
• has an ’a’ followed by an ’e’ somewhere in it
• does not have an ’a’
• does not have an ’a’ nor ’e’
• has an ’a’ but not ’e’
• has at least 2 consequtive vowels (a,e,i,o,u)
• has at least 3 vowels
• has at least 6 characters
• has at exactly 6 characters
• Bonus: all the words with either ’aba’ or ’ada’ in them
• Bonus: all the words with either ’aba’ or ’eda’ in them
• Bonus: has a double character (e.g. ’oo’)
• Bonus: for every word print the first vowel
Example 11-2. examples/regex/regex_exercise.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "$0 FILENAME\n";
open my $fh, ’<’, $filename or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
if ($line =~ /REGEX1/) {
print "has an a: $line";
}
if ($line =~ /REGEX2/) {
4
Chapter 11. Regular Expressions
print "starts with an a: $line";
}
}
11.14. Solutions: Regular expressions
• /a/
• /^a/
• /th/
• /[aA]/
• /\*/
• another solution: /[*]/
• /^[aA]/
• $str =~ /a/ and $str =~ /e/
• /a.*e/
• $str !~ /a/
• $str !~ /[ae]/
• $str =~ /a/ and $str !~ /e/
• /[aeiou]{2}/
• /[aeiou].*[aeiou].*[aeiou]/
• /....../ /.{6}/
• length($str) == 6
11.15. Grouping, alternatives
Bonus: all the words with either ’aba’ or ’ada’ in them
Bonus: all the words with either ’aba’ or ’eda’ in them
/a[bd]a/
if ($line =~ /aba/ or $line =~ /eda/) {
}
if ($line =~ /aba|eda/) {
}
if ($line =~ /(ab|ed)a/) {
}
5
Chapter 11. Regular Expressions
11.16. Capturing
Bounus: for every word print the first vowel
if ($line =~ /([aeiou])/) {
print $1;
}
Bonus: has a double character (e.g. ’oo’)
Input: "my loop"
/.o/
/(.)o/
if ($line =~ /(.)\1/) {
print $1;
}
/(.+).*\1/ # lines with anything more than once
/((.+).*\1)+/ # Syntax error ! Why ?
if ($line =~ /(.*)=(.*)/) {
print "left: $1\n";
print "right: $2\n";
}
11.17. Anchors
^ # at the beginning of the pattern means beginning of the string
$ # at the end of the pattern means the end of the string
/the/ # matches anywhere in the string: "atheneum", "thermostat", "the", /^the/ # matches only if the string starts with the "thermostat", "the"
/the$/ # matches only if the string ends with the "the", "mathe"
/^the$/ # matches only if the string "the"
/^\s*$/ # the string contains only white spaces (it looks like an empty string)
\b # Word delimiter
/\bstruct\b/ # match every place the word "struct" but not "structure" or "construct"
/\b\w+\b/ # A single "word"
11.18. Character classes
A list of optional characters within square brackets []
6
Chapter 11. Regular Expressions
/a[bc]a/ # aba, aca
/a[2#=x?.]a/ # a2a, a#a, a=a, axa, a?a, a.a
# inside the character class most of the spec characters lose their
# special meaning BUT there are some new special characters
/a[2-8]a/ # is the same as /a[2345678]a/
/a[2-]a/ # a2a, a-a - has no special meaning at the ends
/a[-8]a/ # a8a, a-a
/a[6-C]a/ # a6a, a7a ... aCa characters from the ASCII table: 6789:;<=>?@ABC
/a[C-6]a/ # syntax error
/a[^xa]a/ # "aba", "aca" but not "aaa", "axa" what about "aa" ?
# ^ as the first character in a character class means
# a character that is not in the list
/a[a^x]a/ # aaa, a^a, axa
11.19. Special character classes
Table 11-2. Special character classes
Expression Meaning
\w Word characters: [a-zA-Z0-9_] (but \w is locale
dependent)
\d Digits: [0-9]
\s [\f\t\n\r ] form-feed, tab, newline, carriage return
and SPACE
\W [^\w]
\D [^\d]
\S [^\s]
[:class:] POSIX character classes (alpha, alnum...)
\p{...} Unicode definitions (IsAlpha, IsLower, IsHebrew,
...)
See also perldoc perlre and perldoc perluniintro
11.20. Exercise: Number
Write a function that given a string it return true if the string is a number.
First define what do you mean by a number?
Non negative integer?
Integer?
Real number?
In scientific notation?
7
Chapter 11. Regular Expressions
11.21. Exercise: Hex/Oct/Bin
Write functions that return true if the given value is a
1) Hexadecimal number
2) Octal number
3) Binary number
11.22. Exercise: Roman numbers
Write functions that return true if the given value is a Roman Number.
If you can do that maybe write another function to return the decimal
value of the given number.
I, II, III, IV, V, VI, VII,....
I = 1
V = 5
X = 10
L = 50
C = 100
D = 500
M = 1000
11.23. Solution: Number
Example 11-3. examples/regex/is_number.pl
#!/usr/bin/perl
use strict;
use warnings;
while (my $number =
if (is_non_negative($number)) {
print "non negative integer without +- sign\n"; # 0, 3, 7
}
if (is_integer($number)) {
print "integer with optional +- sign\n"; # -1, +3
}
if (is_real($number)) {
print "real number with decimal point\n"; # 3.1, 0.0, .3, 2., -.7
}
if (is_exp($number)) {
print "exponential format\n"; # .1e
}
if (is_exp2($number)) {
print "exponential format (x)\n"; # .1e
}
}
8
Chapter 11. Regular Expressions
sub is_non_negative { $_[0] =~ /^\d+$/ }
sub is_integer { $_[0] =~ /^[+-]?\d+$/ }
sub is_real { $_[0] =~ /\d/ and $_[0] =~ /^[+-]?\d*\.?\d*$/}
sub is_exp { $_[0] =~ /\d/ and $_[0] =~ /^[+-]?\d*\.?\d*(e[+-]?\d+)?$/}
sub is_exp2 { $_[0] =~ /\d/ and $_[0] =~ /^
[+-]? # optional + or - sign
\d* # 0 or more digits before the decimal point
\.? # optional decimal point
\d* # 0 or more digits after the decimal point
(e[+-]?\d+)? # optional "e" followed by an integer number
$/x}
11.24. Solution: Hex/Oct/Bin
Example 11-4. examples/regex/is_base_number.pl
#!/usr/bin/perl
use strict;
use warnings;
while (my $number =
if (is_hex($number)) {
print "Hexadecimal number\n"; # 0xAD37F
}
if (is_octal($number)) {
print "Octal number\n"; # 02432471
}
if (is_binary($number)) {
print "Binary number\n"; # 0b01110
}
}
sub is_hex { $_[0] =~ /^0x[\da-fA-F]+$/ }
sub is_octal { $_[0] =~ /^0[0-7]+$/ }
sub is_binary { $_[0] =~ /^0b[01]+$/ }
11.25. Solution: Roman numbers
Example 11-5. examples/regex/is_roman_number.pl
#!/usr/bin/perl
use strict;
use warnings;
while (my $number =
# This solution only check is the string consists of characters used in as Roman numbers
9
Chapter 11. Regular Expressions
# but does not check if the number is actually a valid number. (e.g. IVI is not valid)
# I yet to see a definition on how to validate a Roman number.
if (is_roman($number)) {
print "Roman number\n";
}
}
sub is_roman { $_[0] =~ /^[IVXLCDM]+$/ }
sub is_roman2 { $_[0] =~ /^(M{0,4})(CM|CD|D?C{0,3})(XL|XC|L?X{0,3})(IV|IX|V?I{0,3})$/ }
11.26. Regexp::Common
Example 11-6. examples/regex/regexp_common.pl
#!/usr/bin/perl
use strict;
use warnings;
use Regexp::Common;
my $file = ’regexp_common.txt’;
if (@ARGV) {
$file = shift;
}
open(my $data, ’<’, $file) or die "Could not open $file\n";
while (my $line = <$data>) {
chomp $line;
print "LINE: ’$line’";
if ($line =~ /$RE{balanced}{-parens=>’()’}/) {
print " balanced parentheses";
}
if ($line =~ /^$RE{lingua}{palindrome}$/) {
print " a palindrome";
}
if ($line =~ /$RE{profanity}/) {
print " a four letter word";
}
print "\n";
}
Example 11-7. examples/regex/regexp_common.txt
one
(two)
(three))
((three)
80
Chapter 11. Regular Expressions
)four(
poop
11.27. Options and modifiers
// is actually the same as m//
When using the m sign you can change the delimiters:
Let’s say you would like to match lines with
/usr/bin/perl
if ($line =~ /\/usr\/bin\/perl/) {
}
if ($line =~ m{/usr/bin/perl}) {
}
11.28. /i Case sensitivity
$line = "Apple";
/apple/ # does not match
/apple/i # case insensitive will match
11.29. /m multiple lines
^ will match beginning of line
$ will match end of line
\A still matches beginning of string
\z
\Z
Example 11-8. examples/regex/find_letter_change.pl
#!/usr/bin/perl
use strict;
use warnings;
#../regex/examples/text/american-english
my $filename = shift or die;
my $data;
{
81
Chapter 11. Regular Expressions
open my $fh, ’<’, $filename or die;
local $/ = undef;
$data = <$fh>
}
if ($data =~ /(^a.*\nb.*\n)/mi) {
print $1;
}
11.30. /s single line
. will match any character (including newline)
11.31. /x enable whitespaces and comments
/(X\d+).*\1/
/
(X\d+) # product number
.* # any character
\1 # the same product number
/x
11.32. Substitute
• s/PATTERN/REPLACEMENT/
$line = "abc123def";
$line =~ s/\d+/ /; # "abc def"
$line =~ s/([a-z]*)(\d*)([a-z]*)/$3$2$1/; # "def123abc"
$line =~ s/.../x/; # "x123def";
$line =~ s/.../x/g; # "xxx";
$line =~ s/(.)(.)/$2$1/; # "bac123def"
$line =~ s/(.)(.)/$2$1/g; # "ba1c32edf"
82
Chapter 11. Regular Expressions
11.33. Greedy quantifiers
/xa*/ on xaaab
/xa*/ on xabxaab
/a*/ on xabxaab
11.34. minimal match
/a.*b/ axbzb matches axbzb
/a.*?b/ axbzb matches axb as the * quantifier is minimal now
/a.*b/ axy121413413bq
/a.*?b/ axy121413413bq
They both match the same string
11.35. Replace spaces
s/^\s*// leading
s/\s*$// tailing
Better to write:
s/^\s+// leading
s/\s+$// tailing
both ends:
s/^\s*(.*)\s*$/$1/ " abc " => "abc " because of the greediness
s/^\s*(.*?)\s*$/$1/ " abc " => "abc" minimal match
11.36. Replace string in assembly code
Example 11-9. examples/regex/assembly_source.txt
mv A, R3
mv R2, B
mv R1, R3
mv B, R4
add A, R1
add B, R1
add R1, R2
add R3, R3
mv X, R2
83
Chapter 11. Regular Expressions
Example 11-10. examples/regex/assembly_process.pl
#!/usr/bin/perl
use strict;
use warnings;
# assuming there are no R4 values then 4 substitutions will do
s/R1/R4/g
s/R3/R1/g
s/R2/R3/g
s/R4/R2/g
# or without any assumption and in one substitution:
my %map = (
R1 => ’R2’,
R2 => ’R3’,
R3 => ’R1’,
);
s/(R[123])/$map{$1}/g
11.37. split with regular expresion
LIST = split REGEX, STRING;
Example 11-11. examples/regex/field_value_pairs.txt
fname = Foo
lname = Bar
email=foo@bar.com
Example 11-12. examples/regex/parse_field_value_pairs.pl
#!/usr/bin/perl
use strict;
use warnings;
# data: field_value_pairs.txt
my $filename = shift or die "Usage: $0 filename\n";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
while (my $line = <$fh>) {
chomp $line;
my ($field, $value) = split /\s*=\s*/, $line;
print "$value=$field\n";
}
84
Chapter 11. Regular Expressions
11.38. Exercise: split CGI
Given a string that looks like this:
my $str = ’fname=Foo&lname=Bar&email=foo@bar.com’;
Create a hash where the keys are fname, lname, email
11.39. Exercies: filename/dirname
Give a path like /home/foo/.mozilla/cache/data.txt
return the filename (data.txt)
return the full-path directory name ( /home/foo/.mozilla/cache )
11.40. Exercise: Sort SNMP numbers
Given a file with SNMP numbers (one number on every line)
print them in sorted order comparing the first number of
each SNMP number first.
If they are equal then comparing the second number, etc...
Example 11-13. examples/regex/snmp.txt
1.2.7.6
4.5.7.23
1.2.7
2.3.5.7.10.8.9
11.41. Exercise: parse hours log file and give report
The log file looks like this
Example 11-14. examples/regex/timelog.log
09:20 Introduction
11:00 Exercises
11:15 Break
11:35 Scalars
12:30 Lunch Break
13:30 Exercises
14:10 Solutions
14:30 Break
85
Chapter 11. Regular Expressions
14:40 Arrays
15:40 Exercises
17:00 Solutions
17:30 End
09:30 Advanced Arrays
10:30 Break
10:50 Exercises
12:00 Solutions
12:30 Hash fuction introduction
12:45 Lunch Break
14:15 Exercises
16:00 Solutions
16:15 Break
16:30 Subroutines
17:00 Exercises
17:30 End
the report should look something like this:
09:20-11:00 Introduction
11:00-11:15 Exercises
11:15-11:35 Break
...
Solutions 95 minutes 9%
Break 65 minutes 6%
...
11.42. Exercise: Parse ini file
An ini file has sections starting by the name of the section in square brackets and within
each section there are key = value pairs with optional spaces around the "=" sign.
The keys can only contain letters, numbers, underscore or dash.
In addition there can be empty lines and lines starting with # which are comments.
Given a filename, a section name and a key, please print out the value.
Example ini file:
Example 11-15. examples/regex/inifile.ini
# comment
[alpha]
base= moon
ship= alpha 3
86
Chapter 11. Regular Expressions
[earth]
# ?
base=earth
ship= x-wing
11.43. Exercise: parse perl file
Parse your perl files and print out the names of your variables.
In the first version print out the scalar variables only.
In the second version show all variables.
(you give the names of the files on the command line)
11.44. Solution: Split CGI
Example 11-16. examples/regex/split_cgi.pl
#!/usr/bin/perl
use strict;
use warnings;
my $str = ’fname=Foo&lname=Bar&email=foo@bar.com’;
my %data = split /[=&]/, $str;
use Data::Dumper;
print Dumper \%data;
11.45. Solution: filename/dirname
Example 11-17. examples/regex/file_basename.pl
#!/usr/bin/perl
use strict;
use warnings;
my $path = "/home/foo/.mozilla/cache/data.txt";
my $filename = ($path =~ m{([^/]*)$} ? $1 : "");
my $dirname = ($path =~ m{^(.*)/} ? $1 : "");
# Directory name:
print "$path\n";
87
Chapter 11. Regular Expressions
print "$filename\n";
print "$dirname\n";
use File::Basename;
print basename($path) . "\n";
print dirname($path) . "\n";
11.46. Solution: Sort SNMP numbers
Example 11-18. examples/regex/sort_snmp_numbers.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "Usage: $0 filename\n";
open(my $fh, "<", $filename) or die "Could not open ’$filename’\n";
my @snmps = <$fh>;
chomp @snmps;
print join "\n", @snmps;
print "\n------------------\n";
my @sorted_snmps = sort by_snmp_number @snmps;
print join "\n", @sorted_snmps;
sub by_snmp_number {
my @a = split /\./, $a;
my @b = split /\./, $b;
foreach my $i (0..@a-1) {
return 1 if $i >= @b;
next if $a[$i] == $b[$i];
return $a[$i] <=> $b[$i];
}
return 0;
}
print "\n------------------\n";
my @data = map { {"ip" => $_, "data" => [split /\./, $_]} } @snmps;
my @sorted_data = sort {g($a, $b)} @data;
my @sorted_snmps_take_two = map {$_->{ip}} @sorted_data;
print join "\n", @sorted_snmps_take_two;
print "\n------------------\n";
88
Chapter 11. Regular Expressions
sub g {
my ($a, $b) = @_;
my @a = @{ $a->{data} };
my @b = @{ $b->{data} };
foreach my $i (0..@a-1) {
return 1 if $i >= @b;
next if $a[$i] == $b[$i];
return $a[$i] <=> $b[$i];
}
return 0;
}
11.47. Solution: parse hours log file and give report
Example 11-19. examples/regex/timelog.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = shift or die "Usage: $0 filename\n";
my @entries;
my %stat;
open(my $fh, "<", $filename) or die "Could not open ’$filename’ $!";
while (my $line = <$fh>) {
chomp $line;
next if $line =~ /^#/;
if ($line =~ /\S/) {
push @entries, $line;
next;
}
process_day();
@entries = ();
}
process_day(); # in case there is no empty line after the last line
foreach my $title (keys %stat) {
printf "%-25s %4s minutes %3s%%\n",
$title, $stat{$title}, int(100 * $stat{$title} / $stat{Total});
}
sub process_day {
89
Chapter 11. Regular Expressions
my @day;
foreach my $e (@entries) {
my ($time, $title) = split " ", $e, 2;
if (@day) {
$day[-1]{end} = $time;
my ($start_hour, $start_min) = split ":", $day[-1]{start};
my ($end_hour, $end_min) = split ":", $day[-1]{end};
$day[-1]{total} = $end_hour*60+$end_min - ($start_hour*60+$start_min);
if ($day[-1]{title} =~ /Break|Exercises|Solutions/) {
$stat{$day[-1]{title}} += $day[-1]{total};
} else {
$stat{Lectures} += $day[-1]{total};
}
$stat{Total} += $day[-1]{total};
print "$day[-1]{start}-$day[-1]{end} $day[-1]{title}\n";
}
if ($title ne "End") {
push @day, {
start => $time,
title => $title,
};
}
}
print "\n";
return;
}
11.48. Solution: Parse ini file
Example 11-20. examples/regex/parse_ini.pl
#!/usr/bin/perl
use strict;
use warnings;
if (@ARGV != 2) {
print "Usage: $0 section key\n";
exit;
}
my ($section, $key) = @ARGV;
my $in_section = 0;
while (my $line =
next if $line =~ /^#/; # skip comments
next if $line =~ /^\s*$/; # skip empty lines
if ($line =~ /^\[$section\]$/) {
90
Chapter 11. Regular Expressions
$in_section = 1;
next;
}
if ($line =~ /^\[/) {
$in_section = 0;
next;
}
if ($in_section and $line =~ /^$key\s*=\s*(.*)$/) {
print "$1\n";
last;
}
}
11.49. Solution: parse perl file
Example 11-21. examples/regex/print_variables.pl
#!/usr/bin/perl
use strict;
use warnings;
# scalars only but finds only the first variable on every line
#while (<>) {
# if (/(\$\w+)\b/) {
# if (not defined $h{$ARGV}{$1}) {
# $h{$ARGV}{$1}=1;
# print "$ARGV: $1\n";
# }
# }
#}
# scalars $ or arrays @ or hashes %
# including all variables on every line
my %h;
while (my $line = <>) {
if (my @vars = $line =~/[\$@%]\w+\b/g) {
foreach my $v (@vars) {
if (not defined $h{$ARGV}{$v}) {
$h{$ARGV}{$v}=1;
print "$ARGV: $v\n";
}
}
}
}
91
Chapter 11. Regular Expressions
11.50. Regular Expressions Cheat sheet
Table 11-3. Regexes
Expression Meaning
a Just an ’a’ character
. any character except new-line
[bgh.] one of the characters listed in the character class
b,g,h or .
[b-h] The same as [bcdefgh]
[a-z] Lower case letters
[b-] The letter b or -
[^bx] Anything except b or x
\w Word characters: [a-zA-Z0-9_]
\d Digits: [0-9]
\s [\f\t\n\r ] form-feed, tab, newline, carriage return
and SPACE
\W [^\w]
\D [^\d]
\S [^\s]
[:class:] POSIX character classes (alpha, alnum...)
\p{...} Unicode definitions (IsAlpha, IsLower, IsHebrew,
...)
a* 0-infinite ’a’ characters
a+ 1-infinite ’a’ characters
a? 0-1 ’a’ characters
a{n,m} n-m ’a’ characters
( ) Grouping and capturing
| Alternation
\1, \2 Capture buffers
$1, $2 Capture variables
^ $ Beginning and end of string ancors
See also perldoc perlre
92
Chapter 12. Shell to Perl
Manipulating Files and Directories
12.1. Running External Programs
system() can execute any external program. You pass to it the same string as you would type on the
command line.
It returns 0 on success and the exit code of the external program on failure. Hence the strange way we
check if it failes.
Passing the program name and the parameters as an array is more secure as it does not involve invocation
of a shell. There is no shell processing involved;
system("some_app.exe --option");
See perldoc -f system for more error handling
my $result = ‘some_app.exe --option‘;
my @result = ‘some_app.exe --option‘;
backticks “ are also know as qx{}
12.2. UNIX commands from the inside
You can run every external command using system
but it makes it platform dependant and might have more security implications.
The following calls are available from Perl.
There are more but we won’t cover them now.
Table 12-1. UNIX command
UNIX DOS
unlink FILENAME rm del
rename OLDFILE, NEWFILE mv ren
chmod MODE, FILE chmod -
chown UID, GID, FILE chown -
93
Chapter 12. Shell to Perl
chdir DIRNAME cd cd
mkdir DIRNAME, PERM mkdir mkdir
rmdir DIRNAME rmdir rmdir
link OLDNAME,
NEWNAME
ln -
symlink OLDNAME,
NEWNAME
ln -s -
readlink LINKNAME ls -l -
glob WILDCARDS ls -1 dir
opendir, readdir ls -1 dir
%ENV, $ENV{HOME}
my $uid = getpwnam($username);
my $gid = getgrnam($groupname);
12.3. File globbing (wildcards)
Example 12-1. examples/shell/file_globbing.pl
#!/usr/bin/perl
use strict;
use warnings;
# File globbing
my @xml_files_in_current_dir = glob "*.xml";
my $bin_dir = "/home/foo/bin";
my @perl_files = glob "$bin_dir/*.pl $bin_dir/*.pm";
# my @xml_files_using_old_syntax = <*.xml>;
12.4. Rename files
• glob - directory listing
Example 12-2. examples/shell/rename_files.pl
#!/usr/bin/perl
use strict;
use warnings;
foreach my $file (glob "*.xml") {
94
Chapter 12. Shell to Perl
my $new = substr($file, 0, -3) . "html";
print "rename $file, $new\n";
#rename $file, $new;
}
12.5. Directory handles
For a platform independent approach use opendir and readdir.
In order to read the content of a directory (that is the list of the files)
first we have to open the directory similarly to the way we opened a file
but using the opendir function
This way we get a directory handle which we can use in subsequent operations.
Once the directory was opened successfully we can use the function readdir
in a loop to get the names of the files in that directory
Example 12-3. examples/shell/list_directory.pl
#!/usr/bin/perl
use strict;
use warnings;
my $dir = shift or die "Usage: $0 DIRECTORY\n";
opendir my $dh, $dir or die "Cannot open $dir: $!\n";
while (my $entry = readdir $dh) {
if ($entry eq "." or $entry eq "..") {
next;
}
print "$entry\n";
}
closedir $dh;
in LIST context readdir returns all the files in the directory.
opendir(my $dh, "/etc") or die $!;
@files = readdir $dh;
12.6. File::HomeDir
Example 12-4. examples/shell/file_homedir.pl
#!/usr/bin/perl
use strict;
95
Chapter 12. Shell to Perl
use warnings;
use File::HomeDir;
my $home = File::HomeDir->my_home;
my $docs = File::HomeDir->my_documents;
print "$home\n";
print "$docs\n";
12.7. More UNIX commands implemented in modules
Table 12-2. UNIX command in Modules
Module Usage Comment
Cwd $dir = cwd; current working directory
File::Copy copy "oldfile", "newfile";
move "oldfile", "newfile"; this works between file systems
as well
File::Basename basename "/a/b/c/file.pl"; file.pl
dirname "/a/b/c/file.pl"; /a/b/c
File::Path mkpath("a/b/c")
rmtree("/")
File::Find
File::Find::Rule
12.8. More modules
use File::Spec;
$f = File::Spec->catfile(’home’, ’admin’, ’project’); # fancy OOP style
print "$f\n"; # home\admin\project on Windows
use File::Spec::Functions; # build path based on current Os
$f = catfile(’home’, ’admin’, ’project’);
print "$f\n"; # home/admin/project on Unix
12.9. Change Copyright text in every source file in a
96
Chapter 12. Shell to Perl
directory hierarchy
• File::Find
• reference to subroutine
Example 12-5. examples/shell/change_files.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find qw(find);
my $dir = ".";
if (defined $ARGV[0]) {
$dir = $ARGV[0];
}
find( \&change_file, $dir);
sub change_file {
if (not -f $_) {
return;
}
if (substr($_, -3) ne ".pl") {
return;
}
print "$_\n";
my $data;
if (open my $fh, "<", $_) {
local $/ = undef;
$data = <$fh>;
} else {
warn "Could not open ’$_’ for reading\n";
return;
}
$data =~ s/Copyright Old/Coyright New/g;
# Let’s not ruin our example files....
my $new_name = "$_.new";
if (open my $fh, ">", $new_name) {
print $fh $data;
} else {
warn "Could not open ’$new_name’ for writing\n";
}
return;
}
97
Chapter 12. Shell to Perl
12.10. File::Tools
Includes all the above
12.11. Exercise: Tree
Implement tree: prints a tree structure of a given directory.
All filenames are printed and subdirectories are properly indented.
$ tree.pl .
.
subdir_1
file_1_in_subdir_1
file_2_in_subdir_1
subdir_2
subdir_2_1
file_1_in_subdir_2_1
file_1_in_subdir_2
Implement the previous one using File::Find
Implement the previous one using File::Find::Rule
12.12. Solutions: Tree
Example 12-6. examples/shell/tree.pl
#!/usr/bin/perl
use strict;
use warnings;
my $dir = ’.’;
if (@ARGV) {
$dir = $ARGV[0];
}
traverse_dir(”, $dir, 0);
sub traverse_dir {
my ($dir, $thing, $depth) = @_;
my $path = ($dir ? "$dir/$thing" : $thing);
98
Chapter 12. Shell to Perl
print " " x ($depth*3), "$thing\n";
return if not -d $path;
if (opendir my $dh, $path) {
while (my $entry = readdir $dh) {
next if $entry eq "." or $entry eq "..";
traverse_dir ($path, $entry, $depth+1);
}
} else {
print " " x ($depth*3-3), "#### Could not open $dir\n";
}
return;
}
Example 12-7. examples/shell/tree_ff.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
if (not @ARGV) {
@ARGV = (".");
}
find (\&find_name, @ARGV);
sub find_name {
print " " x (split("/", $File::Find::name) -1);
print "$_\n";
return;
}
Example 12-8. examples/shell/tree_file_find_rule.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find::Rule;
my $dir = ’.’;
if (@ARGV) {
$dir = shift;
}
foreach my $thing (File::Find::Rule->in($dir)) {
my @parts = split m{/}, $thing;
print " " x @parts;
print "$parts[-1]\n";
}
99
Chapter 13. More about files
13.1. File test or -X operators
Before we try to read from a file or try to write to a file
we might want to check our rights, if we can do the required action at all.
For this there is a bunch of so called -X operators. Usually you use them in
an if statement:
if (-e "file.txt") {
print "File exists !\n";
}
• -e File (or directory) exists
• -r File (or directory) is readable by this user
• -w File (or directory) is writable by this user
• -x File (or directory) is executable by this user
• -d Entry is a directory
• -l Entry is a symbolic link
• -s Size of the file (hence also means ’file is not empty’)
• -M Number of days between the modification date of a file and the start time of our script
Hence -s can be used either in an if statement or like this:
$size = -s $filename;
There are more such operators see perldoc -f -x
13.2. Reading from file, read, eof
Once the file is open for reading it behaves exactly like STDIN and we can access the same way.
Example 13-1. examples/files/read_from_file.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "input.txt";
open my $fh, "<", $filename or die $!;
100
Chapter 13. More about files
my $line = <$fh>;
chomp $line;
while (my $line = <$fh>) {
chomp $line;
#...
}
open my $data, "<", $filename or die $!;
my @lines = <$data>;
chomp @lines;
foreach my $line (@lines) {
print $line;
}
In Perl we usually care about lines of input so the above is enough.
Still some like to read files with chunks of arbitrary length.
read puts the read string to the variable passed to the function and
returns the number of characters actually read
READ_LENGTH = read FILEHANDLE,SCALAR,LENGTH
Example 13-2. examples/files/read_file.pl
#!/usr/bin/perl
use strict;
use warnings;
# reading in 30 characters:
open my $in, "<", $0 or die $!;
my $expected = 30;
my $buf;
my $actual = read $in, $buf, $expected;
if ($actual < $expected) {
print "reached end of file\n";
}
# returns TRUE if we are stand at or after the end of file.
eof($in)
13.3. tell, seek
For our purposes a file is a line of characters.
After a bunch of read and/or write operations we need to tell where are we on that line ?
101
Chapter 13. More about files
LOCATION = tell FILEHANDLE
We might also want to move within that file
seek FILEHANDLE, OFFSET, WHENCE
WHENCE:
0 from beginning of file
1 from current location
2 from end of file
OFFSET:
+/- number of bytes to move
the important values are:
seek $fh, 0,0; # go to the beginning of the file
seek $fh, 0,2; # go to the end of the file
13.4. truncate
# Sometimes you need to
truncate FILEHANDLE, LENGTH;
Example 13-3. examples/files/truncate.pl
#!/usr/bin/perl
use strict;
use warnings;
my $new = $ARGV[0];
my $filename = "file.txt";
open my $fh, "+<", $filename or die "Could not open $!\n";
my $old = <$fh>;
seek $fh, 0, 0; # move to the beginning of the file
print $fh $new;
truncate $fh, length $new; # cut the file to the new size
13.5. UNIX file system, hard links symbolic links
• What is in a Directory ?
• What is in an Inode ?
102
Chapter 13. More about files
• What is a symbolic link ?
• What is a hard link ?
What links can be between different partitions ?
(hint: only symbolic links as hard links are bound to the inode
number which is local to each partition)
13.6. stat, lstat
# In order to get information from the inode table you can use the stat system call
ARRAY = stat FILEHANDLE| FILENAME
@fields = stat ($filename);
@fields = stat ($fh);
$fields[4] is the UID
$fields[7] is the size in bytes
0 dev device number of file system
1 ino inode number
2 mode file mode (type and permissions)
3 nlink number of (hard) links to the file
4 uid numeric user ID of file’s owner
5 gid numeric group ID of file’s owner
6 rdev the device identifier (special files only)
7 size total size of file, in bytes
8 atime last access time in seconds since the epoch
9 mtime last modify time in seconds since the epoch
10 ctime inode change time (NOT creation time!) in seconds since the epoch
11 blksize preferred block size for file system I/O
12 blocks actual number of blocks allocated
for symbolic links use lstat
13.7. Exercise: Create a counter
Each time I run the script I want to get a higher number.
103
Chapter 13. More about files
13.8. Exercise: Create multiple counters
Create multiple counters separated by newlines
I run the script like this: counter.pl 3
This will increment the counter #3 by one and print the value.
13.9. Exercises: List old logfiles
List all the logfiles in the current directory that are older than 3 days
List all the log files in this directory and subdirectories that
are more than 3 days old.
13.10. Solution: Create a counter
Example 13-4. examples/files/counter.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = "counter.txt";
if (not -e $filename) {
open my $fh, ">", $filename or die "Could not create counter file: $!";
print $fh 0;
}
open my $fh, "+<", $filename or die "Could not open counter: $!\n";
my $c = <$fh>;
chomp $c;
seek $fh, 0, 0;
truncate $fh, 0;
$c++;
print $c;
print $fh $c;
close $fh;
104
Chapter 13. More about files
13.11. Solution: Create multiple counters
Example 13-5. examples/files/multiple_counter.pl
#!/usr/bin/perl
use strict;
use warnings;
unless (@ARGV) {
print "Usage: $0
exit;
}
my $id = shift @ARGV;
$id--; # because we index the counters from 1 and the array is from 0
my $filename = "multiple_counter.txt";
if (not -e $filename) {
open my $fh, ">", $filename or die "Could not create counter file: $!";
print $fh 0;
}
open my $fh, "+<", $filename or die "Could not open counter: $!\n";
my @c = <$fh>;
chomp @c;
seek $fh, 0, 0; # move to the beginning of the file
truncate $fh, 0; # cut the file to a certain size
$c[$id]++;
print $c[$id];
foreach my $v (@c) {
if (defined $v) {
print $fh "$v\n";
} else {
print $fh "\n";
}
}
close $fh;
13.12. Solutions: List old logfiles
Example 13-6. examples/shell/logfiles_older_than3days.txt
perl -e ’for (<*.log>) {print "$_\n" if -M $_ > 3}’
105
Chapter 13. More about files
Example 13-7. examples/shell/list_old_log_files.pl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find ’find’;
find({
wanted => \&old_files,
no_chdir => 1,
}, $ARGV[0] || ’.’);
sub old_files {
if (substr($_, -4) ne ".log") {
return;
}
if (-M $_ > 3) {
print "$_\n";
}
return;
}
106
Chapter 14. Using Perl modules, using CPAN
14.1. Using modules exporting functions
use Cwd;
my $path = cwd;
Probably better this way, so the reader will know where each function comes from and we reduce the risk
of redefining other functions by importing exactly the functions we want.
use Cwd (’cwd’);
my $path = cwd;
also written as
use Cwd qw(cwd);
my $path = cwd;
You can also make sure not to import anything and the use fully qualified names.
use Cwd ();
my $path = Cwd::cwd;
14.2. Using Object Oriented modules
Example 14-1. examples/cpan/math_bigint.pl
#!/usr/bin/perl
use strict;
use warnings;
use Math::BigInt;
my $x = Math::BigInt->new("1234567890");
my $y = Math::BigInt->new("8234567890");
$x->badd($y);
print $x->bstr, "\n"; # 9469135780
107
Chapter 14. Using Perl modules, using CPAN
14.3. Selecting Module to use
Evaluating modules, getting information about them
• CPAN http://www.cpan.org/
• Searching CPAN http://search.cpan.org/
• Randy Kobes CPAN http://kobesearch.cpan.org/
• POD = Plain Old Documentation
• CPAN Testers http://testers.cpan.org/
• CPAN Ratings http://cpanratings.perl.org/
• CPANTS http://cpants.perl.org/
• RT (Request Tracker) http://rt.cpan.org/
• Annotate POD http://annocpan.org/
• CPAN::Forum http://www.cpanforum.com/
• Mailing lists http://lists.cpan.org/
• PerlMonks http://www.perlmonks.org/
• Perl Mongers http://www.pm.org/
• Perl Mongers in Israel http://www.perl.org.il/
14.4. Installing modules on ActivePerl
C:> ppm
ppm> install Name-Of-Module
in case it returns a list of modules, pick up the correct number:
ppm> install 3
There are additional sites with ppm repositories once can find on Kobes Search
Add the repository to ppm and install modules from that place as well:
ppm> rep add uwin http://theoryx5.uwinnipeg.ca/ppms/
ppm> install IO-Socket-SSL
in ActiveState 5.6.x
ppm> set rep name URL
In case the computer is behind a company proxy you can configure
108
Chapter 14. Using Perl modules, using CPAN
the http_proxy environment variable and ppm will use the proxy:
set http_proxy=http://proxy.company.com:8080
14.5. Installing modules on Unix manually with root
rights
• Download the tar.gz file from search.cpan or other site (wget URL)
• Linux: tar xzf distribution.tar.gz
• UNIX: gunzip distribution.tar.gz
• UNIX: tar xf distribution.tar
• perl Makefile.PL
• make
• make test
• make install (as root)
Without root rights
perl Makefile.PL PREFIX=/home/foobar/perlib LIB=/home/foobar/perlib/lib
In the code:
use lib ’/home/foobar/perlib/lib’;
use My::Module;
Module::Build
perl Build.PL --install_base /home/foobar/perl5lib --install_path lib=/home/foobar/perl5lib/lib
./Build
./Build test
./Build install
14.6. Changing @INC
When using modules that are not installed in the standard directories
and we cannot assume (or require) to run the script in the same directory
where the module is. That is in most of the cases, we need to change @INC
so our script can find our module(s).
Set the environment variable
109
Chapter 14. Using Perl modules, using CPAN
PERL5LIB or PERLLIB for all the scripts
use lib ’path/to/lib’; for the sepcific script
perl -I path/to/lib script.pl for this invocation only
# relative path
use FindBin;
use File::Spec;
use lib File::Spec->catfile($FindBin::Bin, ’..’, ’lib’);
# relative path
use File::Spec;
use File::Basename;
use lib File::Spec->catfile(
File::Basename::dirname(File::Spec->rel2abs($0)),
’..’,
’lib’);
14.7. Using CPAN.pm
$ cpan
cpan> install Module::Name
Need to configure CPAN.pm:
set urllist to a CPAN mirror that is close by
set prerequisites_policy to follow
set makepl_arg (PREFIX=... LIB=...)
perl -MCPAN -eshell
14.8. CPAN.pm
Example 14-2. examples/cpan/ENV
export PERL5LIB=/home/gabor/perl5lib/lib
Example 14-3. examples/cpan/MyConfig.pm
# This is CPAN.pm’s systemwide configuration file. This file provides
# defaults for users, and the values can be changed in a per-user
# configuration file. The user-config file is being looked for as
110
Chapter 14. Using Perl modules, using CPAN
# ~/.cpan/CPAN/MyConfig.pm.
$CPAN::Config = {
’build_cache’ => q[10],
’build_dir’ => q[/home/gabor/.cpan/build],
’cache_metadata’ => q[1],
’cpan_home’ => q[/home/gabor/.cpan],
’dontload_hash’ => { },
’ftp’ => q[/usr/kerberos/bin/ftp],
’ftp_proxy’ => q[],
’getcwd’ => q[cwd],
’gpg’ => q[/usr/bin/gpg],
’gzip’ => q[/bin/gzip],
’histfile’ => q[/home/gabor/.cpan/histfile],
’histsize’ => q[100],
’http_proxy’ => q[],
’inactivity_timeout’ => q[0],
’index_expire’ => q[1],
’inhibit_startup_message’ => q[0],
’keep_source_where’ => q[/home/gabor/.cpan/sources],
’links’ => q[/usr/bin/links],
’make’ => q[/usr/bin/make],
’make_arg’ => q[],
’make_install_arg’ => q[],
’makepl_arg’ => q[PREFIX=/home/gabor/perl5lib LIB=/home/gabor/perl5lib/lib],
’ncftpget’ => q[/usr/bin/ncftpget],
’no_proxy’ => q[],
’pager’ => q[/usr/bin/less],
’prerequisites_policy’ => q[follow],
’scan_cache’ => q[atstart],
’shell’ => q[/bin/bash],
’tar’ => q[/bin/tar],
’term_is_latin’ => q[1],
’unzip’ => q[/usr/bin/unzip],
’urllist’ => [q[http://mirror.mirimar.net/cpan/]],
’wget’ => q[/usr/bin/wget],
};
1;
__END__
14.9. CPANPLUS, CPAN::Reporter
cpan> install CPAN::Reporter
cpan> reload cpan
cpan> o conf init test_report
cpan> o conf commit
111
Chapter 14. Using Perl modules, using CPAN
14.10. Exercise: Module installation
Install the Acme::EyeDrops module from CPAN and write a script
to draw a camel. As you are not root, you might need to install it in
a local subdirectory.
Create a simple script that does some simple computation.
Creata a script using Acme::EyeDrops that will use the above simple script as
source.
Save your camel in a file.
Run the file containing the camel using Perl.
14.11. Solution: Module installation
Example 14-4. examples/cpan/acme_camel.pl
#!/usr/bin/perl
=pod
search.cpan.org
search Acme::EyeDrops
download the latest Acme-EyeDrops gziped file (for me it was Acme-EyeDrops-1.01.tar.gz)
mkdir modules (create a local directory where we’ll install the module)
tar xzf Acme-EyeDrops-1.01.tar.gz
cd Acme-EyeDrops-1.01
perl Makefile.PL PREFIX=/home/user/modules LIB=/home/user/module/lib
(the full path to the directory you created for the modules)
make
make test
make install
Create a script called hello_world.pl that asks for your name and then
prints Hello NAME.
Run this script. See the camel.
Now run this script and redirect to another file
perl acme_camel.pl > camel.pl
Now run the camel:
perl camel.pl
=cut
use strict;
use warnings;
112
Chapter 14. Using Perl modules, using CPAN
use lib qw (/home/user/modules/lib/);
use Acme::EyeDrops qw (sightly);
print sightly({
Shape => ’camel’,
SourceFile => ’hello_world.pl’,
});
113
Chapter 15. Applications
15.1. Simple uses of Perl
After leaning the syntax of the language let’s see a few simple ways to use it in real life tasks.
15.2. Create Unix user account
Example 15-1. examples/applications/create_user.pl
#!/usr/bin/perl
use strict;
use warnings;
my $adduser = ’/usr/sbin/adduser’;
use Getopt::Long qw(GetOptions);
my %opts;
GetOptions(\%opts,
’fname=s’,
’lname=s’,
) or usage();
if (not $opts{fname} or $opts{fname} !~ /^[a-zA-Z]+$/) {
usage("First name must be alphabetic");
}
if (not $opts{lname} or $opts{lname} !~ /^[a-zA-Z]+$/) {
usage("Last name must be alphabetic");
}
my $username = lc( substr($opts{lname}, 0, 1) . $opts{fname});
my $home = "/opt/$username";
print "Username: $username\n";
my $cmd = qq($adduser --home $home --disabled-password --gecos "$opts{fname} $opts{lname}" $print "$cmd\n";
system $cmd;
sub usage {
my ($msg) = @_;
if ($msg) {
print "$msg\n\n";
114
Chapter 15. Applications
}
print "Usage: $0 --fname FirstName --lname LastName\n";
exit;
}
15.3. Reporting file system diskspace usage (df)
Example 15-2. examples/applications/diskspace.pl
#!/usr/bin/perl
use strict;
use warnings;
use Filesys::Df qw(df);
my $df = df("/", 1024 * 1024 * 1024);
print "Percent Full: $df->{per}\n";
print "Superuser Blocks: $df->{blocks}\n";
print "Superuser Blocks Available: $df->{bfree}\n";
print "User Blocks: $df->{user_blocks}\n";
print "User Blocks Available: $df->{bavail}\n";
print "Blocks Used: $df->{used}\n";
15.4. Reporting diskspace usage on the mail server
Example 15-3. examples/applications/diskusage.pl
#!/usr/bin/perl
use strict;
use warnings;
#
# Reporting disk usage on the mail server
#
# Run the script in a cron job
#
# 1) Report to Boss if there are people with large files
#
# 2) If a user has a file that is too big then ask him to remove the
# large e-mail from the mail server via web access
# This one has not been implemented yet
#
######################################################
use Mail::Sendmail qw(sendmail);
use Filesys::Df qw(df);
115
Chapter 15. Applications
################## Limit Definitions
my $report_to_boss_limit = 1_000_000; # the size of the /var/spool/mail/username file in my $report_to_user_limit = 1_000_000;
my $boss_email = ’boss@company’;
my $from_email = ’Disk Usage Report
my $disk_space_percantage = 80;
my %file_size;
foreach my $path () { # each user has a file in that directory
if ($path =~ /Save/) { # disregard the Save directory
next;
}
if ($path =~ /\.pop$/) { # disregard temporary .pop files
next;
}
$file_size{$path} = -s $path;
}
my $txt = "x";
# sort files by size
foreach my $path (sort {$file_size{$b} <=> $file_size{$a}} keys %file_size) {
my $name = $path;
$name =~ s{/var/spool/mail/}{};
if ($file_size{$path} > $report_to_boss_limit) {
$txt .= "$name\t\t" . int ($file_size{$_}/1_000_000) . " MB\n";
}
}
my @disks = qw(/ /boot);
foreach my $disk (@disks) {
my $df = df($disk, 1024 * 1024 * 1024);
if ($df->{per} > $disk_space_percantage) {
$txt .= "\n\nDiskspace is low\n\nUsing " . $df->{per} . "\% of the space on $disk\n";
}
}
if ($txt) {
$txt = "Disk Usage of /var/spool/mail on the incoming mail server\n" .
"Reporting users over $report_to_boss_limit bytes\n\n" .
$txt;
sendmail (
To => $boss_email,
From => $from_email,
Subject => ’Disk Usage Report’ . localtime(),
Message => $txt,
);
}
116
Chapter 15. Applications
15.5. A du like script
Example 15-4. examples/applications/du.pl
#!/usr/bin/perl
use strict;
use warnings;
use Filesys::DiskUsage qw(du);
my %sizes = du({’make-hash’ => 1}, @ARGV);
foreach my $entry (sort { $sizes{$a} <=> $sizes{$b} } keys %sizes) {
print "$entry => $sizes{$entry}\n";
}
15.6. Send e-mail
• Mail::Sendmail
Example 15-5. examples/applications/sendmail.pl
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long "GetOptions";
use Mail::Sendmail "sendmail";
my $to;
my $from;
my $help;
my $file;
GetOptions(
"to=s" => \$to,
"from=s" => \$from,
"help" => \$help,
"file=s" => \$file,
);
if ($help) {
usage();
}
if ($to and $from and $file) {
my ($subject, $message) = read_file($file);
my %mail = (
To => $to,
From => $from,
Subject => $subject,
Message => $message,
117
Chapter 15. Applications
);
sendmail(%mail) or die $Mail::Sendmail::error;
} else {
usage();
}
sub usage {
print "Usage: $0\n";
print " --to TO\n";
print " --from FROM\n";
print " --file FILE\n";
print "\n";
print " --help\n";
print "\n";
print "The given FILE is going to be the content of the e-mail\n";
print "The first line of the file should be:\n";
print "Subject: and the subject itself\n";
print "\n";
exit;
}
sub read_file {
my ($file) = @_;
open(my $fh, "<", $file) or die "Could not open ’$file’\n";
my $subject = <$fh>;
local $/ = undef;
my $message = <$fh>;
$subject =~ s/^Subject: //;
return ($subject, $message);
}
15.7. Read Excel file
Example 15-6. examples/applications/read_excel.pl
#!/usr/bin/perl
use strict;
use warnings;
use Spreadsheet::ParseExcel::Simple qw();
my $xls = Spreadsheet::ParseExcel::Simple->read("spreadsheet.xls");
foreach my $sheet ($xls->sheets) {
while ($sheet->has_data) {
118
Chapter 15. Applications
my @data = $sheet->next_row;
print join "|", @data;
print "\n";
}
}
15.8. Process file with fixed width records
Example 15-7. examples/applications/pack.pl
#!/usr/bin/perl
use strict;
use warnings;
# You need to parse a log file where the fields are fixed length long
# and have no delimiters
# The definition is as follows:
# LABEL: 4 chars
# SOURCE: 8 digits
# DESTINATION: 8 digits
# TYPE: 4 chars
# VALUE: 8 digits
my $file = ’examples/pack.txt’;
open(my $data, ’<’, $file) or die "Could not open ’$file’\n";
while (my $line = <$data>) {
print $line;
chomp $line;
my ($label, $source, $dest, $type, $value) = unpack ("A4 A8 A8 A4 A8", $line);
print "LABEL: $label SOURCE: $source DEST: $dest TYPE: $type VALUE: $value\n";
}
Example 15-8. examples/applications/pack.txt
ALD37845566974923342XYZ24023984
QRW49327408234028434ERD24448009
15.9. Process file with multiline records
Example 15-9. examples/applications/config.txt
device = 234234
name = Big
address = 115.6.79.8
class = B
device = 234224
119
Chapter 15. Applications
name = Big Blue
address = 115.6.69.8
class = B
alias = Foxbox
device = 234235
name = Big Green box
address = 115.6.79.1
class = G
owner = Boss
device = 334235
name = Small Yellow
address = 115.6.79.10
class = Y
Example 15-10. examples/applications/process_config.pl
#!/usr/bin/perl
use strict;
use warnings;
=head1 DESCRIPTION
File have sections separated by empty lines
Each section has several field = value entries like this:
Given a value of the name field print out all the values in this section
device = 234234
name = Big
address = 115.6.79.8
class = B
=cut
if (@ARGV != 2) {
die "\n Usage: $0 filename name\n Try: $0 examples/config.txt Big\n\n";
}
my ($filename, $name) = @ARGV;
open(my $fh, "<", $filename) or die "Could not open ’$filename’ $!";
my %data;
while (my $line = <$fh>) {
chomp $line;
if ($line =~ /^\s*$/ and %data) {
if ($data{name} eq $name) {
foreach my $k (keys %data) {
printf "%-10s = %s\n", $k, $data{$k};
}
exit;
}
%data = ();
120
Chapter 15. Applications
} else {
my ($field, $value) = split /\s*=\s*/, $line;
$data{$field} = $value;
}
}
15.10. Process multi field csv file
Example 15-11. examples/applications/fields.csv
Name,ID,Input,Output
Big Venta,12,Left,Right
Small Elevator,7343124,Bottom,Top
Giant Ant,423235,Lower floor,Upper floor
Example 15-12. examples/applications/process_fields.pl
#!/usr/bin/perl
use strict;
use warnings;
use Text::CSV_XS qw();
use Data::Dumper qw(Dumper);
my $filename = shift or die "Usage: $0 FILENAME\n";
open(my $fh, "<", $filename) or die "Could not open ’$filename’: $!";
my $csv = Text::CSV_XS->new;
my $key = "Name";
my $header = <$fh>;
chomp $header;
$csv->parse($header);
my @header = $csv->fields;
my %data;
while (my $line = <$fh>) {
chomp $line;
$csv->parse($line);
my @cols = $csv->fields;
my %h;
@h{@header} = @cols;
$data{$h{$key}} = \%h;
}
print Dumper \%data;
121
Chapter 15. Applications
15.11. Fetch web page
Example 15-13. examples/applications/get_webpage.pl
#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple qw(get);
my $page = get "http://web_development:8080/";
if ($page) {
print "Site is alive\n";
} else {
print "Site is not accessible\n";
}
15.12. Generate web page
We are building the HTML pages from a template utilizing the HTML::Template module from CPAN.
Besides the plain HTML the template has additional TMPL_* tags that will be filled by the values by
HTML::Template.
Example 15-14. examples/applications/html.tmpl
You typed
122
Chapter 15. Applications
This is a simple Perl script that should be installed to a CGIExec enabled directory of Apache. When the
user hits this page the first time it displays a white page with only entry-box and a submit button on it.
the user can fill the box,
Example 15-15. examples/applications/html.pl
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use HTML::Template;
my $template = HTML::Template->new(filename => "examples/html.tmpl");
my $q = CGI->new;
print $q->header;
if ($q->param("text")) {
my $text = $q->param("text");
$template->param(echo => $text);
}
print $template->output
15.13. Parse XML file
Example 15-16. examples/applications/simple.xml
123
Chapter 15. Applications
Example 15-17. examples/applications/xml_simple.pl
#!/usr/bin/perl
use strict;
use warnings;
use XML::Simple qw(XMLin);
my $xml = XMLin("examples/simple.xml", ForceArray => 1);
#use Data::Dumper qw(Dumper);
#print Dumper $xml;
#exit;
print join "-", keys %{$xml->{person}};
print "\n";
foreach my $id (keys %{$xml->{person}}) {
printf "%-10s %-10s %-10s\n",
$xml->{person}{$id}{fname}[0],
$xml->{person}{$id}{lname}[0],
$xml->{person}{$id}{idnum}[0];
}
15.14. Database access using DBI and DBD::SQLite
Example 15-18. examples/applications/db.pl
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use DBI qw();
my $action;
GetOptions("action=s" => \$action);
if (not $action or $action !~ /^(create|insert|selecta|selecth)$/) {
print <<"USAGE";
Usage:
$0 --action create|insert|selecta|selecth
USAGE
exit;
}
my $dbfile = "sample.db";
if ($action eq "create") {
create();
exit;
}
124
Chapter 15. Applications
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","", {});
if ($action eq "insert") {
insert();
}
if ($action eq "selecta") {
fetch_arrays();
}
if ($action eq "selecth") {
fetch_hashref();
}
sub create {
unlink $dbfile if -e $dbfile;
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","", {});
$dbh->do("CREATE TABLE people (id INTEGER PRIMARY KEY, fname VARCHAR(100), lname VARCHAR(return;
}
sub insert {
$dbh->do("INSERT INTO people (id, fname, lname) VALUES(?, ?, ?)", undef, 1, "Gabor", "Szabo");
$dbh->do("INSERT INTO people (id, fname, lname) VALUES(?, ?, ?)", undef, 2, "Josef", "Kiss");
return;
}
sub fetch_arrays {
my $sth = $dbh->prepare("SELECT lname, fname FROM people WHERE id = ?");
$sth->execute(1);
while (my @result = $sth->fetchrow_array()) {
print "lname: $result[0], fname: $result[1]\n";
}
$sth->finish;
return;
}
sub fetch_hashref {
my $sth = $dbh->prepare("SELECT lname, fname FROM people WHERE id = ?");
$sth->execute(1);
while (my $result = $sth->fetchrow_hashref("NAME_lc")) {
print "lname: $result->{lname}, fname: $result->{fname}\n";
}
$sth->finish;
return;
}
125
Chapter 15. Applications
15.15. Net::LDAP
Example 15-19. examples/applications/ldap.pl
#!/usr/bin/perl
use strict;
use warnings;
use Net::LDAP;
my $server = "ldap.itd.umich.edu";
my $ldap = Net::LDAP->new( $server ) or die "$@";
$ldap->bind;
my $result = $ldap->search(
base => "",
filter => "(&(cn=Ver*) (sn=Szab*))",
attr => ["mail"],
);
$result->code && die $result->error;
printf "COUNT: %s\n", $result->count;
foreach my $entry ($result->entries) {
$entry->dump;
}
print "===============================================\n";
foreach my $entry ($result->entries) {
printf "%s <%s>\n", $entry->get_value("displayName"), $entry->get_value("mail");
$entry->add ( "brother" => "Gabor" );
$entry->replace ( "mail" => ’verele@verele.com’);
my $res = $entry->update($ldap);
$res->code && die $res->code;
}
$ldap->add(
’cn=root, o=University of Michigan, c=US’,
attr => [
cn => ’Gabor Szabo’,
ou => ’My Place in the Universe’,
mail => ’gabor@pti.co.il’,
],
);
$ldap->unbind;
126
Chapter 15. Applications
15.16. Tie::File
Example 15-20. examples/applications/tie.pl
#!/usr/bin/perl
use strict;
use warnings;
use Tie::File;
tie my @file, ’Tie::File’, "data.txt" or die $!;
$file[7] = "Hello";
127
Chapter 16. Oneliners
16.1. Change encoding in a file
perl -i.bak -MEncode -p -e ’Encode::from_to($_, "iso-8859-2", "utf8")’ html/download/printable_cv.html
16.2. Replace file content
You have a bunch of text files in your directory mentioning the name:
"Microsoft Word"
You are told to replace that by
"OpenOffice Write"
perl -i -p -e "s/MicrosoftWord/OpenOffice Write/g" *.txt
-i = inplace editing
-p = loop over lines and print each line (after processing)
-e = command line script
16.3. Process a csv file
You have a number of csv files,
you want to print the 3rd field of each row of each file.
perl -a -F, -n -e ’print "$F[2]\n"’ *.csv
-n = loop over lines but do NOT print them
-a = autosplit by ’ ’
-F, = replace the split string by ’,’
In a CSV file you would like to sum up the numbers in the 3rd column.
perl -a -F, -n -e ’$sum += $F[2]; END {print $sum}’ examples/arrays/process_csv_file.csv
The END block gets executed at the end of the execution and only once.
You want to make sure all the rows are 4 elements long.
128
Chapter 16. Oneliners
Print out file name and line number of all the bad rows.
perl -a -F, -n -e ’print "$ARGV:$.\n" if @F != 4’ *.csv
See also perldoc perlrun
0 Responses to Perl Script notes
Something to say?