Perl in a Nutshell

background image

Perl in a Nutshell

Version January 17, 2013

by

Thorsten Kracht

background image

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

background image

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

background image

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

background image

List of Figures

4

background image

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

background image

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

background image

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:

background image

#
# 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

background image

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

background image

#

@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){...}

#

background image

# 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;

background image

# 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’

background image

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:/;}

background image

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.

background image

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

background image

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

background image

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’);

background image

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

background image

#
# $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;

}

background image

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

background image

\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$/;

background image

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/</&lt;/g;
$buffer_out =˜ s/>/&gt;/g;

6.6.6

Special characters, string starts with ’/’

#
# Special characters, make sure that $flag_value starts with a ’/’

background image

#
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//;

background image

6.6.14

Count the stars

#
# count the stars in $_
#
$cnt = tr/*/*/;

background image

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

background image

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);

}

background image

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);

background image

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

background image

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";

}

background image

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
#

background image

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))); }

background image

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>

background image

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

background image

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>

background image

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‘;

background image

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 · · ·

background image

$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);

background image

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

background image

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;

background image

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.

background image

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

background image

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;

background image

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

background image

close( SOCKET);

}

11.2

Exit Handler

...
#
END
{

print "exiting \n";

}

background image

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

background image

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:

background image

#!/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)
{

background image

$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

background image

# 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)
{

background image

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:

background image

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;

background image

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);

background image

$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;

background image

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);

}

background image

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";

}

background image

}

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()
{

background image

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()
{

background image

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 |

background image

&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>";}

background image

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;

background image

$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;

background image

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();

background image

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

background image

# 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";

background image

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;

background image

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

}

background image

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

background image

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;

}

background image

Bibliography

[1] Larry Wall et al.,

Programming Perl, O’Reilly

69

background image

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

background image

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


Wyszukiwarka

Podobne podstrony:
Gramatyka historyczna in a nutshell
t. osobo in a nutshell, statystyka, statystyka
Modes In A Nutshell
usb in a nutshell
Stephen Hawking The Mathematical Universe in a Nutshell
Java Nested Types Java in a Nutshell
Polish Commercial Law in a Nutshell
Education in Poland
Participation in international trade
in w4
Metaphor Examples in Literature
Die Baudenkmale in Deutschland

więcej podobnych podstron