Perl Notes


Arrays

# Number of elements in an array
$x = scalar @array;
$x = scalar @$rarray; # reference to an array

# Largest index in array
$x = $#array;
$x = $#$rarray; # reference to an array

# Add to the end of an array
push @array, $element;

# Add to the beginning of an array
unshift @array, $element;

# Remove from the beginning of an array
$var = shift @array;

# Remove from the end of an array
$var = pop @array;

# Remove an element in an array
my @array = qw/ John Frank Remon Jim Dave Lon /;
# Remove Jim from array
for (my $x = $#array; $x >= 0; $x--) {
   if ($array[$x] eq "Jim") {
     splice @array, $x, 1; # remove the element
   } # end if
} # end for

# Pass a reference to an array
&doSomething (\@array);

# Refer to an element using a reference to an array 
$$rarray[$x];


Hash

# Define a hash
my %foodColor = (
                 Apple,  "red",
                 Banna,  "yellow",
                 Lemon,  "yellow",
                 Carrot, "orange"
                );

# Add an element
$foodColor{Raspberry} = "pink";

# Print it out
print "Known foods:\n","-" x 17 ,"\n";
foreach my $food (keys %foodColor) {
  print "$food: $foodColor{$food}\n";
} # end foreach

# Another way of doing it
while (($food, $color) = each (%foodColor)) {
  print "$food is $color\n";
} # end while

# Check if an element exists
if (exists $foodColor{"Apple"}) {
  print "Yes it is defined\n";
} else {
  print "Sorry it is not defined\n";
} # end if

# Remove an element
delete $foodColor{"Raspberry"};


Hash and Array references in a Hash

%phone = ('Home','555-1234','Office','555-5678');
@children = qw(Barb Laura Betty Jan);

%FredSmith = ('Employee number','p11918','Phone',\%phone,'Children',\@children);

print "Fred Smiths second child is $FredSmith{Children}->[1]\n";
print "Fred Smiths office phone is $FredSmith{'Phone'}->{Office}\n";


Test for an element in an Array

my @array = qw/Jim Beth Laurie Inga Kathy/;

# Check for something in the array
my $name = "Jim";

# If you only want to look for one or two names use:
if (grep(/^$name$/,@array)) {
  print "Yes, $name was found.\n";
} # end if

# If you want to look for a lot of stuff, use:
my @namesToLookFor = qw/Jim Laurie Larry Kathy/;
my %array = ();

foreach my $e (@array) {
    $array{$e} = 1;
} # end foreach

foreach $name (@namesToLookFor) {
  if ($array{$name}) {
    print "$name was found.\n";
  } # end if
} # end foreach


Modulus

$y = 50;

# Print each number that is divisible by 50
foreach $x (1..1000) {
  unless ($x % $y) {
    print "$x = $x\n";
  } # end if
} # end foreach

$x = 100;
$y = 50;


# Typical test
unless ($x % $y) {
  print "No remainder\n";
} else {
  print "There is a remainder\n";
} # end if


Options

# This script takes at least one argument.  If the argument
# -f is used, it must be followed by a filename.

use strict;
use Getopt::Std;
use vars qw/$opt_v $opt_f $opt_i/;

# Check and initialize options
getopts ('vif:') || &usage;
&usage if @ARGV == 0;

print "Verbose is requested\n" if $opt_v;
print "Interactive is requested\n" if $opt_i;
print "Filename is $opt_f\n" if $opt_f;

print "@ARGV\n";

########################################################
sub usage {

  print "\n\tUsage: scriptName [-iv] [-f filename]\n\n";
  exit;

} # end sub


wantarray

my ($a,$b) = &wantarrayTest;

print "a = $a\n";
print "b = $b\n";

$a = &wantarrayTest;

print "a = $a\n";

####################  Subroutine  #########################################
sub wantarrayTest {

  my $x = 6;
  my $y = 7;
  my $z = 8;

  return wantarray ? ($x,$y) : $z;

} # end sub


Pass File Handle References

use strict;

# Open file for reading
open ( TEMPLATE,"$template" ) or die "Could not open template file";

