# Same as previous example except use qq
 	# operator to "double quote" "so we don't 
	# have to use \"inside double quoted string.
 if (/ab/) {
 print qq/"ab" is in "$_".\n/;
 }


 	# Same as previous example.
 /ab/ and print qq/"ab" is in "$_"\n/;

if ($str =~ /yz$/) {
    print qq/"yz" at end of line in "$str". \n/;
}

	#Same as previous example.
($str =~ /yz$/) and print qq/"yz" at end of line in "$str".\n/;
}

	#Same as previous example.
($str =~ /yz$/) and print qq/"yz" at end of line in "$str".\n/;
	
	#Set $match to 1 if second character
	#on line of $str is "X", 0 otherwise.
$match = ($str =~ /^.X/);

The general form of the substitution operator is s/ old / new /;. By default the substitution is done on $_ . To do it on another scalar do,
for example:

$home =~ s/White House/home state/; # after term is up

Here are some examples of the substitution command:

Reading from a file.

 # Use `<' to open a file for input.
 # We print on standard output the line number and line read.
$fn = "filename";
$n = 0;
open FH, "<$fn" or die qq/"Can't open "$fn" for input:$!, stopped");
while () {
 printf "%6d %s\n", $++n, $_;
}
close FH or die qq/Can't close input file "$fn":$!, stopped/;

Printing to a file.

 # Use `>' to open a file for output.
open FH, ">$fn" or die qq/Can't open "$fn" for output:$!, stopped"/;
print FH "Test line.\n";
close FH or die qq/Can't close output file "$fn":$!, stopped/;

18 Built-in Functions

chop( string )

Delete last character from string and return deleted character as value of function. Note that string can't be a constant (e.g., "string") because there wouldn't be anywhere to put the shortened string .

die( message )

Print `` message at program line line " and abort program.
For example, with $file set to ``a'' in program ``b''
die("can't open "$file\":$!, stopped")
would print
can't open "a":\ permission denied, stopped at b line 4.

grep( expression , array )

For each element of array , set $_ to that element, and evaluate expression . If value is used in an array context return all elements of @array for which expression was true. If value is used in a scalar context return number of times expression was true.

keys( associative_array )

Returns an array consisting of all of \AArray's keys in no particular order. In $name{$k} = $v, $k is a key and $v is a value. (See values.)

length( string )

Returns number of characters in string .

pop( array )

Delete last element from array and return deleted element as value of function. (See push.)

push( array , scalar )

Adds scalar to the end of array .

sort( array )

Return sorted array as value of function.

values( hash )

Returns an array consisting of all of hash's keys in no particular order. (See keys.)

Example Program namese - reverse names

Description

Read "Lastname, Firstname" lines from standard input.
Print "Firstname Lastname" lines on standard output.


One could also do this from the command line using:
perl -pe 's/(.*),\s*(.*)/$2 $1/'

Run

1% namese
2 Flintstone, Fred
3  Fred Flintstone
4 Clinton, Bill
5 Bill Clinton
6 [Typed Control-D here.]

Code

1  #!/usr/local/bin/perl -w
2
3 while (<>) {
4 chop; # delete newline
5 # In the following line
6 #	SYMBOL	MEANING
7  #	s	This is a substitute command
8  #	/	Everything up to the next / is what we want to do
9   #	(.*)	Match . (any character) zero or more times and remember what 
10  #		was matched as $1 since this is the 1st set of parentheses. 
11  #		(This matches everything up to the comma.)
12  #	,	Match the comma.
13  #	\s*	Match \s (white space character) zero or more times.
14  #		(This matches any spaces after comma.)
15 #	(.*)	Match . (any character) zero or more times and remember 
16 #		what was matched as $2 since this is the 2nd set of
17 #		parentheses.(This matches everything after the comma
18  #	        followed by any white space to the end of the line.)
19  #	/	This marks the end of what we want to substitute.
20  #		What we want to substitute the old stuff with starts
21  #		with the next character.
22  #	$2 $1	What the 2nd set of parentheses earlier matched followed by 
23  #		a space followed by what the 1st set of paretheses earlier 
24  #		matched. This reverses the Last and First names.
25  #	/	End of substitute command.
26   s/(.*),\s*(.*)/$2 $1/; # change "Last, First" to "First Last"
27 print "$_\n";
28 }
29
30 exit 0;

Example Program argse - print command line arguments

Description

Print the command line arguments using several different equivalent methods.

Run

1   % argse a b
2   first method:a b
3   second method:a b
4   third method:a b
5   fourth method:a b
6   fifth method:a b

Code

