Perl in a Nutshell
Version January 17, 2013
by
Thorsten Kracht
Contents
1
Introduction
5
1.1
Man Pages . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
5
2
Miscellaneous
6
2.1
Truth . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6
2.2
Quotes . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
6
2.3
Calling Perl from Perl . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
7
2.3.1
eval . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
7
2.3.2
eval, ARGV . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
7
2.3.3
eval, ARGV, hashes . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
7
3
Variables
9
3.1
Scalars . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
9
3.2
Arrays
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
9
3.2.1
Passing Array References to a Subroutine . . . . . . . . . . . . . . . . . . . . . . . . . . . .
10
3.3
Hashes . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
10
3.4
Symbolic References . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
11
3.5
Nested Data Structures . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
11
3.6
Typeglobs . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
12
3.7
Special Variables . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
13
3.7.1
The Input Record Separator . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
13
3.7.2
The Default Variable $
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
13
3.7.3
Errors, $ERRNO . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
14
3.8
The Scope of Variables, my, local, our . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
14
4
Operators
15
4.1
File Test Operators . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
15
4.2
Precedence of Operators . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
15
4.3
Logical Operators
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
16
4.4
Bitwise Operators
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
16
4.5
Comparison Operators . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
16
4.6
split . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
17
4.7
Miscellaneous Operators . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
17
5
Control Statements
18
5.1
If . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
18
5.2
Loops . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
18
5.3
Switch . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
19
6
Regular Expressions
20
6.1
Modifiers . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
20
6.2
Metacharacters . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
20
6.3
Quantifiers, greedy, ungreedy . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
21
6.4
Interpolation . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
21
6.5
Variables . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6
Examples . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6.1
Find a word in a string . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6.2
Skip comment lines . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6.3
Grouping . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
1
6.6.4
Backreference, parse time string . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6.5
XML vs. HTML, replace ’¡’ and ’¿’ . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6.6
Special characters, string starts with ’/’ . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
22
6.6.7
Trimm leading and tailing white space . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
23
6.6.8
Remove path . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
23
6.6.9
Remove the file extension . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
23
6.6.10
Change path . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
23
6.6.11
Reverse the first two fields, exclude a range of characters
. . . . . . . . . . . . . . . . . . .
23
6.6.12
Translate to lower case letters . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
23
6.6.13
Remove Ctrl-M . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
23
6.6.14
Count the stars . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
24
7
File I/O, File Handles
25
7.1
The Basics . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
25
7.2
Passing File Handles . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
25
7.3
Storing File Handles in a Hash . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
26
7.4
The FileHandle Module . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
26
7.5
Flushing Output . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
26
7.6
Reading Single Keystrokes . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
26
7.7
I/O Re-direction, local( *STDOUT) . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
26
7.8
readdir . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
27
8
Functions
28
8.1
alarm . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
28
8.2
BEGIN, END . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
28
8.3
chdir . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
28
8.4
chr, ord, character conversion . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
28
8.5
doty . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
29
8.6
eval . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
29
8.6.1
eval, alarm (timeout) . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
29
8.7
getpwuid . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
30
8.8
grep . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
30
8.9
isatty . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
30
8.10 join . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
30
8.11 length . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
30
8.12 localtime . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
30
8.13 map . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
31
8.14 mkdir . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
31
8.15 pack, unpack . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
31
8.16 print, sprintf
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
32
8.17 rand, srand . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
33
8.18 rename . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
33
8.19 require . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
33
8.20 socket, connect, fcntl, select, · · · . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
33
8.21 sort . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
33
8.22 sotd . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
34
8.23 split . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
34
8.24 stat, localtime . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
35
8.25 substr . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
35
8.26 System . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
35
8.27 time . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
36
8.28 times . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
36
8.29 uc, lc, ucfirst, lcfirst, case conversion
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
36
8.30 unlink . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
37
8.31 Numeric functions . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
37
9
Subroutines
38
9.1
Closures, anonymous subroutines . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
39
10 Packages, Modules
41
10.1 Include Path . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
42
10.2 Symbols Tables . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
42
11 Signal Handling
43
11.1 Alarm Handler . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
43
11.2 Exit Handler . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
44
12 Examples
45
12.1 Perl Language Features . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
45
12.1.1
Command line arguments: ARGV . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
45
12.1.2 Meta Information, caller(), ref(), isa(), ...
. . . . . . . . . . . . . . . . . . . . . . . . . . . .
45
12.1.3
Sleeping with a finer resolution, select() . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
45
12.1.4
Timeout . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
46
12.1.5
ascii format()
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
46
12.2 OS Interface . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
46
12.2.1
Executing shell commands, system() . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
46
12.2.2
Remove many files, opendir() . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
46
12.2.3
Rename files . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
47
12.2.4
Replace blanks, ¨a, ¨
A, ¨o, etc. in file names . . . . . . . . . . . . . . . . . . . . . . . . . . . .
48
12.2.5
Substitute strings in files, simple
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
48
12.2.6
Substitute strings in source files . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
49
12.2.7
Change the file protection, chmod() . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
51
12.2.8
Kill processes, yesno(), kill() . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
51
12.3 IO, Sockets, RS232, USB, ... . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
52
12.3.1
Mirroring /dev/ttyS0, including the client . . . . . . . . . . . . . . . . . . . . . . . . . . . .
52
12.3.2
Reading single keystrokes, cbreak mode . . . . . . . . . . . . . . . . . . . . . . . . . . . .
54
12.3.3
Reading single keystrokes, POSIX::Termios . . . . . . . . . . . . . . . . . . . . . . . . . .
55
12.3.4
Pinging a host, system(), ping() . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
55
12.3.5
Serial line I/O, Elcomat, POSIX::Termios . . . . . . . . . . . . . . . . . . . . . . . . . . . .
56
12.3.6
Serial line I/O, DMC, sysopen( $path, O RDWR) , select()
. . . . . . . . . . . . . . . . . .
56
12.3.7
Serial line I/O, I404, BPM, sysopen( $path, O RDWR) , select() . . . . . . . . . . . . . . . .
57
12.3.8 USB, select(), POSIX::Termios, baudrates . . . . . . . . . . . . . . . . . . . . . . . . . . . .
58
12.3.9 USB, I404
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
59
12.3.10 Sockets, using Net::TCP . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
62
12.3.11 Sockets, using IO::Socket::INET, TCP/IP . . . . . . . . . . . . . . . . . . . . . . . . . . . .
63
12.3.12 Sockets, using IO::Socket::INET, UDP, P03, pump . . . . . . . . . . . . . . . . . . . . . . .
63
12.3.13 Sockets, using IO::Socket::INET for T95 Temperatur Controller . . . . . . . . . . . . . . . .
64
12.3.14 Raw Sockets, Spectra Client . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
65
12.3.15 Sockets, SDD Server . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
66
12.3.16 Sockets, Modbus Implementation, fd select() . . . . . . . . . . . . . . . . . . . . . . . . . .
67
List of Figures
4
Chapter 1
Introduction
This note has been written for those who know Perl already to some extend and who wish to lookup some feature.
Those who prefer hardcopies take a look into: “Programming Perl” by Larry Wall, Tom Christansen and Randal L.
Schwartz, “Advanced Perl Programming” by Sriram Srinivasan and “Perl Cookbook” by Tom Christiansen and Nathan
Torkington, all printed by O’Reilly.
1.1
Man Pages
These are important man pages:
perl
Practical Extraction and Report Language
perlembed
embed perl in a C program
perlguts
Perl API
perlxs
XS language reference
5
Chapter 2
Miscellaneous
2.1
Truth
All strings except ”” and ”0” are true
Numbers except 0 are true
References are true
Any undefined values is false
2.2
Quotes
Customary
Generic
Meaning
Interpolates
’’
q//
Literal
No
""
qq//
Literal
Yes
‘‘
qx//
Command
Yes
()
qw//
Word list
No
//
m//
Pattern match
Yes
s///
s///
Substitution
Yes
y///
tr///
Translation
No
Any non-alphanumeric non-whitespace character can be used in place of /, e.g.:
$single = q!I said, "You said, ’She said
The line-oriented form of quoting:
# with interpolation
print <<EOF;
The price is $Price;
EOF
# same as above
print <<"EOF";
The price is $Price;
EOF
# no interpolation
print <<’EOF’;
The price is $Price;
EOF
# execute commands
print <<‘EOF‘;
ls -al
EOF
6
2.3
Calling Perl from Perl
2.3.1
eval
A Perl script executes the contents of a file as Perl code with the
eval function:
eval ‘cat $file_name‘;
2.3.2
eval, ARGV
In a more realistic application information is exchanged between the two scripts. Suppose
t1.pl sends arguments to
t2.pl which returns a string with the results. Let’s look at t2.pl first:
#
# this is t2.pl
#
print "t2.pl received @ARGV\n";
return "Guten Tag 7";
t2.pl receives its arguments via @ARGV. This array name has been choosen because it is @ARGV that imports the
command line arguments in any Perl script.
The script
t1.pl declares @ARGV and fills it with some contents:
#!/usr/bin/perl
#
# this is t1.pl
#
use strict;
{
my @ARGV = qw( 3.14 "Hello");
my @res = split ’ ’, eval ‘cat t2.pl‘;
print "t2.pl returned @res\n";
}
@ARGV has been declared private to an anonymous block in order to avoid collisions with the @ARGV that passes
arguments to
t1.pl. The important line is my @res = split ’ ’, eval ‘cat t2.pl‘;. It calls t2.pl
and splits the returned string into pieces.
Running
t1.pl yields:
$ perl t1.pl
t2.pl: received: 3.14 "Hello"
t2.pl returned Guten Tag 7
2.3.3
eval, ARGV, hashes
Finally it is demonstrated how data are transfered between the scripts using hashes. This time we start with
t1.pl:
#!/usr/bin/perl
#
# this is t1.pl
#
use strict;
{
my @ARGV = qw( p1 val1 p2 val2);
my $h =
eval ‘cat t2.pl‘;
foreach my $key (sort keys %$h)
{
print "t1: $key " . $h->{$key} . "\n";
}
}
In
t1.pl @ARGV is filled with pairs of names and values. t2.pl copies @ARGV to a hash, preparing for a key-
word/value lookup:
#
# this is t2.pl
#
my %params = @ARGV;
foreach my $key (sort keys %params)
{
print "t2: $key " . $params{ $key} . "\n";
}
return { k1 => "v1", k2 => "v2"};
t2.pl returns the reference of an anonymous hash.
The output reads:
$ ./t1.pl
t2: p1 val1
t2: p2 val2
t1: k1 v1
t1: k2 v2
Chapter 3
Variables
3.1
Scalars
# scalar variables
$pi = 3.1415;
undef $pi;
# undefine variable
$i += 1;
++$i;
# auto increment
$i--;
$line .= "\n";
$val ||= "Default";
chop( $line = <STDIN>);
# remove "\n"
$mode = 0755;
# octal
$mask = 0xff40;
scalar( @days);
# type cast
# references
$rs = \186282.42;
# reference to a constant scalar
$rs = \$foo;
# reference to a scalar
$bar = $$rs;
# dereference
$bar = ${$rs};
# using a block which returns a reference
# Querying a reference
$a = 10;
$ra = \$a;
print ref( $ra);
Reserving some space for a scalar variable:
$i = " " x 320;
print " Length " . length( $i) . "\n";
3.2
Arrays
#
# initialisation
#
@home = ( "couch", "chair", "table", "stove");
@temp = qw( foo bar);
# quote words
@ones = (1) x 80;
# fills with 80 ones
@arr = ((map { 19 + $_ * 0.1} (1 .. 5)),
# @arr receives 10 elements, the
(map { 22 + $_ * 0.2} (1 .. 5))); # first is 19.1, the last 23
#
# manipulation
9
#
@whatever = @home;
# copies the items
$home[0] = "door";
# set the first element
($s1, $s2, $s3, $s4) = @home;
@temp = (@foo, @bar, &SomeSub); # interpolation of sublists
($a, $b, @rest) = split;
$home = @stuff;
# $home gets 4 (length)
$home = scalar( @stuff);
# $home gets 4 (length)
print $#home;
# subscript of the last element
@home = ();
# clear list
$#home = -1;
# clear list
scalar( @x) == $#x + 1;
# always true
print "$home[-1]\n";
# print last element
#
# Array references
#
$ra = \@ARGV;
# reference to an array
$ra = [1, 2, 3];
# reference to an anon array
print " -- @$ra \n";
$$ra[0] = "January";
$ra->[0] = "January";
${$ra}[0] = "January";
# a block returns a reference
3.2.1
Passing Array References to a Subroutine
@array1 = (1, 2, 3);
@array2 = (4, 5, 6, 7);
AddArrays( \@array1, \@array2);
sub AddArrays
{
my ($array1, $array2) = @_;
$len2 = @$array2;
for( $i = 0; $i < $len2; $i++)
{
$array1->[$i] += $array2->[$i];
}
}
3.3
Hashes
%longday = ( "Sun" => "Sunday",
"Mon" => "Monday");
%map = ();
# clear hash
%params =
@ARGV;
# copy an array to a hash
$map{ Sun} = "Sunday";
print $longday{"Sun"};
foreach $var (sort keys %ENV)
{
print "$var: " . $ENV{ $var} . "\n";
}
#
# Hash references
#
$rh = { "laurel" => "hardy",
"romeo" => "juliet"}; # reference to an anon hash
$$rh{"key") = "VAL";
$rh->{"key") = "VAL";
foreach my $key (sort keys %$rh){...}
#
# Temporary anonymous hash
#
foreach my $key ( keys %{$h = {qw( start 0 stop 100)}})
{
print " $key -> $h->{ $key}\n";
}
3.4
Symbolic References
no strict ’refs’;
#
# symbolic references work for global variables only
#
use vars qw($bam @bam);
$name = "bam";
$db_h{name} = "bam";
$$name = 1;
# sets $bam
${$name x 2} = 3;
# sets $bambam
$name->[0] = 4;
# sets $bam[0]
$$name[0] = 4;
# also sets $bam[0]
${$name}[0] = 4;
# also sets $bam[0]
${sub {return \"bam";}}[0] = 4;
# also sets $bam[0]
@$name = ();
# clears @bam
&$name();
# calls &bam()
&{$db_h{name}}();
# calls &bam()
$pck = "THAT";
${"${pck}::$name"} = 5;
# sets $THAT::bam without eval
${ $pck . "::h"}{i};
# sets $THAT::h{i}
#
# calling Spectra::get_motor_unit_backlash( "mot1")
#
no strict ’refs’;
foreach my $func qw( motor_unit_backlash)
{
$m1 = &{"Spectra::" . "get_" . $func}( "mot1");
}
For an example of passing an anonymous subroutine reference as a parameter see section 9.1.
3.5
Nested Data Structures
Hashes of hashes:
%h = ( "1d" => { name => "MOT1"},
"2d" => { name => "MOT2"},
"3d" => { name => "MOT3"});
print "Motor " . $h{ "2d"}{ name} . "\n";
# prints ’MOT1’
The following example demonstrates how array references can be stored in hashes:
%sue
= ( name => ’Sue’, age => 45); # parent
%john
= ( name => ’John’, age => 20); # child
%peggy = ( name => ’Peggy’, age => 16); # child
@children = (\%john, \%peggy);
$sue{ children} = \@children;
# or
$sue{ children} = [\%john, \%peggy];
print "Peggy’s age: " . $sue{ children}->[ 1]->{ age} . "\n";
print "Peggy’s age: " . $sue{ children}[ 1]{ age} . "\n"; # shortcut
#
# implicit creation of complex data structures: the following
# statement is valid without any preceding initialization of
# the data structure
#
$sue{children}[1]{age} = 10;
#
# using anonymous arrays
#
%sue =
(
name => ’Sue’, age => 45,
children =>
[
{ name => ’John’, age => 20},
{ name => ’Peggy’, age => 16},
],
)
Here is an example for a data record:
$rec = {
TEXT
=> $string,
SEQUENCE => [ @old_values ],
LOOKUP
=> [ %some_table],
THATCODE => \&some_function,
THISCODE => sub { $_[0] ** $_[1]},
HANDLE
=> \*STDOUT,
}
print $rec->{ TEXT};
print $rec->{ SEQUENCE}[ 0];
print $rec->{ LOOKUP}{ "key"};
($first_k, $first_v) = each %{ $rec->{ LOOKUP}};
$answer = &{ $rec->{ THATCODE}} ( $arg);
$answer = &{ $rec->{ THISCODE}} ( $arg1, $arg2);
print { $rec->{ HANDLE} } "a string\n";
3.6
Typeglobs
Typeglobs establish an abstraction layer that relates symbol table entries to data types (
$a @a %a &a a). They can
be used to avoid de-referencing:
use vars qw( $a *b);
$a = 10;
*b = *a;
$b++;
print "a: $a\n"; # -> 11
In the next example an array reference is passed to a subroutine:
use vars qw( @a *b);
@a = qw( a b c);
print " a: @a \n"; # -> ’a b c’
f1( *a);
print " a: @a \n"; # -> ’d e f’
sub f1
{
local( *b) = shift;
@b = qw( d e f);
}
Notice that typeglobs can be localized. But they can not be lexical variables (
my).
References
${\$x} and typeglobs x{*x} are equivalent. Thus we have:
*b = \$a;
# selective aliasing
*PI = \3.1415927;
# read-only variables
*f1 = sub {print "hello\n";} # named anonymous subroutines
f1();
3.7
Special Variables
Variable
Meaning
$!
Error message
$/
Input record separator
$"
List separator
$_
Default variable
$0, $PROGRAM_NAME
program name
$$
current process id
$.
Current line number of the input file
__FILE__
Current file name
__LINE__
Current line number
3.7.1
The Input Record Separator
undef $/;
$_ = <FH>;
s/\n[ \t]+/ /g;
3.7.2
The Default Variable $
The default input and pattern-searching variable, used in:
• file tests (-f, -d) except -t which defaults to STDIN
• print, unlink
• pattern matching m// s/// tr/// when used without =˜
• default iterator in foreach
• default implicit iterator for grep and map.
• the destination for <FH> when it is the sole criterion of a while test.
# input
while(<>){...} # only equivalent in while
while( defined( $_ = <>)){...}
# input and pattern matching
while( <FILE>){ print if /http:/;}
3.7.3
Errors, $ERRNO
If used in numeric context,
$! ($ERRNO) yields the value of the errno variable. In string context it yields the system
error string.
chdir "/home/typo" or die "chdir: $!\n";
The program terminates with
chdir: No such file or directory.
3.8
The Scope of Variables, my, local, our
Lexical variables are tagged with
my. Their scope is limited to the surrounding statement block. Global variables are
introduced with
our, example:
our $x = 1;
if( $x > 0)
{
my $x = 2;
print " x = $x\n"; # prints ’x = 2’
}
print " x = $x\n"; # prints ’x = 1’
In early Perl versions the
our verb was not available. Instead one had to write:
use vars qw( $x);
$x = 1;
Global variables can be made
local to a block. Their value is saved and restored at the end of the block. The new
value becomes available not only inside the block but also for all subroutines that are called from inside the block.
our $x = 1;
f1();
f2();
# prints ’1’
sub f1 {
local( $x) = 2;
f2();
# prints ’2’
}
sub f2 {
print "x = $x\n";
}
The function
local is especially useful for temporarily changing builtin variables. See section 7.7 for an example. It
shows how
STDOUT is re-assigned to point to a text widget.
Chapter 4
Operators
4.1
File Test Operators
Operator
Meaning
-d
directory
-e
exits
-f
regular file
-l
symbolic link
-r
readable
-s
non-zero size (returns size)
-u
setuid bit set
-w
writable
-x
executable
-B
binary file
-T
text file
Example:
if( -e $file_name){ ...};
4.2
Precedence of Operators
Associativity
Operator
Left
Terms and list operators
Left
->
Nonassociative
++ --
Right
**
Right
! ˜ \ and unary + -
Left
=˜ !˜
Left
* / % x
Left
+ - .
Left
<< >>
Nonassociative
Named unary operators
Nonassociative
< > <= >= lt gt le ge
Nonassociative
== != <=> eq ne cmp
Left
&
Left
! ˆ
Left
&&
Left
||
Nonassociative
.
Right
?:
Left
, =>
Nonassociative
List operators
Right
not
Left
and
Left
or xor
Term: variables, quote, quotelike operators, expressions in parentheses, any function whose arguments are parenthe-
sized.
List operator: print, sort, chmod, etc.
15
Named unary operator: -e (file tests), defined, chdir, sqrt, undef, etc.
4.3
Logical Operators
Operator
Meaning
$a && $b
and
$a || $b
or
! $a
not
$a and $b
and
$a or $b
or
not $a
not
Examples:
if( $a > 5 && $b < 10)
{
...
}
$home = $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7];
4.4
Bitwise Operators
Operator
Meaning
&
and
|
or
ˆ
excl. or
<<
shift left
>>
shift right
$r1 = 0xfa;
$r2 = 0xfb;
$r3 = 0xfc;
#
# combine 3 bytes to a 24 bit word
#
$r = $r1 | $r2 << 8 | $r3 << 16 ;
#
# r: 0xfcfbfa
#
#
# combine the complement of 3 bytes to a 24 bit word
#
$r = (˜$r1 & 0xff) |
(˜$r2 << 8
& 0xff00) |
(˜$r3 << 16
& 0xff0000) + 1;
#
# r: 0x30405
#
4.5
Comparison Operators
Numeric
String
Return Value
==
eq
True if $a is equal $b
!=
ne
True if $a is not equal $b
<
lt
True if $a is less than $b
>
gt
True if $a is greater than $b
<=
le
True if $a is not greater than $b
<=>
cmp
0 if equal, 1 if $a is greater, -1 if $b is greater
4.6
split
@arr = split //, $string;
Splits a string into individual characters.
@lines = split /ˆ/m, $file;
Splits a file contents into separate lines;
Operator
Meaning
Concatenation
$line = "first" . "hast";
Join
$temp = join($", @ARGV);
print $temp;
Repetition
$line = "123";
$i = 3;
print $line x $i;
123123123
Split
@lines = split /ˆ/m, $buffer;
4.7
Miscellaneous Operators
expr1, expr2
Comma operator. Evaluates the left side, then evaluates the right side and returns the result of the right side.
test_expr ? true_expr : false_expr
Conditional operator. Depending on the
test_expr the true_expr or the false_expr is evaluated and becomes
the value of the entire expression. This code demonstrates how to toggle a ’paused’ flag:
$paused ? ($paused = 0) : ($paused = 1);
..
Range operator, in list context:
foreach my $i (1 .. 100){ print "i= $i\n";}
@abc = (’A’ .. ’Z’, ’a’ .. ’z’);
Chapter 5
Control Statements
5.1
If
if( $city eq "Hamburg"){
...
}
elsif( $city eq "Hannover"){
...
}
else {
...
}
5.2
Loops
LINE: while( $line = <SESAME>){
....
last LINE if $line eq "\n";
...
next LINE if $line =˜ /ˆ#/; # skip comment lines
}
#
# arrays in scalar context return length
#
while( @ARGV)
{
process( shift @ARGV);
}
#
#
#
for( $i=0; $i < 10; $i = $i + 1)
{
...
}
#
# $elem is a reference, not a copy, i.e.:
# changing $elt changes @list
#
foreach my $elt (@list)
{
...
}
18
#
# $i in [0, 100]
#
foreach my $i (0 .. 100)
{
...
}
#
# keys of a hash table
#
foreach $key (sort keys %hash)
{
...
}
5.3
Switch
There is no
switch statement in Perl, but the bare block contruct allows us to write the equivalent:
$i = $whatever;
SWITCH: {
if( $i =˜ /case1/) { $var = 1; last SWITCH;}
if( $i =˜ /case2/) { $var = 2; last SWITCH;}
$var = 3;
}
or
$i = $whatever;
SWITCH: {
$var = 1, last SWITCH if( $i =˜ /case1/);
$var = 2, last SWITCH if( $i =˜ /case2/);
$var = 3;
}
Chapter 6
Regular Expressions
6.1
Modifiers
m/PATTERN/gimos
/PATTERN/gimos
Modifiers
g global
i case-insensitive
m treat string as multiple lines
s treat string as single line
With
m any non-whitespace pairs of characters can be used as delimiters:
if( $name =˜ m#ˆ/home/user# )
{
...
}
6.2
Metacharacters
\ | ( ) [ { ˆ $ * + ?
. any character but newline
ˆ,$ start/end of line
* zero or more occ. of the prec. char. or group
+ one or more occ. of the prec. char. or group
? zero or one occ. of prec. char. or group (makes * and + ungreedy)
[a-z] range fo chars, [abc] group of chars
[ˆ...] anything but range fo chars.
\ escape character
\\ backslash
\b start or end of word
\e escape
\B next string not in word
\< start of word
\> end of word
20
\d digit
\D non-digit
\n newline
\s a whitespace character
\S a non-whitespace character
\t tab
\w any word charcter
\W any non-word character
\| multiple patterns
(...) group
6.3
Quantifiers, greedy, ungreedy
+
at least one, {,1}
*
zero or more, {0,}
/\d{7,11}/ 7 to 11 digits
/(bam){2}/ matches "bambam"
Quantifiers are
greedy. Minimal matching is selected by a “?” following a quantifier, e.g.:
my $t = "abc123";
$t =˜ /(.+)\d/; # greedy
print "$1\n";
produces
abc12, while
my $t = "abc123";
$t =˜ /(.+?)\d/; # ungreedy
print "$1\n";
prints
abc.
Regular expressions match as
early as possible, e.g. if s/x*//; is applied to the string $_ = "fred xxxx john";
nothing is substituted because
x* includes the empty string which stands at the beginning of every string.
6.4
Interpolation
#
# Interpolation
# -------------
#
$foo = "moo";
#
$temp =˜ /$foo$/;
# is equivalent to
$temp =˜ /moo$/;
6.5
Variables
$& returns the entire matched string
$‘ returns everything before the matched string
$’ returns everything after the matched string
$1 refers to the first group, outside the pattern
$2 refers to the second group, outside the pattern
$3 ...
\1 refers to the first group, inside the pattern
\2 refers to the second group, inside the pattern
\3 ...
6.6
Examples
6.6.1
Find a word in a string
#
# ’Fred’ somewhere in $i:
#
if( $i =˜ /Fred/){ ...}
6.6.2
Skip comment lines
#
# skip comment line (!) or empty line
#
next if( $line =˜ /(\s*!.*)|(ˆ$)/);
6.6.3
Grouping
#
# Grouping:
#
if( $i =˜ /(Fred|Wilma|Barney) Flintstone/){ ...}
#
# ’moomoomoo’
#
if( $i =˜ /(moo){3}/){ ...}
6.6.4
Backreference, parse time string
#
# Backreference
#
if($i =˜ /Time: (..):(..):(..)/){
$hours = $1;
$mins = $2;
$secs = $3;
}
6.6.5
XML vs. HTML, replace ’¡’ and ’¿’
$buffer_out .= ‘cat /online_dir/online.xml‘;
$buffer_out =˜ s/</</g;
$buffer_out =˜ s/>/>/g;
6.6.6
Special characters, string starts with ’/’
#
# Special characters, make sure that $flag_value starts with a ’/’
#
if( $flag_value !˜ /ˆ\/.*/ )
{
$flag_value = "/" . $flag_value;
}
6.6.7
Trimm leading and tailing white space
#
# trim leading and trailing white space of a single line
#
$line =˜ s/ˆ\s*(.*?)\s*$/$1/;
#
# trim leading and trailing white space of an array of lines
#
map { $_ =˜ s/ˆ\s*(.*?)\s*$/$1/} @lines;
6.6.8
Remove path
#
# remove path
#
$fname =˜ s/.*\///;
6.6.9
Remove the file extension
#
# remove file extension
#
$fname =˜ s/\..*//;
6.6.10
Change path
#
# change path
#
$path =˜ s(/usr/bin)(/usr/local/bin);
6.6.11
Reverse the first two fields, exclude a range of characters
#
# reverse the 1st two fields
#
s/([ˆ ]*) *([ˆ ]*)/$2 $1/;
6.6.12
Translate to lower case letters
#
# to lower case letters
#
$ARGV[1] =˜ tr/A-Z/a-z/;
6.6.13
Remove Ctrl-M
#
# remove ˆM
#
$line =˜ tr/\015//;
6.6.14
Count the stars
#
# count the stars in $_
#
$cnt = tr/*/*/;
Chapter 7
File I/O, File Handles
7.1
The Basics
Input:
open( FH, "<filename");
open( FH, "input-pipe-command");
open( FH, "ls -1 *.fio");
read with
$line = <FH>;
Output:
open( FH, ">filename"); new file
open( FH, ">>filename"); append
open( FH, "| output-pipe-command");
write with
print FH "whatever\n";
Close:
close( FH);
Example:
open( FH, ">fh.output");
print FH "there is no comma between ’FH’ and this string \n";
close( FH);
open( FH, "<fh.output");
while( my $line = <FH>) {
chomp $line;
# remove the trailing <new-line>
print ": $line \n";
}
close( FH);
7.2
Passing File Handles
File handles are passed by referencing the corresponding typeglob.
#!/usr/bin/perl
open( FH, ">test.file");
f1( \*FH);
close( FH);
sub f1
{
my ($fh) = @_;
print $fh "some-output\n";
}
25
7.3
Storing File Handles in a Hash
Sometimes one has to store a file handle in a hash:
open( FH, ">test.log");
$h{ fh} = \*FH;
print { $h{ fh}} "some output\n";
close( $h{ fh});
Notice the strange syntax:
print needs a {$h{ fh}}, whereas close wants a $h{ fh}.
7.4
The FileHandle Module
use FileHandle;
$fh = new FileHandle "< nodes.lis";
@nodes = <$fh>;
undef $fh; # automatically closes the file
7.5
Flushing Output
If a print statement is not terminated by
’\n’, the output is buffered. This feature can be disabled by setting the special
variable
$|:
$| = 1;
print "hello world";
sleep(2);
print "\n";
You can also say:
use FileHandle;
STDOUT->autoflush(1);
print "hello world";
or
use FileHandle;
print "hello world";
STDOUT->flush();
7.6
Reading Single Keystrokes
See the example 12.3.2 for how to read single keystrokes from STDIN.
7.7
I/O Re-direction, local( *STDOUT)
I/O redirection works basically by localizing typeglobs that describe file handles. In the first example
STDOUT is
redirected to an output file:
sub ...
{
local( *STDOUT);
open( F, ’>/tmp/x’);
*STDOUT = *F;
print "hello world \n";
close(F);
}
The following code shows how
STDOUT is redirected to a text widget (by J. Medved):
my $w_text = $top->Scrolled( ’Text’,
-relief => ’sunken’,
-setgrid => ’true’,
-height => ’30’
-scrollbars => ’e’)->pack();
sub ...
{
local( *STDOUT);
tie( *STDOUT, ’Tk::Text’, $w_text);
open(NET, "ls -al |");
while (<NET>)
{
print "$_";
}
close( NET);
}
7.8
readdir
The following piece of codes reads all file names of the process working directory into an array.
opendir( D, ".");
@files = readdir(D);
closedir( D);
Chapter 8
Functions
8.1
alarm
The section 8.6.1 demonstrates how a time-out is implemented for a critical piece of code using the
alarm() function.
8.2
BEGIN, END
The functions
BEGIN and END are executed as early and as late as possible:
BEGIN
{
print " in the beginning \n";
}
END
{
print " this is the end \n";
}
print "hello world \n";
8.3
chdir
This function changes the working directory.
chdir EXPR;
#
# the following lines are equivalent
#
chdir "/home/user/";
chdir( $ENV{ "HOME"} || $ENV{ "LOGDIR"});
chdir ();
chdir (getpwuid( $<)[7]);
8.4
chr, ord, character conversion
chr() converts a number into a character, ord() does the opposite:
$string = chr(65) . chr(66) . chr(67); # "ABC"
$i = ord(’A’); # 65
The conversion of multiple characters can also be done with
pack( "C*", @list).
my @list = ( 65, 66, 67);
print pack( "C*", @list) . "\n"; # --> "ABC\n"
28
8.5
doty
This function returns the day-of-the-year as a floating point number.
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isday) = localtime time();
my $doty = sprintf "%g", ($yday + $hour/24 + $min/1440.);
8.6
eval
The argument is parsed and executed as if it were a Perl program.
my $ret = eval $perl_code;
if( $@)
{
print "error: eval returned $@\n";
}
The value returned from
eval is the value of the last expression evaluated.
eval traps otherwise-fatal errors:
#!/usr/bin/perl
$a = 1;
$b = 0;
eval
{
$c = $a / $b;
};
if( $@)
{
print "error: eval returned $@\n";
}
8.6.1
eval, alarm (timeout)
The following example shows how a time-out can be installed for a critical function call.
#!/usr/bin/perl -w
use strict;
eval
{
local $SIG{ ALRM} = sub { die "time-out"; };
alarm(3);
#
# in a realistic case the sleep() function is replaced by some
# critical piece of code that needs a time-out handling, like connect()
#
sleep(4);
#
# the alarm is cleared, if all went well
alarm(0);
};
if( $@)
{
print "eval returned an error: $@\n";
}
8.7
getpwuid
#
# the function getpwuid translates the user id "$<" to
# the corresponding passwd file entry.
#
($name, $passwd, $uid, $gid, $quota, $comment, $gcos, $dir, $shell) =
getpwuid( $<);
8.8
grep
Evaluates an expression in a Boolean context of each element of an array, temporarily setting
$_.
@code_lines = grep !/ˆ#/, @all_lines;
8.9
isatty
Find out whether the process is controlled by a terminal:
use POSIX;
my $flag_tty = POSIX::isatty( ’STDIN’);
8.10
join
Separate strings are put together by:
my $temp = join ’:’, @files;
8.11
length
Returns the size of a scalar:
$i = " " x 320;
print " Length " . length( $i) . "\n";
Use the function scalar to find the length of an array and scalar keys to find the size of a hash.
8.12
localtime
($sec, $min, $hour, $mday,
$mon, $year, $wday, $yday, $isday) = localtime( time());
$year += 1900;
$mon = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec)[$mon];
print "The last access time of $filename is $mday.$mon.$year $hour:$min\n";
#
# in scalar context localtime returns a string
#
print scalar localtime;
# --> Tue Oct 25 08:45:10 2005
8.13
map
Evaluates an expression for each element of a list:
@words = map {split ’ ’} @lines;
Here is another example. The variable
$_ is temporarily set to each element of the list. Notice that the operation is
destructive -
@arr is changed.
my @arr = qw(1 2 3);
my @new = map {$_ *= 2}
@arr;
print "@new, @arr\n"; # --> ’2 4 6, 2 4 6’
8.14
mkdir
Creates a directory, permissions are specified by
$mode, modified by umask.
$ret = mkdir( $file_name, $mode);
Suppose
umask is 0022 and you say:
$ret = mkdir( "test_dir", 0777);
test_dir is then created with drwxr-xr-x.
8.15
pack, unpack
A list of values is packed into a binary structure.
$ret = pack(TEMPLATE, @list);
The TEMPLATE is a sequence of characters that give the order and type of values, as follows:
Each letter may optionally be followed by a number which gives a repeat count. A ∗ for the repeat count means to use
however many items are left.
Examples:
@list = (65,66,67);
$str = pack("CCC", @list);
# --> "ABC", ’C’ -> unsigned char
$str = pack("C3", @list);
# --> "ABC"
$str = pack("C*", @list);
# --> "ABC"
@list = unpack("C*", $str); # --> 65 66 67
$str = pack("ccxxcc", @list); # --> "AB\0\0CD"
$str = pack("s2",1,2); # --> "\1\0\2\0" on little-endian
# --> "\0\1\0\2" on big-endian
$str = pack("a4","abcd","x","y","z");
# --> "abcd"
$str = pack("aaaa","abcd","x","y","z"); # --> "axyz"
$str = pack("a14","abcdefg"); # -->"abcdefg\0\0\0\0\0\0\0"
sub bin2dec { return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); }
A
An ascii string, will be space padded.
a
An ascii string, will be null padded.
c
A signed char value.
C
An unsigned char value.
s
A signed short value.
S
An unsigned short value.
i
A signed integer value.
I
An unsigned integer value.
l
A signed long value.
L
An unsigned long value.
n
A short in ”network” order.
N
A long in ”network” order.
p
A pointer to a string.
v
A short in ”VAX” (little-endian) order.
V
A long in ”VAX” (little-endian) order.
x
A null byte.
X
Back up a byte.
@
Null fill to absolute position.
u
A uuencoded string.
b
A bit string (ascending bit order, like vec()).
B
A bit string (descending bit order).
h
A hex string (low nybble first).
H
A hex string (high nybble first).
Table 8.1: pack
Unpack does the reverse of pack: it takes a string representing a structure and expands it out into an array value,
returning the array value. (In a scalar context, it merely returns the first value produced.)
The TEMPLATE has the same format as in the pack function. Here’s a subroutine that does substring:
sub substr
{
local($expr,$offset,$len) = @_;
unpack("x$offset a$len", $expr);
}
8.16
print, sprintf
print "hello world\n";
open( FH, ">fh.output");
print FH "there is no comma between ’FH’ and this string \n";
close( FH);
The function sprintf returns a string, usage, e.g.:
print sprintf "x = %g\n", $x;.
# integer
print sprintf "%d", $i;
print sprintf "%08d", $i;
# with up to 8 leading zeros
print sprintf "%x", $i;
# hexadecimal
# exponential notation
print sprintf "<%e>", 10;
# prints <1.000000e+01>
print sprintf "<%.1e>", 10; # prints <1.0e+01>
# fixed decimal notation
print sprintf "<%f>", 1;
# prints <1.000000>
print sprintf "<%.1f>", 1;
# prints <1.0>
print sprintf "<%.0f>", 1;
# prints <1>
# %e or %g
print sprintf "%g", $x;
# strings
print sprintf "%s", $str;
print sprintf "%-s", $str;
# left aligned
8.17
rand, srand
Fractional random numbers:
srand();
# sets random seed, def.: time()
srand(1);
# generate reproducible random number
srand( time() ˆ ($$ + ($$ << 15))); # sets random seed, $$ is the PID
$x = rand();
# [0,1[
$x = rand(10);
# [0,10[
8.18
rename
$ret = rename( $oldname, $newname); # returns 1 for success
8.19
require
require "Module.pm";
The code of
Module.pm is loaded and executed. require keeps track of the loaded modules by updating @INC. If
it is necessary to re-load a module, the corresponding entry has to be cleared first:
#
# reloading a module
#
delete $INC{ Module.pm};
require "Module.pm";
8.20
socket, connect, fcntl, select, · · ·
See the examples 12.3.14, 12.3.15 and ?? for how to use sockets.
8.21
sort
#
# sorting strings:
#
@ascending = sort @unsorted;
@ascending = sort { $a cmp $b} @unsorted;
#
# sorting numbers
#
@ascending = sort { $a <=> $b} @unsorted;
@descending = sort { $b <=> $a} @unsorted;
#
# adc names, make sure adc2 precedes adc11 and adcX precedes vfcX
#
my @arr = qw( adc1 adc2 adc11 vfc1 vfc2 vfc11);
@arr = sort { $a =˜ /(\D+)(\d+)/; # e.g.: VFC2
my $a_pre = $1;
# VFC
my $a_i = $2;
# 2
$b =˜ /(\D+)(\d+)/;
my $b_pre = $1;
my $b_i = $2;
#
# if the prefixes differ, use them to sort ...
#
if( $a_pre ne $b_pre)
{
$a_pre cmp $b_pre;
}
#
# ... otherwise use the numbers
#
else
{
$a_i <=> $b_i;
}
} @arr;
8.22
sotd
This function returns the seconds-of-the-day, the number of seconds since 00:00h.
my $scs = Spectra::sotd();
8.23
split
Splits a string into pieces:
@lines = split /ˆ/m, $file_contents;
@words = split ’ ’, $line;
@characters = split ’’, $line;
Here is another example:
#!/usr/bin/perl -w
use strict;
my $buffer = "a
b
\012\012 \015
c ";
$buffer =˜ s/\015|\012//g;
print $buffer . "\n";
my @arr = split / +/, $buffer;
foreach my $elm ( @arr)
{
print "<$elm>\n";
}
The output is:
a
b
c
<a>
<b>
<c>
8.24
stat, localtime
This example finds the last access time of a file and converts it into a readable format:
($dev, $ino, $mode, $nlink, $uid, $gid,
$rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat $filename;
($sec, $min, $hour, $mday,
$mon, $year, $wday, $yday, $isday) = localtime $atime;
$year += 1900;
$mon = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec)[$mon];
print "The last access time of $filename is $mday.$mon.$year $hour:$min\n";
8.25
substr
Extracts a substring and returns it:
$ret = substr( $expr, $offset[, $len]);
If offset is negative,
substr starts that far from the end of the string. If len is omitted, the rest of the string is
returned.
8.26
System
#
# return status == 0 indicates normal end
#
system( "someShellCommand") == 0 or die "error return: $?";
#
# the return status:
#
- the lower 8 bit encode a received signal number
#
- divide by 256 to obtain the actual exit status
#
$status = system( "someShellCommand");
if( $status == 0)
{
print "successful return \n";
}
elsif( $status == 0xff00)
{
print "error return $!\n";
}
elsif( $status > 0x80)
{
$status >>= 8;
print "exit status $status \n";
}
else
{
print "received signal $status\n";
}
#
#
#
@lines = ‘cat $file_name‘;
8.27
time
This function returns number of non-leap seconds since 1.1.1970, UTC. Useful for feeding the value to other functions
or to determine time differences.
#!/usr/bin/perl
#
$timeStart = time();
sleep 3; # replace this by the piece of code you are interested in
$timeTotal = time() - $timeStart;
print " Total time $timeTotal \n";
exit 0;
The
time() output may also be fed into localtime.
($sec, $min, $hour, $mday,
$mon, $year, $wday, $yday, $isday) = localtime time();
8.28
times
This POSIX function returns the elapsed realtime since system startup, the user and system time of the process and the
user and system time of the child processes. All times are returned in clock tics.
#!/usr/bin/perl
#
use POSIX;
($realtime, $user, $system, $cuser, $csystem) = POSIX::times();
$seconds = $realtime * 0.01;
print <<EOF;
POSIX::times() output:
Real time since system startup
tics:
$realtime
seconds: $seconds
Process time [tics]
user:
$user
system: $system
Child processes [tics]
user:
$user
system: $system
EOF
;
exit 0;
8.29
uc, lc, ucfirst, lcfirst, case conversion
Case conversions can be done by functions · · ·
$BIG = uc( $small);
# string to upper case letters
$small = lc( $BIG);
# string to lower case letters
$Big = ucfirst( $small); # first letter to upper case
$sMALL = lcfirst( $BIG); # first letter to lower case
· · · or by string escapes.
$BIG = "\U$small";
# string to upper case letters
$small = "\L$BIG";
# string to lower case letters
$Big = "\u$small";
# first letter to upper case
$sMALL = "\l$BIG";
# first letter to lower case
String escapes can also be used in regular expressions:
$line = "tHe QUICK brOWN FOX";
$line =˜ s/(\w)/\u\L$1/g;
# The Quick Brown Fox
8.30
unlink
Delete a list of files:
$cnt = unlink <test*.fio>; # returns the number of deleted files
unlink "test.ps";
unlink @files;
8.31
Numeric functions
Name
Explanation
abs
atan2
pi = atan2(1, 1) * 4
cos
EXPR in radians
exp
e to the power of EXPR.
The ** operator does general exponentiations.
hex
Interprets EXPR as a hex-string
and returns a decimal number
Inverse:
$str = sprintf "%lx", $i; # an ell
int
The integer portion of EXPR
log
base
e
oct
Interprets EXPR as an octal string
and returns a decimal number
$val = oct $val if $val =˜ /ˆ0/;
Inverse:
sprintf "%lo", $i; # an ell
rand
Returns a random fractional number
between 0 and EXPR (or 1)
sin
EXPR in radians
sqrt
srand
Sets the random seed,
default:
srand( time);
Chapter 9
Subroutines
Parameters are passed to subroutines by setting global variables or through the default variable. Here is an example
which demonstrates how the the default variable is used:
sub max
{
my $max= shift(@_);
foreach $ret (@_)
{
$max = $ret if $max < $ret;
}
return $max;
}
$bestday = max( $mon,
$tue, $wed, $thu, $fri);
The default variable may contain a reference to a hash:
sub find_device_name
{
my $params = shift;
my $device = $$params{device};
if( $device)
{
delete $$params{device};
goto device_found;
}
...
device_found:
return " $device";
}
...
$buffer = find_device_name( \%params);
...
So far, the subroutines returned scalar variables. It is also possible to return an array:
sub1
{
...
return wantarray ? ( $a, $b, $c) : undef;
}
...
($x, $y, $z) = sub1();
...
38
The function
wantarray returns 1, if the subroutine was called in a list context:
Note that subroutines may return an
undefined value:
sub sub1
{
...
$ret_stat = $somevalue;
goto finish;
...
$ret_stat = undef;
goto finish;
...
finish:
return $ret_stat;
}
$ret = sub1();
if( defined $ret)
{
...
}
else {
print "Error\n";
}
The function
caller returns information about the calling frame:
($package, $filename, $line) = caller;
There is an optional numeric argument to
caller() which specifies the number of frames to be popped from the
stack.
9.1
Closures, anonymous subroutines
Closures are anonymous subroutines which reference lexical variables of a surrounding block and this way retain
their values. Here is an example from the textbooks:
sub genanon
{
my ($string) = @_;
return sub {print "$string\n"};
}
my $f1 = genanon( "Guten Tag");
my $f2 = genanon( "Hallo");
&$f1(); # prints ’Guten Tag’
&$f2(); # prints ’Hallo’
The variable
$string is created, each time genanon is invoked. Normally lexical variables are deallocated when
the surrounding function exits. But
genanon creates a function that uses $string. This has the effect that the
reference count to the value of
$string does not reach zero when genanon returns. Hence $f1 and $f2 refer to
subroutines that have some private piece of data.
Let’s look at a more realistic example. Closures are best put into action as call-back routines for widgets. In the
following example a menu button is created which allows the user to set a variable named
$var. Each of the menu
items select a specific value.
#!/usr/bin/perl -w
use strict;
use Tk 800.000;
use vars qw($var);
$var = 1;
my $w_top = Tk::MainWindow->new;
my $b = $w_top->Menubutton( -relief => ’raised’,
-text => "Button: $var")->pack();
foreach my $i qw( 1 2 5 10 20)
{
$b->command( -label => "$i",
-command =>
sub {
$var = $i;
$b->configure( -text => "Button: $var")});
}
#
# exit button
#
$w_top->Button( -relief => ’raised’,
-text => "exit",
-command => sub { $w_top->destroy();})->pack();
MainLoop;
Notice that
$i is a lexical variable to the foreach loop block. Thus the anonymous functions which are assigned to
the
-command parameter contain private values of $i.
Closures are a bit confusing. To clarify things it may be instructive to modify the code in a way that it fails: replace
’
use vars qw($var)’ by ’use vars qw($var $i)’ and ’my $i’ by ’$i’ . Insert a ’$i = 1234;’ line
before the loop.
$i is turned into a global variable. All actions that are invoked by the button set $var to 1234.
Chapter 10
Packages, Modules
Modules are included with use, a compiler directive. The extension .pm stands for perl module.
The package command switches between the packages (symbol tables).
Default package:
$:: or $main::. The main symbol table is called %main::.
Packages may be nested:
$OUTER::INNER:var.
Importing symbols:
#!/usr/bin/perl
sub sub1{ print "this is main::sub1 \n"; }
sub sub2{ print "this is main::sub2 \n"; }
use Tmodule qw( sub1 );
sub1();
sub2();
The module file contains:
#!/usr/bin/perl
package Tmodule;
require Exporter;
@ISA = qw( Exporter);
@EXPORT = qw( sub1 sub2);
@EXPORT_OK = qw( $tvar );
sub sub1{ print "this is Tmodule::sub1 \n"; }
sub sub2{ print "this is Tmodule::sub2 \n"; }
$tvar = "12";
return 1;
The following output is generated:
this is Tmodule::sub1
this is main::sub2
Note that Tmodule::sub2 is exported but not mentioned in the use command. That’s why the corresponding routine
from main is executed.
require
is executed at run-time. Routines from the required package have to be fully qualified, e.g.:
Tmodule::sub1().
The function AUTOLOAD is called for all unresolved references:
sub AUTOLOAD {
my $program = $AUTOLOAD;
$program =˜ s/.*:://;
system( $program, @_);
}
date();
who( ’am’, ’i’);
ls( ’-1’);
41
10.1
Include Path
An additional directory is inserted at the top of the include path by:
BEGIN
{
unshift( @INC, "/home/user/dir");
}
10.2
Symbols Tables
Suppose a program consists of the modules Spectra, Spc and Util. In this case all symbols can be written to an output
file by:
no strict ’refs’;
open FH, ">symbols.lis";
foreach my $mod ( qw(main Spectra Spc Util))
{
foreach my $key (keys %{ "main::" . $mod . "::"})
{
print FH ${ "main::" . $mod . "::"}{$key} . "\n";
}
}
close FH;
Chapter 11
Signal Handling
#
# print all signal names
#
use Config;
print $Config{sig_name};
#
# install a handler
#
$SIG{"INT"} = \&signal_handler;
sub signal_handler
{
my $signam = shift;
print "Caught SIG$signam";
...
}
11.1
Alarm Handler
The following example demonstrates how
eval is used with an alarm handler. If the time-out occurs, the eval block
dies, returns 0 and control is transfered to the next statement.
...
#
$proto = getprotobyname(’tcp’);
$port = getservbyname(’ssh’, ’tcp’);
for $sub ( 1 .. 255)
{
$node = "131.169.$net.$sub";
socket( SOCKET, PF_INET, SOCK_STREAM, $proto);
$sin = sockaddr_in($port, inet_aton( $node));
eval
{
local $SIG{ALRM} = sub { die };
alarm(1);
connect(SOCKET,$sin);
alarm 0;
} || next;
$reply = <SOCKET>;
if( defined $reply)
{
...
}
43
close( SOCKET);
}
11.2
Exit Handler
...
#
END
{
print "exiting \n";
}
Chapter 12
Examples
12.1
Perl Language Features
12.1.1
Command line arguments: ARGV
Hashes can be useful when a script is called with parameters. But first the ARGV array has to be copied to a hash.
#
# copy an array to a hash
#
my %params = @ARGV;
#
# look for command line parameter
#
my $volts = $params{volts} || 0.1;
This piece of code could have been invoked by
> perl script.pl volts 0.2
Another example for parsing the command line options:
while( $_ = $ARGV[0], /ˆ-/){
shift;
if( /ˆ-D(.*)/){ $debug = $1;}
if( /ˆ-v/){ $verbose++;}
...
}
12.1.2
Meta Information, caller(), ref(), isa(), ...
($package, $file, $line) = caller();
Call stack information.
foreach $k (keys %Foo::) ...;
The global symbols of the package Foo.
print ref($r);
What a reference contains.
$obj->isa(”Foo”);
Returns true, if
$obj inherits Foo.
$obj->can(”bar”);
Returns true, if it supports method
bar.
12.1.3
Sleeping with a finer resolution, select()
The function
select() can be called with a time-out in seconds which is fractional.
select undef, undef, undef, 1.23;
45
12.1.4
Timeout
The section 8.6.1 demonstrates how a time-out is implemented for a critical piece of code using the
alarm() function.
12.1.5
ascii format()
The function ascii format() receives a string and returns the same string with white space characters being made visible,
e.g. “abc¡CR¿¡LF¿”.
sub ascii_format
{
my ($argin) = @_;
my $argout = "";
foreach my $i ( 0 .. (length($argin) - 1))
{
my $let = substr( $argin, $i, 1);
my $dec = unpack( "C", $let);
if( $dec < 32)
{
if( $dec == 10)
{
$argout .= "<LF>";
}
elsif( $dec == 13)
{
$argout .= "<CR>";
}
else
{
$argout .= "<$dec>";
}
}
else
{
$argout .= $let;
}
}
return $argout;
}
12.2
OS Interface
12.2.1
Executing shell commands, system()
Shell commands may be executed using backticks (grave accents):
my @files = ‘ls -1‘;
or with the help of the
system() function:
system( "cp $file_src $file_dest");
Mind that double quoted strings and backticked strings are subject to variable interpolation.
12.2.2
Remove many files, opendir()
Directories may contain lots of files. Therefore, wild-carded commands like
rm ∗ may result in an overflow. The
following script helps to clean-up such a directory:
#!/usr/bin/perl -w
sub yesno { print "$_[0] y/[n]: ";return (<STDIN> =˜ /ˆ(y|Y)$/);}
sub print_usage
{
print <<EOF;
The purpose of rm.pl is to delete many files.
Usage:
# rm.pl file_pattern [y]
’file_pattern’ is a regular expression pattern.
Make sure that wildcard characters are quoted.
e.g.: rm.pl ’tst.*\.fio’ y
EOF
1;
}
my ($file_spec, $flag, $rest) = @ARGV;
exit print_usage() if( !defined $file_spec || defined $rest);
$flag = ’n’ if( !defined $flag);
opendir( D, ".");
@files = readdir(D);
closedir( D);
foreach my $fname (@files)
{
$fname =˜ s/ˆ\s*(.*?)\s*$/$1/; # remove white space
next if( $fname !˜ /$file_spec/);
if( $flag eq "y" || yesno( "delete $fname"))
{
print " deleting $fname \n";
unlink $fname;
}
}
exit 0;
12.2.3
Rename files
It happens quite often that directories contain files names which are tailored according to some rule, like a common
generic part. The following script demonstrates how the names of these files can be changed.
#!/usr/bin/perl -w
#
# searches the current directory for files that are named ’*_fzm.fio’ and
# renames them to ’*_online.fio’.
#
use strict;
my $temp;
my @files = <*_kzm.fio>;
foreach my $file (@files)
{
$temp = $file;
$temp =˜ s/_kzm\.fio/_online\.fio/;
print " renaming $file to $temp \n";
system( "mv $file $temp");
}
12.2.4
Replace blanks, ¨a, ¨
A, ¨o, etc. in file names
The following script renames the files of the current directory. All white space characters are replaced by ’ ’.
#!/usr/bin/perl -w
use strict;
sub yesno { print "$_[0] y/[n]: ";return (<STDIN> =˜ /ˆ(y|Y)$/);}
#
# read the file names of the current directory
#
opendir( D, ".");
my @files = readdir(D);
closedir( D);
foreach my $fname (@files)
{
#
# remove leading/trailing white space
#
$fname =˜ s/ˆ\s*(.*?)\s*$/$1/;
#
# see, if the file name still contains white space
#
next if( $fname !˜ /\s/ &&
$fname !˜ /[\200-\377]/);
my $fname_new = $fname;
#
# replace any white space character by ’_’, Umlaute
#
$fname_new =˜ s/\s/_/g;
$fname_new =˜ s/\344/ae/g;
$fname_new =˜ s/\304/Ae/g;
$fname_new =˜ s/\366/oe/g;
$fname_new =˜ s/\326/Oe/g;
$fname_new =˜ s/\374/ue/g;
$fname_new =˜ s/\334/Ue/g;
$fname_new =˜ s/\337/sz/g;
if( yesno( " rename \"$fname\" to $fname_new"))
{
system( "mv \"$fname\" $fname_new");
}
}
exit 0;
12.2.5
Substitute strings in files, simple
Suppose there are a number of files in a directory with a common structure and part of the contents has to be substituted
with some other characters for all of the files. The following script may be helpful:
#!/usr/bin/perl -w
#
# run through all .dat files of the current directory and remove
# the string ’mbar’ and replace the string ’Pump is off’ by ’0.’
#
use strict;
my @files = <*.dat>;
foreach my $file (@files)
{
print " converting file $file \n";
my @lines = ‘cat $file‘;
#
# notice that $line does not contain some copy of a line of @lines
# but is pointing to the actual value.
#
foreach my $line (@lines)
{
$line =˜ s/mbar//g;
$line =˜ s/Pump is off/0./g;
}
open FH, ">$file";
print FH "@lines";
close FH;
}
12.2.6
Substitute strings in source files
This section displays 2 scripts. The first, replace.pl, replaces a string in a single file. The second script calls replace.pl
for all files of a directory.
Note: create a copy of your directory before working with these scripts.
#!/bin/env perl
if( scalar( @ARGV) != 4)
{
print "\n./replace.pl fileName oldString newString flagReally \n";
goto finish;
}
if( ! -x "/usr/local/bin/vrsn")
{
print "\n vrsn does not exist \n";
goto finish;
}
my ( $fileName, $oldString, $newString, $flagReally) = @ARGV;
if( ! -r $fileName)
{
print " $fileName does not exist \n";
goto finish;
}
if( $flagReally)
{
system( "/usr/local/bin/vrsn -s $fileName");
}
@lines = ‘cat $fileName‘;
if( $flagReally)
{
open( FH, ">$fileName");
}
my $no = 0;
foreach $line ( @lines)
{
my $oldLine = $line;
if( $line =˜ s/$oldString/$newString/g)
{
print "line $no \n";
print " old: $oldLine";
print " new: $line";
}
if( $flagReally)
{
print FH $line;
}
$no++;
}
if( $flagReally)
{
close( FH);
}
finish:
The second script calls replace.pl for many files (all .c files of the directory):
#!/bin/env perl
my $oldString = "WWM";
my $newString = "exp_to_mw";
sub yesno
{
print "$_[0] y/[n]: ";
return (<STDIN> =˜ /ˆ(y|Y)$/);
}
my @files = ‘ls -1 *.c‘;
foreach my $file ( @files)
{
chomp $file;
if( $file !˜ /\.c/)
{
next;
}
my $ret = ‘grep $oldString $file && echo ok‘;
chomp $ret;
if( $ret =˜ /ok/)
{
if( yesno( "execute $file"))
{
system( "./replace.pl $file $oldString $newString 1");
}
else
{
goto finish;
}
}
}
finish:
12.2.7
Change the file protection, chmod()
chmod 0644, <*.c>;
12.2.8
Kill processes, yesno(), kill()
#!/usr/bin/perl
use strict;
#
# yesno returns 1, if the user entered ’y’ or ’Y’
#
sub yesno
{
print "$_[0] y/[n]: ";
return (<STDIN> =˜ /ˆ(y|Y)$/);
}
#
# main
#
my $line;
if( @ARGV != 1)
{
print <<EOF;
Usage:
kill_proc search_string
EOF
;
exit 1;
}
for $line (‘ps ax‘)
{
my ($pid, $tty, $stat, $time, @rest) = split ’ ’, $line;
my $command = join ’ ’, @rest;
#
# test whether the search string is part of the command field
# exclude the current process from being killed
#
if( $command =˜ /.*$ARGV[0].*/ &&
!( $command =˜ /.*kill_proc.*/))
{
if( yesno( "Kill ’$command’"))
{
kill 9, $pid;
}
}
}
exit 0;
12.3
IO, Sockets, RS232, USB, ...
12.3.1
Mirroring /dev/ttyS0, including the client
The following lines of code read some input from /dev/ttyS0 and send it back the same way.
#!/usr/bin/perl -w
use strict;
use POSIX qw(:termios_h);
use FileHandle;
my $buffer= "";
my $nfd;
#
# root> chmod 666 /dev/ttyS0
#
sysopen( SOCK, "/dev/ttyS0", O_RDWR) or die ’Failed to open /dev/ttyS0’;
my $fd = fileno( SOCK);
my $term = POSIX::Termios->new;
$term->getattr( $fd);
$term->setospeed( 4098);
# B115200
$term->setispeed( 4098);
my $lflag = $term->getlflag();
my $c_cflag = $term->getcflag();
$term->setcflag( $c_cflag | &POSIX::CS8);
$term->setattr( $fd, &POSIX::TCSANOW);
my $len;
while(1)
{
my $rin = my $win = my $ein = "";
vec( $rin, fileno( SOCK), 1) = 1;
$ein = $rin | $win;
$nfd = select( $rin, $win, $ein, 0.2);
if( $nfd)
{
$buffer = "";
$len = sysread( SOCK, $buffer, 100, 0);
print " --- len $len $buffer \n";
$len = syswrite( SOCK, $buffer, length( $buffer), 0);
}
}
finish:
close SOCK;
The following lines are a client that uses the mirror to do some network tests.
#!/usr/bin/perl -w
use strict;
#
# need this because the file handle $sck is ’variable’
#
no strict ’refs’;
use Socket;
use Fcntl;
my ($remote, $port, $iaddr, $paddr, $proto, $line);
$remote = ’hasptsXX.desy.de’;
$port = 10015;
$port = getservbyname( $port, ’tcp’) if( $port =˜ /\D/);
die " no port " unless $port;
$iaddr = inet_aton( $remote) or die "no host $remote";
$paddr = sockaddr_in( $port, $iaddr);
$proto = getprotobyname( ’tcp’);
#
# allow for ’non-static’ filehandles
#
my $sck = "SOCK";
socket( $sck, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
connect( $sck, $paddr) or die "connect: $!";
#
# set the socket to ’blocking’
#
my $flags = fcntl( $sck, F_GETFL(), 0);
$flags
&= ˜O_NONBLOCK();
# Clear non-blocking, but preserve other flags
fcntl( $sck, F_SETFL(), $flags);
my $buffer = "";
while(1)
{
#
# send the command
#
my $com = "dies ist ein test ein etwas laengerer text abcdefghijklmnop\n";
syswrite( $sck, $com, length($com), 0);
print "\n";
my $argout = "";
while(1)
{
#
# test whether we have input
#
my $rin = my$win = my $ein = "";
vec( $rin, fileno( $sck), 1) = 1;
$ein = $rin | $win;
my $tmo = 0.5;
(my $nfound, my $remaining) = select( $rin, $win, $ein, $tmo);
if( !$nfound)
{
last;
}
my $used = 0.5 - $remaining;
print " time used $used\n";
#
# get the input
#
$buffer = "";
my $len = sysread( $sck, $buffer, 100, 0);
$argout .= $buffer;
print " received len $len $argout\n";
}
}
close( $sck);
exit;
12.3.2
Reading single keystrokes, cbreak mode
#!/usr/bin/perl -w
#
# inkey() reads a keystroke from STDIN, if there is any.
# It returns -1, if no input was found.
#
use strict;
my $char_code;
my ($rin, $rout) = ( ’’, ’’);
sub inkey
{
my ($timeout, $key) = ( 0, "");
my ($nfound, $time_left) = select( $rout = $rin, undef, undef, $timeout);
$key = getc( STDIN) if( $nfound);
#
# treat special keys. they begin with <escape>
#
if( chr( 27) eq $key)
{
$key = getc( STDIN);
$key = getc( STDIN);
$key = 274 if( $key eq chr(65)); # up
$key = 275 if( $key eq chr(66)); # down
$key = 276 if( $key eq chr(67)); # right
$key = 277 if( $key eq chr(68)); # left
}
else
{
$key = unpack( "C*", $key);
}
$key = -1 if( !defined( $key));
return $key;
}
#
# finally switch back to no-cbreak, echo
#
END
{
system "stty", ’-cbreak’;
system "stty", ’echo’;
print "\n BYE\n";
}
#
# cbreak mode and no-echo
#
system "stty", ’cbreak’;
system "stty", ’-echo’;
vec( $rin, fileno( STDIN), 1) = 1;
while(1)
{
$char_code = inkey();
print "you typed $char_code\n" if( $char_code > 0);
}
12.3.3
Reading single keystrokes, POSIX::Termios
#!/usr/bin/perl
use strict;
use POSIX qw( :termios_h);
my ($term, $term_org, $echo, $noecho, $fd_stdin);
$fd_stdin = fileno( STDIN);
$term = POSIX::Termios->new();
$term->getattr( $fd_stdin);
$term_org = $term->getlflag();
$echo = ECHO | ECHOK | ICANON;
$noecho = $term_org & ˜$echo;
sub cbreak
{
$term->setlflag( $noecho);
$term->setcc( VTIME, 1);
$term->setattr( $fd_stdin, TCSANOW);
}
sub nocbreak
{
$term->setlflag( $term_org);
$term->setcc( VTIME, 0);
$term->setattr( $fd_stdin, TCSANOW);
}
sub inkey
{
my $key = -1;
cbreak();
sysread( STDIN, $key, 1);
nocbreak();
return $key;
}
END
{
nocbreak();
}
while(1)
{
print " you typed " . inkey() . "\n";
}
12.3.4
Pinging a host, system(), ping()
#!/usr/bin/perl -w
foreach my $node qw( hasa1 hasb1 hasc1 hasNotExist)
{
my $ret = !system( "ping -c 1 -w 1 -q $node 1>/dev/null 2>&1");
if( $ret)
{
print "$node is online \n";
}
else
{
print "$node is offline \n";
}
}
12.3.5
Serial line I/O, Elcomat, POSIX::Termios
#!/usr/bin/perl -w
use strict;
use POSIX qw(:termios_h);
my ($typ, $status, $messwert_x, $messwert_y);
my $str= " " x 100;
my $buffer= " " x 100;
my $fd = POSIX::open( "/dev/cua0", &POSIX::O_RDWR) || die "open returns error";
my $term = POSIX::Termios->new;
$term->getattr( $fd);
$term->setospeed( &POSIX::B19200);
$term->setispeed( &POSIX::B19200);
$term->setattr( $fd, &POSIX::TCSANOW);
foreach my $i ( 1 .. 10)
{
POSIX::write( $fd, "a\015", 2);
$str = "";
while( $str !˜ /.+\015$/)
{
POSIX::read( $fd, $buffer, 100);
$str = $str . $buffer;
}
chomp $str;
($typ, $status, $messwert_x, $messwert_y) = split ’ ’, $str;
print "$messwert_x, $messwert_y \n";
}
POSIX::close( $fd);
12.3.6
Serial line I/O, DMC, sysopen( $path, O RDWR) , select()
#!/usr/bin/perl -w
use strict;
use POSIX qw(:termios_h);
use FileHandle;
my $buffer= " " x 100;
my ($nfd);
#
# has107k: cua0 is the upper connector
#
sysopen( DMC, "/dev/cua0", O_RDWR);
my $fd = fileno( DMC);
my $term = POSIX::Termios->new;
$term->getattr( $fd);
$term->setospeed( &POSIX::B19200);
$term->setispeed( &POSIX::B19200);
my $lflag = $term->getlflag();
$term->setlflag( $lflag & ˜(POSIX::ECHO));
my $c_cflag = $term->getcflag();
$term->setcflag( $c_cflag | &POSIX::CS8);
$term->setattr( $fd, &POSIX::TCSANOW);
while()
{
print " Enter> ";
$buffer = <>;
goto finish if( $buffer =˜ /bye/i);
if( length( $buffer))
{
$buffer .= "\n";
syswrite( DMC, $buffer, length( $buffer), 0);
}
$nfd = 1;
while( $nfd)
{
my $rin = my $win = my $ein = "";
vec( $rin, fileno( DMC), 1) = 1;
$ein = $rin | $win;
$nfd = select( $rin, $win, $ein, 0.1);
if( $nfd)
{
sysread( DMC, $buffer, 100, 0);
$buffer =˜ s/ˆ\s*(.*?)\s*$/$1/;
if( length( $buffer))
{
print "
$buffer \n";
}
}
}
}
finish:
close DMC;
12.3.7
Serial line I/O, I404, BPM, sysopen( $path, O RDWR) , select()
The following script communicates with the I404 BPMs.
#!/usr/bin/perl -w
use strict;
use POSIX qw(:termios_h);
use FileHandle;
my $buffer= " " x 200;
my ($nfd);
#
# root> chmod 666 /dev/ttyS0
#
sysopen( I404, "/dev/ttyS0", O_RDWR) or die ’Failed to open /dev/ttyS0’;
my $fd = fileno( I404);
my $term = POSIX::Termios->new;
$term->getattr( $fd);
$term->setospeed( 4098);
# B115200
$term->setispeed( 4098);
my $lflag = $term->getlflag();
$term->setlflag( $lflag & ˜(POSIX::ECHO));
my $c_cflag = $term->getcflag();
$term->setcflag( $c_cflag | &POSIX::CS8);
$term->setattr( $fd, &POSIX::TCSANOW);
print " enter ’bye’ to exit \n";
while()
{
print " Enter> ";
$buffer = <>;
goto finish if( $buffer =˜ /bye/i);
if( length( $buffer))
{
syswrite( I404, $buffer, length( $buffer), 0);
}
$nfd = 1;
while( $nfd)
{
my $rin = my $win = my $ein = "";
vec( $rin, fileno( I404), 1) = 1;
$ein = $rin | $win;
$nfd = select( $rin, $win, $ein, 0.1);
if( $nfd)
{
my $len = sysread( I404, $buffer, 100, 0);
$buffer =˜ s/ˆ\s*(.*?)\s*$/$1/;
if( length( $buffer))
{
print " len $len
$buffer \n";
}
}
}
}
finish:
close I404;
12.3.8
USB, select(), POSIX::Termios, baudrates
The following script demonstrates USB IO. The connected device is an MCA (AXAS, FastComTec interface).
#!/usr/bin/perl
#
# [root@haso111m temp]# stty -F
/dev/ttyUSB0 -a
# speed 921600 baud; rows 0; columns 0; line = 0;
# intr = ˆC; quit = ˆ\; erase = ˆ?; kill = ˆU; eof = ˆD; eol = <undef>;
# eol2 = <undef>; swtch = <undef>; start = ˆQ; stop = ˆS; susp = ˆZ; rprnt = ˆR;
# werase = ˆW; lnext = ˆV; flush = ˆO; min = 1; time = 0;
# -parenb -parodd cs8 hupcl -cstopb cread clocal -crtscts
# ignbrk -brkint -ignpar -parmrk -inpck -istrip -inlcr -igncr -icrnl -ixon -ixoff
# -iuclc -ixany -imaxbel -iutf8
# -opost -olcuc -ocrnl onlcr -onocr -onlret -ofill -ofdel nl0 cr0 tab0 bs0 vt0 ff0
# -isig -icanon -iexten -echo echoe -echok -echonl -noflsh -xcase -tostop -echoprt
# -echoctl -echoke
#
use strict;
use Fcntl;
use POSIX qw(:termios_h);
sysopen(USB, "/dev/ttyUSB0", O_RDWR) || die "failed to open \n";
my $term = POSIX::Termios->new();
$term->getattr( fileno(USB)) || die("Failed getattr: $!");
my $echo = $term->getlflag();
$echo &= ˜ECHO;
$echo &= ˜ECHOK;
$echo |= ECHOE;
$term->setlflag( $echo);
$term->setcflag( &POSIX::CS8 |
&POSIX::CREAD |
&POSIX::CLOCAL |
&POSIX::HUPCL);
$term->setiflag( &POSIX::IGNBRK);
$term->getattr( fileno(USB)) || die("Failed getattr: $!");
$term->setospeed( 4103);
$term->setispeed( 4103);
$term->setattr( fileno(USB), TCSANOW) || die "Failed setattr: $!";
my $com = "?\015\012"; # help
my $buffer = "";
my $cuffer = "";
syswrite(USB, $com, length( $com)) or die " write failed \n";
my $rin = my $win = my $ein = "";
vec( $rin, fileno( USB), 1) = 1;
$ein = $rin | $win;
my $nfd = select( $rin, $win, $ein, 0.1);
while( $nfd)
{
sysread(USB, $buffer, 1000);
$cuffer .= $buffer;
$nfd = select( $rin, $win, $ein, 0.1);
}
print " $cuffer \n";
close( USB);
Normally the function
$term->setospeed() is invoked this way: $term->setospeed( &POSIX::B9600).
However, the higher baud rates are not defined in the POSIX module yet. Still these speeds can be selected by supply-
ing some code, e.g. 921600 bits per second is specified by
$term->setospeed( 4103). The table 12.1 displays
all codes.
12.3.9
USB, I404
This script sets the terminal attributes for the I404:
#!/usr/bin/perl -w
use strict;
use POSIX qw(:termios_h);
use FileHandle;
# syst:pass 12345
# syst:comm:term 1
# syst:comm:check 0
sub ascii_format
{
my ($argin) = @_;
my $argout = "";
foreach my $i ( 0 .. (length($argin) - 1))
{
my $let = substr( $argin, $i, 1);
my $dec = unpack( "C", $let);
if( $dec < 32)
{
if( $dec == 10){ $argout .= "<LF>";}
elsif( $dec == 13){ $argout .= "<CR>";}
else { $argout .= "<$dec>";}
B0
0
B50
1
B75
2
B110
3
B134
4
B150
5
B200
6
B300
7
B600
8
B1200
9
B1800
10
B2400
11
B4800
12
B9600
13
B19200
14
B38400
15
B57600
4097
B115200
4098
B230400
4099
B460800
4100
B500000
4101
B576000
4102
B921600
4103
B1000000
4104
B1152000
4105
B2000000
4107
B2500000
4108
B3000000
4109
B3500000
4110
B4000000
4111
Table 12.1: Baud rates and setispeed/setospeed
}
else
{
$argout .= $let;
}
}
return $argout;
}
my $buffer= " " x 200;
my ($nfd);
#
# root> chmod 666 /dev/ttyUSB1
#
sysopen( I404, "/dev/ttyUSB1", O_RDWR) or die ’Failed to open /dev/ttyUSB1’;
my $fd = fileno( I404);
my $term = POSIX::Termios->new;
$term->getattr( $fd);
#$term->setospeed( 4098);
# B115200
#$term->setispeed( 4098);
$term->setospeed( &POSIX::B19200);
# B19200
$term->setispeed( &POSIX::B19200);
my $lflag = $term->getlflag();
$lflag = $lflag & ˜(&POSIX::ECHO);
$lflag = $lflag | &POSIX::ISIG | &POSIX::ICANON | &POSIX::IEXTEN;
$term->setlflag( $lflag);
my $c_cflag = $term->getcflag();
$term->setcflag( $c_cflag | &POSIX::CS8);
$term->setcc( VMIN, 1);
my $iflag = $term->getiflag();
$iflag = $iflag & ˜(&POSIX::IXOFF);
$iflag = $iflag | &POSIX::ICRNL | &POSIX::IXON;
$term->setiflag( $iflag);
my $oflag = $term->getoflag();
$oflag = $oflag | &POSIX::OPOST;
$term->setoflag( $oflag);
$term->setattr( $fd, &POSIX::TCSANOW);
my $len;
my $argout = "";
print " enter ’bye’ to exit \n";
while()
{
print " Enter> ";
$buffer = <>;
$buffer =˜ s/ˆ\s*(.*?)\s*$/$1/;
goto finish if( $buffer =˜ /bye/i);
if( length( $buffer))
{
$buffer .= "\n";
$len = syswrite( I404, $buffer, length( $buffer), 0);
print " write $len bytes " . ascii_format( $buffer) . "\n";
}
$nfd = 1;
while( $nfd)
{
my $rin = my $win = my $ein = "";
vec( $rin, fileno( I404), 1) = 1;
$ein = $rin | $win;
$nfd = select( $rin, $win, $ein, 1.);
print " nfd $nfd \n";
if( $nfd)
{
$buffer = "";
$len = sysread( I404, $buffer, 100, 0);
print " --- len $len " . ascii_format( $buffer) . "\n";
if( $len)
{
$argout .= $buffer;
}
$buffer =˜ s/ˆ\s*(.*?)\s*$/$1/;
if( $len == 1)
{
last;
}
}
}
}
finish:
close I404;
12.3.10
Sockets, using Net::TCP
The following example demonstrates TCP socket I/O. This first piece of code is the client using the
Net::TCP module.
It sends
nloop string to the mirror and displays the progress after 1000 I/Os. The time of the whole process can be
measured by
$ time ./tcp_client_loop.pl server_host 7777 10000.
#!/usr/bin/perl
#
# Usage:
#
#
# ./tcp_client_loop.pl server_host 7777 1000
#
use Net::TCP;
my ( $y, $x);
my ( $host, $port, $nloop) = @ARGV;
print " host $host, port $port, nloop $nloop \n";
if( !$host || !$port || !$nloop)
{
print " Usage: \$ ./tcp_client_loop.pl server_host 7777 nloop \n";
goto finish;
}
tie $x, Net::TCP, $host, $port or die "Failed to tie \$x \n";
my $com = "probe\n";
foreach my $i (1 .. $nloop)
{
$x = $com;
# send a string
$y = $x;
# receive the answer
if( !( $i % 1000))
# output after 1000 I/Os to save time
{
$y =˜ s/ˆ\s*(.*?)\s*$/$1/;
# remove blank space
print " $i, received: $y \n";
}
}
$x = "bye\n";
finish:
untie $x;
Here is the server that mirrors the strings. Is is started on a remote host.
#!/usr/bin/perl -w
#
# server, mirror, terminates on ’bye’
#
# usage:
#
$ ./tcp_server_mirror.pl
#
my $text = " " x 128;
#
# main: Server Program
#
use IO::Socket::INET;
my $sock = IO::Socket::INET->new( Listen => 5,
LocalPort => 7777,
Reuse => 1,
Proto
=> ’tcp’);
my $new_sock = $sock->accept();
my $count = 0;
while(1)
{
$count++;
$new_sock->recv( $text, 128);
$text =˜ s/ˆ\s*(.*?)\s*$/$1/;
if( $text =˜ /bye/i)
{
$sock->close();
exit 0;
}
if( !($count % 1000))
{
print "$count, sending $text\n";
}
$new_sock->send( "--- $text\n");
}
12.3.11
Sockets, using IO::Socket::INET, TCP/IP
The following examples demonstrates how sockets are used with the IO::Socket::INET and IO::Select modules.
#!/usr/bin/env perl
#
# Before this script is started:
#
#
someHost> spectra
#
SPECTRA> server/async
#
use strict;
use IO::Socket::INET;
use IO::Select;
my $sock = IO::Socket::INET->new(PeerAddr => ’someHost’,
PeerPort => ’7777’,
Proto
=> ’tcp’,
Type => SOCK_STREAM) || die "Failed to connect\n";
$sock->send( "*=2*3");
my $s = new IO::Select();
$s->add( $sock);
my $buffer = "";
while( length( $buffer) == 0 || $s->can_read(0.1))
{
$sock->recv( $buffer, 100);
}
print " received $buffer\n";
close($sock);
12.3.12
Sockets, using IO::Socket::INET, UDP, P03, pump
The following examples demonstrates how sockets are used with the IO::Socket::INET and IO::Select modules.
#!/usr/bin/env perl
#
# start the pump server (Labview) before this
# script is started
#
use strict;
use IO::Socket::INET;
use IO::Select;
my $host="131.169.215.XX";
my $port=2612;
my $sock = IO::Socket::INET->new(PeerAddr => $host,
PeerPort => $port,
Proto
=> ’udp’) || die "Failed to connect\n";
#
Type => SOCK_STREAM) || die "Failed to connect\n";
my $s = new IO::Select();
$s->add( $sock);
sub sendMsg
{
my ( $msg) = @_;
my $buffer ;
$sock->send( $msg);
while( length( $buffer) == 0 || $s->can_read(0.1))
{
$sock->recv( $buffer, 100);
}
print " rec: $buffer \n";
sleep(5);
}
sendMsg( "pumpfast");
close($sock);
12.3.13
Sockets, using IO::Socket::INET for T95 Temperatur Controller
The following examples demonstrates how sockets are used with the IO::Socket::INET and IO::Select modules to
communicate with the T95 temperatur controller:
#!/usr/bin/env perl
#
use strict;
use IO::Socket::INET;
use IO::Select;
my $sock = IO::Socket::INET->new(PeerAddr => "hastsXX.desy.de",
PeerPort => 4504,
Proto
=> ’tcp’,
Type => SOCK_STREAM) || die "Failed to connect\n";
$sock->send( "T\015");
my $s = new IO::Select();
$s->add( $sock);
my $buffer = "";
while( length( $buffer) == 0 || $s->can_read(0.1))
{
$sock->recv( $buffer, 100);
}
my @list = unpack( "C*", $buffer);
print " received @list\n";
close($sock);
12.3.14
Raw Sockets, Spectra Client
Here is an example for how a client, using the Perl socket interface, communicates with Spectra running in the server
mode.
#!/usr/bin/perl -w
#
# To test this piece of code: Start Spectra on pal11, enter
# the server mode ...
#
#
SPECTRA> server 7777/verbose
#
# ... and run this code.
#
# # client.pl pal11 7777
#
use strict;
#
# need this because the file handle $sck is ’variable’
#
no strict ’refs’;
use Socket;
use Fcntl;
my ($remote, $port, $iaddr, $paddr, $proto, $line);
$remote = shift || ’pal11’;
$port = shift || 7777;
$port = getservbyname( $port, ’tcp’) if( $port =˜ /\D/);
die " no port " unless $port;
$iaddr = inet_aton( $remote) or die "no host $remote";
$paddr = sockaddr_in( $port, $iaddr);
$proto = getprotobyname( ’tcp’);
#
# allow for ’non-static’ filehandles
#
my $sck = "SOCK";
socket( $sck, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
connect( $sck, $paddr) or die "connect: $!";
#
# set the socket to ’blocking’
#
my $flags = fcntl( $sck, F_GETFL(), 0);
$flags
&= ˜O_NONBLOCK();
# Clear non-blocking, but preserve other flags
fcntl( $sck, F_SETFL(), $flags);
#
# send the command
#
my $com = "*=2*3\n";
print " sending $com\n";
syswrite( $sck, $com, length($com), 0);
#
# test whether we have input
#
my $rin = my$win = my $ein = "";
vec( $rin, fileno( $sck), 1) = 1;
$ein = $rin | $win;
my $tmo = 2.3;
(my $nfound, my $remaining) = select( $rin, $win, $ein, $tmo);
print " nf $nfound remaining time $remaining \n";
die ’no input’ if( !$nfound);
#
# get the input
#
my $buffer = " " x 10;
my $offset = 0;
my $len = sysread( $sck, $buffer, 10, $offset);
print " received $buffer\n";
close( $sck);
exit;
12.3.15
Sockets, SDD Server
The following code is used for the SDD detector. It is a TCP/IP server that re-opens the socket after the client discon-
nected.
#!/usr/bin/perl -w
#
# SDD server
#
use IO::Socket;
use Socket;
my $text = " " x 100000;
my $command = " " x 320;
my $sock = IO::Socket::INET->new( Listen => 5,
LocalPort => 9001,
Reuse => 1,
Proto
=> ’tcp’);
reopen:
print " accepting connections \n";
my $new_sock = $sock->accept();
while(1)
{
print " waiting for input \n";
if( ! $new_sock->recv( $command, 128))
{
print " recv returned error \n";
goto reopen;
}
$command =˜ s/ˆ\s*(.*?)\s*$/$1/;
print " received $command \n";
goto finish if( $command =˜ /bye/i);
if( $command =˜ /ˆmcareadSR/i)
{
‘$text >> temp.lis‘; # Shell Kommando
$text = ‘cat temp.lis‘; # Shell Kommando
}
elsif( $command =˜ /ˆmcareadCR/i)
{
‘$text >> temp.lis‘;
$text = ‘cat temp.lis‘;
}
elsif( $command =˜ /ˆmessen/i)
{
‘mca123buenon >> temp.lis‘;
$text = ‘cat temp.lis‘;
}
elsif( $command =˜ /ˆhalt/i)
{
‘set buen off >> temp.lis‘;
$text = ‘cat temp.lis‘;
}
elsif( $command =˜ /ˆget_fec_spec$/i)
{
$text = ‘mca6_part 0 4095 2 2‘;
}
elsif( $command =˜ /ˆget_fec_spec(\d+)$/)
{
$text = ‘mca6_part 0 4095 $1 $1‘;
}
elsif( $command =˜ /ˆinit_fec_mca/i)
{
‘mca1‘;
‘mca2‘;
‘mca3‘;
$text = "executed init_fec_mca";
}
print " sending $text\n EOF\n";
print " in replying $command \n";
$new_sock->send( "$text\nEOF\n");
}
finish:
$sock->close();
exit 0;
12.3.16
Sockets, Modbus Implementation, fd select()
The following example shows how Modbus I/O is done via a TCP/IP socket interface.
#!/usr/bin/env perl
use strict;
use Socket;
use Fcntl;
my ($remote, $port) = qw( hasa106bc01 502);
my $iaddr = inet_aton( $remote) or die "no host $remote";
my $paddr = sockaddr_in( $port, $iaddr);
my $proto = getprotobyname( ’tcp’);
socket( SOCK, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
connect( SOCK, $paddr) or die "connect: $!";
my $flags = fcntl( SOCK, F_GETFL(), 0);
$flags
&= ˜O_NONBLOCK();
fcntl( SOCK, F_SETFL(), $flags);
#
# create PDU, protocol data unit
#
my $fc = 0x17;
# read/write multiple registers
my $countR = 12;
# read count, in units of 2B
my $adrR = 0x4000;
# start address for read
my $adrW = 0x4003;
# start address for write
my @values = qw( 14 17); # write values
my $countW = scalar( @values);
my $bc = $countW*2;
# write count in B
my $pdu = pack "CnnnnCn*", $fc, $adrR, $countR, $adrW, $countW, $bc, @values;
#
# create TCP header, 7B
#
my $tid = 1234;
# Transaction identifier, 2B, recopied by the server
my $pid = 0;
# Protocol identifier, 2B, 0 = MB
my $len = (length( $pdu) + 1); # Len, 2B, number of following bytes, including uid and data
my $uid = 1;
# Unit identifier, 1B, identification of a remote slave
my $header = pack "nnnC", $tid, $pid, $len, $uid;
#
# append PDU to header
#
my $msg = $header . $pdu;
syswrite( SOCK, $msg, length( $msg), 0);
goto finish if( !fd_select( \*SOCK, 1.0));
my $response;
my $exp = 7 + 2 + 2*$countR;
my $len = sysread( SOCK, $response, $exp, 0);
print " received $len/$exp \n";
$header = substr($response, 0, 6);
my ($tid, $prid, $len) = unpack ’nnn’, $header;
#my ($tid, $prid, $hilen, $lolen) = unpack ’nnCC’, $header;
#print " tid $tid, prid $prid, hilen $hilen, lolen $lolen \n";
my ($unit, $fc, $bc) = unpack ’C*’, substr($response, 6, 3);
print sprintf " unit $unit, f 0x%x, bc $bc \n", $fc;
my @data = unpack ’n*’, substr($response, 9);
print " data @data \n";
#my $len = 0x100 * $hilen + $lolen;
print " len $len \n";
finish:
close( SOCK);
exit;
#
# select
#
sub fd_select
{
my ( $fd, $tmo) = @_;
my $rin = my $win = my $ein = "";
vec( $rin, fileno( $fd), 1) = 1;
$ein = $rin | $win;
my ( $nfd, $remaining) = select( $rin, $win, $ein, $tmo);
wantarray ? ( $nfd, $remaining) : $nfd;
}
Bibliography
[1] Larry Wall et al.,
Programming Perl, O’Reilly
69
Index
ARGV, 45
INC, 42
$, \26
+, 13, 35
$$, 13
$, 13
$., 13
$/, 13
$0, 13
$_, 13
__FILE__, 13
__LINE__, 13
alarm, 46
allocation, 9
array, 9
!
"
AXAS, 58
BPM, 57
caller, 45
cbreak mode, 54
closures, 39
control statements, 18
cua0, 56
data structures
nested, 11
DMC, 56
Elcomat, 56
errno, 14
Errors, 14
eval, 43
example
eval, 43
socket, 43, 65
examples, 45
exit handler, 28
exporting symbols, 41
file handle, 25, 26
FileHandle, 26
files, 25
!
"
function
abs, 37
access time, 35
alarm, 28, 29
atan2, 37
BEGIN, 28
caller, 39, 45
chdir, 28
chr, 28
closedir, 27
cos, 37
defined, 39
doty, 29
END, 28
eval, 7, 29
exp, 37
fcntl, 65
fd select(), 67
getpwuid, 30
grep, 30
hex, 37
int, 37
isatty, 30
join, 17, 30
lc, 36
lcfirst, 36
length, 9, 30
local, 14, 26
localtime, 30, 35
log, 37
map, 31
mkdir, 31
my, 14
numeric, 37
oct, 37
opendir, 27
ord, 28
pack, 31
print, 32
rand, 33, 37
readdir, 27
ref, 45
rename, 33
require, 33
select, 45, 65
sin, 37
sort, 33
sotd, 34
split, 17, 34
sprintf, 32
sqrt, 37
srand, 33, 37
stat, 35
substr, 35
sysread, 65
system, 35
syswrite, 65
tie, 26
70
time, 36
times, 36
uc, 36
ucfirst, 36
unlink, 37
unpack, 31
handler
alarm, 43
exit, 44
hash, 10
hashes of hashes, 11
here documents, 6
I/O redirection, 26
if, 18
image name, 13
inkey(), 54
interpolation, 6
IO::Select, 63, 64
IO::Socket::INET, 63, 64
list, 9
loops, 18
memory allocation, 9
Modbus, 67
modules, 41
mv.pl, 47
nested data structures, 11
operator
bitwise, 16
comma, 17
comparison, 16
conditional, 17
file test, 15
logical, 16
precedence, 15
range, 17
operators, 15
parameter
passing, 38
ping(), 55
processes, killing, 51
program name, 13
quotes, 6
records, 12
ref, 45
regular expressions, 20
greedy, 21
interpolation, 21
minimal matching, 21
modifiers, 20
quantifiers, 21
ungreedy, 21
variables, 22
require, 33, 41
rm.pl, 46
script execution, 7
script name, 13
serial line I/O, 56
setispeed, 58
setospeed, 58
shell, 35
signal handling, 43
socket, 65
#
$
%
&
'
$
(
)
*
+
,
-
.
/
0
*
1
2
*
1
(
3
4
strings, case conversion, 36
strings, creating, 28
subroutine
reference, 39
subroutines, 38
substitute.pl, 48
symbol tables, 42
sysopen, 56, 57
sysread, 56, 57
system(), 55
syswrite, 56, 57
Termios, 56, 57
termios, 58
timeout, 29, 46
truth, 6
ttyS0, 57
Umlaute, 48
undef, 39
USB, 58
wantarray, 39
widget
Text, 26
yesno(), 51