&doSomething (\*TEMPLATE);

close (TEMPLATE);

#################  Subroutine  ##########################################
sub doSomething {
  
  my ($filePointer) = @_;

  while (<$filePointer>) {
    next unless /\S/; # Skip blank lines.
  } # end while

} # end sub


Modify a Unix File Without Changing the Modification Time

# Make sure there is a filename to use
die "\n\tThis script takes an argument\n\n" if (@ARGV == 0);

# Initialize variable
my $targetFile = $ARGV[0];

# Get the modification time of the file
my ($mtime) = (stat($targetFile))[9];

# vi the file
system ("vi $targetFile");

# Return the modification time
utime $mtime, $mtime, "$targetFile";


Signal Handler

use strict;

eval {
  # Install signal handlers
  $SIG{INT} = sub { die "Caught interrupt" };
  $SIG{HUP} = sub { die "Caught interrupt" };

  # Start a forever loop and press ^C for an interrupt test
  while (1) {
    sleep 1;
  } # end while

}; # end eval

# Close down and clean up if ctl-c or interrupt occurred
if ($@) {

  # Print exit message
  print "\nExiting with: $@\n";

  # Close files and erase temporary files

} # end if


Time Out

use strict;

# Define what to do if the signal ALRM is detected
$SIG{ALRM} = sub {&timedOut};

# Look for the alarm
eval {
  
  # Define the timeout period in seconds
  alarm (10);

  # Do something to test it
  sleep 11;

  # Turn the alarm off
  alarm (0);

}; # end eval
######  Sub  #########################################################
sub timedOut {

  print "Process timed out.\n";
  print "Do whatever it takes to finish the job and clean up.\n";

} # end sub


Circular Arrays

use strict;

my @array1 = qw/1 2/;
my @array2 = qw/1 2 3/;
my @array3 = qw/1 2 3 4 5/;

foreach (0 .. 24) {

  # Print element 1 of each array
  print $array1[0],$array2[0],$array3[0],"\n";

  # Rotate the elements in each array
  push(@array1, shift(@array1));
  push(@array2, shift(@array2));
  push(@array3, shift(@array3));

  # Uncomment to rotate the other way
  #unshift (@array1, pop(@array1));
  #unshift (@array2, pop(@array2));
  #unshift (@array3, pop(@array3));

} # end foreach


Numeric Sort

use strict;

my @array = qw/12 2 147 36/;

# Sometimes a string sort does not give us the results we want
@array = sort @array;
print "@array\n";
# output is: 12 147 2 36

# This is an example of a numeric sort
@array = sort { $a <=> $b } @array;
print "@array\n";
# output is: 2 12 36 147


mkdir

$dir = "/tmp/james";

mkdir ($dir, 0755) || die "Failed to make directory \"$dir\": $!";


chmod

$dir = "/tmp/james";

chmod 0700, $dir,'/tmp/jr1';


Return Code From System

$dir = "/tmp/james";

my $status = system ("/bin/mkdir $dir 2>/dev/null");
die "mkdir cmd failed" if $status != 0;


Proper Tense

#@array = qw/jim smith/;
@array = qw/jim/;

printf "Birthday%s in March 2000\n",(@array == 1) ? "" : "s";


flock

# Load file content into an array
open  (FILE,"+< $userDataFile") || die "could not open datefile";
flock (FILE, 2);          # wait for exclusive lock
seek  (FILE, 0, 0);       # rewind to beginning
my @fileContent = <FILE>; # get current content
close (FILE);

# Other useful commands are:
seek (FILE, 0, 0);       # rewind to beginning
truncate (FILE, 0);      # empty the file


Here Documents

# This is the basic way to write a here document

print <<"EOF";

  This will be
  printed exactly 
  as it appears here
  until the EOF appears
  on a line by itself
  with no whitespace.

EOF

# If you want to indent your text in a subroutine but do not
# want it indented in the output, try this.

  (my $text = <<"  EOF") =~ s/^\s+//gm;

  This text will not be
  indented when printed.
  EOF

  print $text;