1  #!/usr/local/bin/perl -w
2
3      # Printing "@array" automatically puts a space between the elements.
4      # Even if there are no arguments we will get the "\n".
5   print "first method:";
6   print("@ARGV\n");
7
8   # Using foreach() to do this would be difficult because it doesn't
9   # allow us to know which element (first, second, etc.) we are printing.
10
11  # An if is used to print " ".
12 print "second method:";
13 for ($i=0; $i<=$#ARGV; $i++) {
14        print($ARGV[$i]);
15            # Could use
16            # if ($i< $#ARGV) {
17            #     print " ";
18               }
19            # or the following if modifier:
20        print " "if ($i < $#ARGV);
21  }
22 print "\n";
23 
24  # Similar to second method except using shorthand if.
25 print "third method: ";

26 for ($i=0; $i<=$#ARGV; $i++) {
27     print($ARGV[$i]);
28     ($i< $#ARGV) and print " ";
29  }
30   print("\n");
31
32  # Using "(expression) ? true_body :false_body"
33  # ternary conditional operator.
34  # Note that if no arguments are specified on
35  # the command line the "\n" will not get printed.
36  print("fourth method:");
37  for ($i=0; $i<=$#ARGV; $i++) {
38    print($ARGV[$i], ($#ARGV==$i) ? "\n" :" ");
39  }
40
41  # Using "(expression) ? true_body :false_body"
42  # ternary conditional operator with printf.
43  # Note that if no arguments are specified on
44  # the command line the "\n" will not get printed.
45  print("fifth method:");
46  for ($i=0; $i<=$#ARGV; $i++) {
47  printf "%s%s", $ARGV[$i], ($#ARGV==$i) ? "\n" :" ");
48  }
49
50 exit 0;

Example Program enve - print environment

Description

Prints a user's environment a few different ways.

Note:

Only a few environment variables are shown in the run of the program.

Run

1   % enve
2   First method:
3   NAME Mark Senn
4   MAIL /var/mail/mds
5   HOME /home/pier/c/mds
6   LPDEST msa
7
8   Second method:
9   HOME /home/pier/c/mds
10  LPDEST msa
11  MAIL /var/mail/mds
12  NAME Mark Senn
13
14  Third method:
15  HOME /home/pier/c/mds
16  LPDEST msa
17  MAIL /var/mail/mds
18  NAME Mark Senn

Code

1   #!/usr/local/bin/perl -w
2
3       # Check usage.
4   if (-1 != $#ARGV) { # arguments besides program name on command line
5      print STDERR "usage:$0\n";
6   exit(1);
7   }
8
9   # Print the environment.
10  print "First Method\n";
11  foreach (keys(%ENV)) {
12       print "$_ $ENV{$_}\n";
13  }
14  print "\n";
15
16  # Print the environment sorted by environment variable name.
17  print "Second Method\n";
18  foreach (sort(keys(%ENV))) {
19   print "$_ $ENV{$_}\n";
20  }
21  print "\n";
22
23
24 	 # Print the environment sorted by environment variable name
25 	 # and formatted for easy reading.
26
27 	 # Get maximum width of label.
28  $width = 0;
29  foreach (keys(%ENV)) {
30  	(length $_ > $width)  and  $width = length $_;
31  }
32
33   	# Print the environment.
34  print "Third Method\n";
35  foreach (sort(keys(%ENV))) {
36 	 printf "%${width}s %s\n", $_, $ENV{$_};
37  }
38
39
40      # Done automatically by Perl but I like to be explicit.
41  exit(0);

Example Program passwde - print password file fields

Description

This program prints the information found in the /etc/passwd file for the login specified on the command line. Each line in the /etc/passwd file is of the form login:password:userid:groupid:name:home_directory:login_shell.

Run

1   % passwde mds
2            login: mds
3       password: *
4         userid: 10658
5        groupid: 1
6          name: Mark Senn
7   home directory: /home/pier/c/mds
8   login shell: /usr/local/bin/tcsh

Code

1   #!/usr/local/bin/perl -w
2
3   $fn = "/etc/passwd";
4   $label = "login:password:userid:groupid:name:home directory:login shell";
5
6
7   # Check usage.
8  if (0 != $#ARGV) {
9  	print STDERR "usage:$0 login\n";
10 	exit(1);
11 }
12
13 	# Open file.
14 open (FH, "<$fn") or die("$0:can't open \"$fn\" for input:$!, stopped");
15
16	 # Go through file looking for $ARGV[0].
17 $exit = 1; # haven't found it, assume error unless we find it
18 while () {
19 	 chop(); # delete newline
20 	 @field = split /:/;
21	 if ($ARGV[0] eq $field[0]) { # found it
22		 # Split $label into @label and find width of widest label.
23		 @label = split(/:/, $label);
24		 $width = 0;
25		 foreach (@label) {
26		     $t = length($_);
27		     $width = $t if ($t >$width);
28	      }
29		 # Print labels and corresponding information.
30	      for ($i=0; $i<=$#label; $i++) {
31		 printf "%${width}s:%s\n", $label[$i], $field[$i];
32	      }
33	      $exit = 0; # no error
34	      last;
35	 }
36   }
37
38	 # Close file---not really necessary but I like to close everything I open.
39   close(FH) or die("$0:can't close \"$fn\":$!, stopped");
40
41	 # Print error message if necessary.
42   $exit and printf STDERR "$0:couldn't find \"$ARGV[0]\" in \"$fn\"\n";
43
44	 # Exit with correct status.
45   exit($exit);

Example Program primese - print first N primes

Description

Print first count primes on standard output where count is specified by the user on the command line.

Run

1	primese 3
2	Prime Value
3	    1     2
4           2     3
5           3     5

Code

1	#!/usr/local/bin/perl -w
2
3	 # There must be one argument on the command line.
4	 # It must consist of one or more digits.
5    if (($#ARGV != 0) or (!($ARGV[0]=~/^\d+$/))) {
6	   print STDERR "usage:$0 count (count >= 0)\n";
7	   exit(1);
8    }
9
10   $count = $ARGV[0]; # number of primes to compute
11
12   @prime = (); # array of primes found so far
13   $n = 2; # first number to look at is first prime
14
15   while ($count) {
16
17	 # Is $n divisible by any of the primes found so far?
18   $prime = 1; # assume prime
19   foreach $p (@prime) {
20 	 if (0 == ($n%$p)) {
21	    $prime = 0; # nope, wasn't prime
22	    last;
23        }
24    }
25
26	 # Add $n to @prime array if $n is prime.
27    if ($prime) {
28   	 push(@prime, $n);
29	 $count--;
30     }
31
32	 $n++;
33
34    }
35
36	 # Print all the primes found.
37    printf "%5s %s\n", "Prime", "Value";
38    for ($i=0; $i<=$#prime; $i++) {
39	 printf "%5d %d\n", $i+1, $prime[$i];
40    }
41
42	# Perl does an exit (0) autatically but I like to say goodbye officially.
43	exit(0);

Example Program markere - find marker and do command

Description

This program goes through the filename specified on the command line looking for $default:. When it finds it it tries to execute whatever follows that string as a Unix command.

Use -m marker to do a marker other than $default.

The make program allows one to construct a Makefile to describe what steps to do to, for example, to compile a program. This program allows a Makefile-like specification to be put in the source code of a file itself.% \footnote{${}^1$}{I got this idea from Kevin Braunsdorf's mk program.}

Run

1	% markere -m example markere
2	example marker done

Code

1	#!/usr/local/bin/perl -w
2	#
3	# $default:/bin/echo "default marker done"
4	# $example:/bin/echo "example marker done"
5	#
6	
7	 	# See _Programming Perl_, 2nd Edition, page 452.
8	 	# Define getopts.
9	 	# The getopts routine strips processes any allowed options
10	 	# setting $opt_L where L is the letter representing the option.
11	 	# The remainder of the line is left in @ARGV.
12	use Getopt::Std;
13
14		 # A maximum of one -m option is allowed and it must be followed by
15		 # an argument.
16		 # One filename must be on the command line.
17	if (!getopts("m:") or ($#ARGV!=0)) {
18		 print STDERR "usage:$0 [-m marker] file\n";
19		 exit(1); 
20	}
21
22	 # Assume $marker to "default" unless "-m marker" on command line.
23	 $marker = "default";
24	 ($opt_m) and $marker = $opt_m;
25	
26	 # Try to open the filename specified on the command line.
27	$file = $ARGV[0];
28	open FH, "<$file" or die qq/Can't open "$file" for input\n/;
29
30	# Read the file line by line.
31	# If we find the marker execute the rest of the line as a Unix command.
32     while()  {
33	  if (/\$$marker:(.*)$/) {
34	      $command = $1;
35	      system($command);
36	      exit 0;
37	  }
38	}
39
40	  # We couldn't find the marker.
41	  #Complain and exit with an error status.
42     print STDERR qq/Couldn't find marker "$marker" in file "$file".\n/;
43     exit 1;
	

Example Program dfe - print pretty df output

Description

Does a df -bk command and formats the output so it is easier to read. This has only been tested on Solaris.

Note:

Some lines were deleted from the sample output to save space.

Run

% dfe
Mount Point		Kbytes    Used  Avail Full Filesystem
/                       123455   21528  89587 20%  /dev/dsk/c0t0d0s0
/export/home/b         1884987 1385517 405225 78%  /dev/dsk/c1t0d0s2
/home/pier/b           1884987 1385517 405225 78%  /export/home/b
/home/schenectady/a    1393648 1113952 140336 89%  schenectady:/export/home/a
/package/netscape      8316752 8099784 133800 99%  pkg:/export/package/a/...
/package/perl          8316752 8099784 133800 99%  pkg:/export/package/a/...
/tmp                    359176   16056 343120  5%  swap
/usr                    168423  136131  15452 90%  /dev/dsk/c0t0d0s6
/var                    950390   92864 762496 11%  /dev/dsk/c0t0d0s7

Code

#!/usr/local/bin/perl -w

 # Array indices start with 1.
$[ = 1;

 # Define headings.
@h = ("Filesystem", "Kbytes", "Used", "Avail", "Full", "Mount Point");

 # Get width of labels.
for ($i=1; $i<=$#h; $i++) {
 $w[$i] = length($h[$i]);
}

 # Run df command and delete newlines from output.
@line = `/bin/df -bk @ARGV`;
grep(chop($_),@line);


 # Parse the df output and make associative arrays
 # %mou, %fil, %kby, %use, %ava, and %cap.

for ($i=2; $i<=$#line; $i++) {

 @f = split(/\s+/, $line[$i]);
 if ($#f< 6) { # input line continued on the next line, append next line
 $line[$i] .= $line[$i+1];
 $i++;
 }
 @f = split(/\s+/,$line[$i]);

 $mou = $f[6];
 $t = $f[1]; $t =~ s/\.purdue\.edu:/:/; $t =~ s/\.ecn:/:/;
 $fil{$mou} = $t;
 $kby{$mou} = $f[2];
 $use{$mou} = $f[3];
 $ava{$mou} = $f[4];
 $cap{$mou} = $f[5];
 
 for ($j=1; $j<=$#f; $j++) {
 $t = length($f[$j]);
 $w[$j] = $t if ($t >$w[$j]);
 }
}


 # Trim length of filesystems until entire line is 79 characters or less.
 # We don't bother to recompute $w[1] since that is now the last field
 # printed on the line.
if ($w[6]+$w[2]+$w[3]+$w[4]+$w[5]+$w[1] >79-5) { # includes 5 spaces
 $t = 79-5 - $w[6] - $w[2] - $w[3] - $w[4] - $w[5];
 foreach $key (keys(%fil)) {
 $_ = $fil{$key};
 while (length($_) >$t) {
 # Change "/xxxx/" or "/xxx/..." to "/...".
 s#/[^/]*/(\.\.\.)?$#/...#x;
 }
 $fil{$key} = $_;
 }
}

 # Print the output.
$format = "%-$w[6]s %$w[2]s %$w[3]s %$w[4]s %$w[5]s %-s\n";
printf $format, $h[6], $h[2], $h[3], $h[4], $h[5], $h[1];
foreach (sort(keys(%fil))) {
 printf $format, $_, $kby{$_}, $use{$_}, $ava{$_}, $cap{$_}, $fil{$_};
}

Example Program udpe - send udp message

Description

This program sends a UDP message to a specified host using the host and service name specified on the command line. This is meant as an example of how to do things like this. Please only experiment with things like this if you know what you're doing.

Run

% udpe resolute.ecn acmaint3_transd

Code

#!/usr/new/bin/perl -w

use strict; require 5.003; use Socket; use Sys::Hostname;

my ($host, $iaddr, $paddr, $port, $proto, $service);

if (1 != $#ARGV) {
 print STDERR "usage:$0 host udp_service\n";
 exit(1);
}

 # Get host and service from command line.
($host,$service) = @ARGV;

 # Get proto.
$proto = getprotobyname("udp");

 # Open socket.
socket(SOCKET, PF_INET, SOCK_DGRAM, $proto)
 or die "$0:can't open socket:$!, stopped";

 # Get port for this service.
$port = getservbyname($service, "udp");

 # Get internet address for host to send to.
$iaddr = inet_aton($host) or die "can't find \"$host\":$!, stopped";

 # Make port address from port and internet addresses.
$paddr = sockaddr_in($port, $iaddr);

 # Try to send it.
defined(send(SOCKET, 0, 0, $paddr)) or die "can't send:$!, stopped";
exit(0); # completely unnecessary but I like to say goodbye officially