Personal Perl Reference

external: index -|- samples
internal: references -|- downloads -|- end

This is a simple list of some perl functions that I have used in various projects, up to 2010/09/03. The best, simple, reference I have found is - http://www.rexswain.com/perl5.html - circa March 2001 - simple list style help ... but no sample code ... some references found in searches ... This is an ever developing personal list, commenced April, 2006 ... No attempt has been made to be 'exhaustive', or 'complete', at any level! Just a PERSONAL list ;=)) enjoy...

internal links: alphabetic list
 absolute path, address-of, and(&=), array, associative array, basename, chomp, chr, classes, closedir, conversion, CPAN, cwd, delete, dereferencing, die, Dumper, else, elsif, __END__, encode, Errors, eval, exit, file test, fileparse, flush, function, gethostbyaddr, gethostbyname, goto, hash, hash references, heredoc, hex, hires time, if, index, installation-windows, installation-unix, join, local, localtime, multidimensional scalar array, my, opendir, operators, or(|=), ord, our, __PACKAGE__package, parameters, pop, ppm, print, quotemeta, qw, readdir, ref, reference, regular expressions, require, rindex, scalar array, scope, shift, shift(<<|>>) sort, special variables, split, splitpath, stat, strict, sub, subref, substr, time, trim, typeof, unicode, unless, unlink, unshift, unzip, x, xml


index( STRING, SEARCH [, POSITION]);

Returns the position of the SEARCH from the beginning of the STRING, at or after the POSITION, if specified. Will return -1 if SEARCH is not found.

code:

print "Hello, World...\n";
my $str = 'abcdabcd';
my $ind1 = index( $str, 'a' );
my $ind2 = index( $str, 'b' );
my $ind3 = index( $str, 'x' );
my $ind4 = index( $str, 'b', 4);
print "Found 'a' at $ind1, 'b' at $ind2, and not 'x' $ind3 ...\n";

output:

Hello, World...
  Found 'a' at 0, 'b' at 1, and not 'x' -1 ... and second 'b' is 5 ...

top -|- index -|- samples


rindex( STRING, SEARCH [, POSITION]);

Returns the position of the SEARCH from the end of the STRING, at or before the POSITION, if specified. Will return -1 if SEARCH is not found.

code:

print "Hello, World...\n";
my $str = 'abcdabcd';
my $ind1 = rindex( $str, 'a' );
my $ind2 = rindex( $str, 'b' );
my $ind3 = rindex( $str, 'x' );
my $ind4 = rindex( $str, 'b', 4);
print "Found 'a' at $ind1, 'b' at $ind2, and not 'x' $ind3 ... and second 'b' is $ind4 ...\n";

output:

Hello, World...
  Found 'a' at 4, 'b' at 5, and not 'x' -1 ... and second 'b' is 1 ...

A bigger example using rindex is as follows - note, this is ONLY an example using rindex, and most certainly NOT the best way to split a path ;=)) If fact perl has its own basename function in use File::Basename; - see basename ...

code:

my $file = 'openal\test.cxx';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'openal/test.cxx';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'openal\../test';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'test.h';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'openal/test';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'test';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'openal\../test.c';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
  $file = 'openal\../';
print "File $file has ext = [".file_extension($file).
   "], and a title = [".file_title($file)."] ...\n";
sub pos_of_last_slash {
   my $fil = shift;  
   my $in1 = rindex( $fil, '/' );  
   my $in2 = rindex( $fil, '\\' );  
   my $pos = -1;  
   # if BOTH exist
   if (($in1 >= 0) && ($in2 >= 0)) {  
      # get the LAST
      if ($in1 > $in2) {
         $pos = $in1;
      } else {
         $pos = $in2;
      }
   } elsif ($in1 >= 0 ) {
      $pos = $in1;
   } elsif ($in2 >= 0 ) {
      $pos = $in2;
   }
   return $pos;
}
sub file_extension {
   my $fil = shift;  
   my $pos = pos_of_last_slash($fil);
   my $last = rindex( $fil, '.' );
   my $ext = '';
   if ( $last >= 0 ) {  
      if ($pos >= 0) {            
         if ($last > $pos) {
            $ext = substr( $fil, $last + 1);
         }
       } else {
         $ext = substr( $fil, $last + 1);
       }
   }  
   return $ext;
}
sub file_title {
     my $fil = shift;  
     my $pos = pos_of_last_slash( $fil );  
     my $last = rindex( $fil, '.' );
     my $tit = '';  
     if ($last >= 0) {  
         if ($pos >= 0) {  
             if ($last > $pos) {
                 print "Using 1 substr( $fil, $pos+1, $last - $pos - 1 ) ...\n";
                 $tit = substr( $fil, $pos+1, $last - $pos - 1 );
             } else {
                 print "Using 2 substr( $fil, $pos+1 ) ...\n";
                 $tit = substr( $fil, $pos+1 );
             }
         } else {
             print "Using 3 substr( $fil, 0, $last ) ...\n";
             $tit = substr( $fil, 0, $last );
         }
     } elsif ($pos >= 0) {
         print "Using 4 substr( $fil, $pos+1 ) ...\n";
         $tit = substr( $fil, $pos+1 );
     } else {
         print "Using 5 no slash, no dot ...\n";
         $tit = $fil;
     }
     return $tit;
  }

 

output:

Using 1 substr( openal\test.cxx, 6+1, 11 - 6 - 1 ) ...
  File openal\test.cxx has ext = [cxx], and a title = [test] ...
  Using 1 substr( openal/test.cxx, 6+1, 11 - 6 - 1 ) ...
  File openal/test.cxx has ext = [cxx], and a title = [test] ...
  Using 2 substr( openal\../test, 9+1 ) ...
  File openal\../test has ext = [], and a title = [test] ...
  Using 3 substr( test.h, 0, 4 ) ...
  File test.h has ext = [h], and a title = [test] ...
  Using 4 substr( openal/test, 6+1 ) ...
  File openal/test has ext = [], and a title = [test] ...
  Using 5 no slash, no dot ...
  File test has ext = [], and a title = [test] ...
  Using 1 substr( openal\../test.c, 9+1, 14 - 9 - 1 ) ...
  File openal\../test.c has ext = [c], and a title = [test] ...
  Using 2 substr( openal\../, 9+1 ) ...
  File openal\../ has ext = [], and a title = [] ...

As stated, this is certainly NOT the best way to parse a PATH. use File::Basefile instead!

top -|- index -|- samples


split( /PATTERN/, STRING, [LIMIT] )

split /PATTERN/, STRING, LIMIT
split /PATTERN/, STRING
split /PATTERN/
split

Splits a string into an array of strings, and returns it. By default, empty leading fields are preserved, and empty trailing ones are deleted. If STRING is omitted, splits the $_ string. If PATTERN is also omitted, splits on whitespace (after skipping any leading whitespace). Anything matching PATTERN is taken to be a delimiter separating the fields. (Note that the delimiter may be longer than one character.) If LIMIT is specified and positive, splits into no more than that many fields (though it may split into fewer). If LIMIT is unspecified or zero, trailing null fields are stripped.

code:

print "Hello, World...\n";
my $src = "group|filename.ext|filename";
my @bits = split( /\|/,$src ); # note 'escape' \ in front of '|'
my ($grp,$fil,$tit) = split( /\|/,$src,3 );
my $cnt = scalar @bits;
print "Bits $cnt =".$bits[0].'|'.$bits[1].'|'.$bits[2]. " from $src ...\n";
print "Bits = $grp | $fil | $tit from $src ...\n";
my $bit = '';
my $item = 0;
foreach $bit (@bits) {
     $item++;
     print "$item = $bit\n";
  }

 

output:

Hello, World...
  Bits 3 =group|filename.ext|filename from group|filename.ext|filename ...
  Bits = group | filename.ext | filename from group|filename.ext|filename ...
  1 = group
  2 = filename.ext
  3 = filename

The split function in fact uses a regular expression for the dividing of a string. For example -

code:

$path = 'c:\this/that\another/end';
@arr = split(/[\\\/]/, $path);
$cnt = scalar @arr;
for ($i = 0; $i < $cnt; $i++) {
   print ' cnt='.($i + 1).': '.($arr[$i])."\n";
}
@arr = split(/(\\|\/)/, $path);
$cnt = scalar @arr;
for ($i = 0; $i < $cnt; $i++) {  
   print ' cnt='.($i + 1).': '.($arr[$i])."\n";
}

output:

 cnt=1: c:
 cnt=2: this
 cnt=3: that
 cnt=4: another
 cnt=5: end
 cnt=1: c:
 cnt=2: \
 cnt=3: this
 cnt=4: /
 cnt=5: that
 cnt=6: \
 cnt=7: another
 cnt=8: /
 cnt=9: end

The Perl documentation suggests a split on a space, / /, will split on any 'spacey' character, include \n, and \t, etc, but if there are multiple spaces in a line of text, then the split will yield some 'blank' entries in the array ... consider the following code and output - note I have used my 'prt' sub, which is the same as 'print', except it also write the output to a file handle, as well as to standard out -

code:

$txt = '   10234   10234   0%  25/01/2005  01:40  fg098-FlightGear.zip';
@arr = split(/ /,$txt);
prt( "Line has been split into ".scalar @arr." components ...\n" );
foreach $cn (@arr) { prt( "[$cn]\n" ); }

output:

Line has been split into 16 components ...
  []
  []
  []
  [10234]
  []
  []
  [10234]
  []
  []
  [0%]
  []
  [25/01/2005]
  []
  [01:40]
  []
  [fg098-FlightGear.zip]

This is obviously NOT what is wanted! Just by changing the split to using a regular expression, and adding a plus, which means 'match 1 or more times', the scene changes considerably -

code:

$txt = '   10234   10234   0%  25/01/2005  01:40  fg098-FlightGear.zip';
@arr = split(/\s+/,$txt);
prt( "Line has been split into ".scalar @arr." components ...\n" );
foreach $cn (@arr) { prt( "[$cn]\n" ); }

output:

Line has been split into 7 components ...
  []
  [10234]
  [10234]
  [0%]
  [25/01/2005]
  [01:40]
  [fg098-FlightGear.zip]

But as can be seen the leading space(s) still create an initial blank in the array. This can be fixed by 'massaging' the text first, to remove any initial spaces, like -

code:

$txt = '   10234   10234   0%  25/01/2005  01:40  fg098-FlightGear.zip';
$txt = substr($txt,1) while ($txt =~ /^\s/);
@arr = split(/\s+/,$txt);
prt( "Line has been split into ".scalar @arr." components ...\n" );
foreach $cn (@arr) { prt( "[$cn]\n" ); }

output:

Line has been split into 6 components ...
  [10234]
  [10234]
  [0%]
  [25/01/2005]
  [01:40]
  [fg098-FlightGear.zip]

Which looks good ;=)) This page - http://www.perlmeme.org/howtos/perlfunc/split_function.html - gives some other examples of the split function, like using brackets, ( ), to retain the splitter items, etc ...

top -|- index -|- samples


scope

Understanding the 'scope' of a variable in Perl can be difficult. This reference - http://perl.plover.com/FAQs/Namespaces.html - explains some of it. Basically ALL variables created have a 'global' scope ... for example -

code:

$x = 2;
sub change_var {
    $x = 3;
  }

After change_var() is called, $x will now equal 2. As the above 'namespace' reference advises, $x is a 'package variable', and such 'package variables' are always global ... its full name is main::$x, unless you set the 'package' name explicitly ...

Of course, there are times when you want a 'private variable', or 'lexical variable' ... other languages, scripts often use the word 'local' for this, but take care Perl uses 'my' for this. As the article states, if you want a 'local variable' think my, not local ;=)) Example -

code:

sub print_report {
   @employee_list = @_;
   foreach $employee (@employee_list) {
      $salary = lookup_salary($employee);
      print_part_report($employee, $salary);
   }
}

This creates a bunch of global variables, @employee_list, $employee, and $salary, which can be clobbered by other parts of the program. To ensure these are 'local' only, use my!

code:

sub print_report {
   my @employee_list = @_;
   foreach my $employee (@employee_list) {
      my $salary = lookup_salary($employee);
      print_part_report($employee, $salary);
   }
}

Take care! There is a 'local' function, but it does not do exactly what you think. Do not use it, unless you really 'understand'!

There is a 'strict' declaration that will help to sort out some of the 'problems' ... Add -

code:

use strict 'vars';

or just

use strict;

And 'mixing' packages can have some weird' effects, like -

code:

#!/usr/bin/perl
use strict; use warnings; use diagnostics;
package main;
my $foo = "hello"; $main::foo = "world";
print "$foo $main::foo\n";

So how come the two 'foo' are different? even if the 'package main;' declaration is removed...

There is also an 'our ($x)' declaration ... this is like saying "use vars '$x';", which allows global $x to be used anywhere, this allow $x to be exempt from the use strict 'vars' declaration. For another example of using 'our', see 'require'...

top -|- index -|- samples


chomp STRING;

Take off any return character, also known as the NEWLINE character, symbolised as \n, at the end of the string. It will not effect other characters! In other words, it removes any trailing string that corresponds to the current value of $/ (also known as $INPUT_RECORD_SEPARATOR in the English module).

Take care! This will NOT always remove the CR, symbolised as \r ... Here is some code to load a file, and remove both CR and LF, if present ...

code:

open IF, "<$my_file" or die "Can not OPEN $my_file!\n";
my @lines = <IF>; # slurp whole file, to an array of lines
close(IF);
foreach my $line (@lines) {
   chomp $line; # remove any return (\n) character ...
   $line =~ s/\r$//; # and remove CR (\r), if present
   print "$line\n";
}

top -|- index -|- samples


XML

There are so many modules in Perl handling XML it can become down right confusing. The following is a SIMPLE example of loading an XML file, and 'walking' the document tree .. You need to adjust the line -

code:

my $file = "c:\\FG0910-1\\source\\projects\\VC8\\FlightGear.vcproj";

Point it at your 'favourite' XML file, and see what happens. Since the output flashes by on the console screen, it has also been written to a log file, tempxout.txt ... modify this also to what you want ...

code:

#!/Perl
# XML - Walking the xml document tree, using XML::Simple - 16 April, 2006
use Data::Dumper;
use XML::Simple;
my $outfil = 'tempxout.txt';
my ($OF);
my $file = 'c:\\FG0910-1\\source\\projects\\VC8\\FlightGear.vcproj';
open $OF, ">$outfil" or die "Can not create $outfil!\n";
my $xs1 = XML::Simple->new();
my $doc = $xs1->XMLin($file);
  prt( "Hello, World... loaded $file ... showing the document tree ...\n");
  show_type($doc, 'doc', 1);
  prt( "Dump of WHOLE document tree ...\n" );
  prt( Data::Dumper->Dump([$doc], [qw(doc)]) );
  prt( "End of show ;=))\n" );
close $OF;
# show_type: parameters $variable $name $output
# will effectively walk the document tree,
# outputting all the elements, and their values.
sub show_type {
  my ($k, $name, $out) = @_;
  my $type = ref($k);
  my $msg = "$name ";
  if ($type) {
     if ($type eq 'HASH' ) {
        my $hcnt = scalar keys %$k;
        $msg .= "(HASH) hcnt=$hcnt ";
        for my $k1 (keys %$k) {
           $msg .= "key=$k1 ";  
           #if (defined %{$k{$k1}} ) {
           #   my $v = %{$k{$k1}};  
           if (defined $$k{$k1} ) {
               my $v = $$k{$k1};  
               my $t2 = ref($v);            
               if ($t2) {  
                  $msg .= "\n{".show_type($v, "$k1 => ", 0).'}';
               } else {
                  $msg .= "val=$v ";
               }
            } else {
              $msg .= 'v=undef ';
            }
         }
      } elsif ($type eq 'ARRAY') {
         my $cnt = scalar @$k;  
         $msg .= "(ARRAY) acnt=$cnt ";
         foreach my $t (@$k) {
            my $t2 = ref($t);  
            if ($t2) {
               $msg .= "\n{".show_type($t, 'sta => ', 0).'}';
            } else {
               $msg .= "$t ";
            }
        }
    } elsif ($type eq 'CODE') {
       $msg .= "is CODE ... ";
    } elsif ($type eq 'GLOB') {  
       $msg .= "is GLOB ... ";
    } else {
       $msg .= "Type is $type ... ";
       $msg .= "[$k] not HASH, ARRAY, CODE. GLOB ... ";
    }
  } else {
   $msg .= "(SCALAR) no Type [$k] ...";
  }
   prt( "$msg\n" ) if ($out);
   return $msg;
}
sub prt {
   print @_;  
   print $OF @_;
}
#eof

top -|- index -|- samples


substr EXPR OFFSET [LEN [SUBSTITUTE]]

This is a very powerful built-in function. Used in its simplest form 'substr( string, offset )' yields the string following the offset ... example -

code:

my $txt = 'The quick brown fox jumps over the lazy dog';
my $txt2 = substr( $txt, 4  );
print "[$txt]\n";
print "[$txt2]\n";

output:

[The quick brown fox jumps over the lazy dog]
  [quick brown fox jumps over the lazy dog]

But if you want part of the string, then add a length, like -

code:

my $txt = 'The quick brown fox jumps over the lazy dog';
my $txt2 = substr( $txt, 4, 5 );
print "[$txt]\n";
print "[$txt2]\n";

output:

[The quick brown fox jumps over the lazy dog]
  [quick]

Finally, it can be used to substitute a string, into the original, and return what was there originally, like -

code:

my $txt = 'The quick brown fox jumps over the lazy dog';
my $txt2 = substr $txt, index( $txt, 'dog'), 3, 'dogs';
print "[$txt]\n";
print "[$txt2]\n";

output:

[The quick brown fox jumps over the lazy dogs]
[dog]

Finally, if an offset is used that is larger than the length of the string, then warnings will be emitted, if warnings are on ...

code:

my $txt = 'The quick brown fox jumps over the lazy dog';
my $txt2 = substr $txt, (length($txt) + 1);
print "[$txt]\n";
print "[$txt2]\n";

output:

substr outside of string at test9.pl line 4.
[The quick brown fox jumps over the lazy dog]
Use of uninitialized value in concatenation (.) or string at test9.pl line 6.
[]

A VERY useful string function ;=)) this page - http://www.perlmeme.org/howtos/perlfunc/substr.html - give some further examples ...

top -|- index -|- samples


die [ LIST ]:

Prints the value of LIST to STDERR and exits with the current value of $! (errno). If $! is 0, exits with the value of ($? >> 8). If ($? >> 8) is 0, exits with 255. LIST defaults to "Died". $? is the status returned by the last command, pipe close or system operator.

code:

$filename = 'configure.ac';
open(FH, $filename)
  || die "ERROR: can't open '$filename': $!\n Currently running in ".getcwd()." ...\n";

output:

ERROR: can't open 'configure.ac': No such file or directory
 Currently running in C:/GTools/perl ...

top -|- index -|- samples


exit [ EXPR ]:

Exits immediately with the value of EXPR, which defaults to 0 (zero). Calls END routines and object destructors before exiting.

code:

exit(1);

top -|- index -|- samples


qw( list of things ):

This is 'quote word' function is a simple, quick way to create an Array list. You can build an array as follow -

code:

my @names = ("Joan", "Geoff", "Peter");

But Perl offers a quicker way -

code:

my @names = qw( Joan Geoff Peter );

The quote word function qw(STRING) takes each element in the string passed to it and splits it on the white space, placing each item into an array element. You can also write it as -

code:

my @names = qw/Joan Geoff Peter/;

top -|- index -|- samples


join( 'EXPR', @list ):

Will 'join' the items in the array @list, using the EXPR between each item. It is rational in that it will not add the EXPR at the beginning or end of the list, but it will add two or more if there are blank items in the list.

code:

my @list = qw( Peter Paul Mary ); # make a simple list
my $line = join( ', ', @list ); # join list into single line
print "$line\n"; # output the line

output:

Peter, Paul, Mary

top -|- index -|- samples


if ( EXPR ) { BLOCK } [ [ elsif ( EXPR ) { BLOCK } ] else { BLOCK } ]
unless ( EXPTR ) { BLOCK } [ else { BLOCK } ]

Perl uses a very 'standard' form of 'if' ... except perhaps the shortening of 'else if' to 'elsif' ... and shares the 'else' with 'unless' ... and Perl can also use a trailing 'if' ...

code:

my $add_file = 1;
if ( $add_file == 1 ) {   
    print FH "add to file"; # write to file
} elsif ( $add_file = 2 ) {  
    print FH2 "add to file 2"; # do different file
} else {  
    # do not write file
}
die "File is not 1" if (( $add_file == 0 ) || ($add_file == 2));
unless   ( $add_file == 0 ) {  
    # do not write file
} else {
    if ( $add_file == 1 )
        print FH "add to file"; # write file, or
    else  
        # different file ...
}
# Round up time to next multiple of 15 minutes
my $NewTime = int(($Sec+$Min*60+$Hour*3600)/900+1)*900;
unless (defined $Time && ($NewTime == $Time)) {
    # this block will be process if one of the above 2 EXPR  
    # evaluates to NOT true. That is, this block will
    # be process if (1) $Time is un-defined, OR if
    # (2) $NewTime is NOT equal to $Time ...
    # Could also be written as if( ! defined $Time || ($NewTime != $Time) )  
    # --- not particularly intuitive logic --- ;=))
    $Time = $NewTime; # update the time
} else {  
    # This will be processed if ( defined $Time, and $NewTime == $Time )
}

top -|- index -|- samples


sort [SUBROUTINE] LIST

Sorts a list, and returns an array in sorted order. The SUBROUTINE, if given must return zero if equal, less than zero, or greater than zero. 'reverse' will reverse the sort order.

code:

my @list = qw( c a b );
foreach $item (sort @list) {
  print $item;
}

output:

abc

code:

foreach $item (reverse sort @list) {
   print $item;
}

output:

cba

This is a strict alphabetic sorting, so with case, this may not be what you want - example :-

code:

my @list = qw( c a B );
foreach my $item (sort @list) {
   print $item;
}

output:

Bac

But a SUBROUTINE can be used to fix this - example :-

code:

foreach my $item (sort {uc($a) cmp uc($b)} @list) {
   print $item;
}

output:

aBc

This could be reversed, by placing the 'global' $b before the $a ...

Of course a SUBROUTINE must be used on a multi-dimensional array, like the following sample -

code:

#!/Perl
# test3.pl
# AIM: Check out sorting a multi-dimensional array ...
# in this case text, thus 'lt' and 'gt' used
# for number sort this would be '<' and '>'!
my $verb3 = 0;
prt( "$0...Hello, World...\n");
my @mdarray = (
   [ 'c', 'cast' ],
   [ 'a', 'appl' ],
   [ 'z', 'zero' ],
   [ 'b', 'beat' ]
  );
my @mdnarray = (
   [ 3, 'cast' ],
   [ 1, 'appl' ],
   [ 4, 'zero' ],
   [ 2, 'beat' ]
  );
my $cnt = scalar @mdarray;
prt( "Array has $cnt members ...\n" );
my @ascarray = sort myasc_ascend @mdarray;
my @decarray = sort myasc_decend @mdarray;
for ($i = 0; $i < $cnt; $i++ ) {
   prt( " ".($i+1)." " );
   prt( "org ($mdarray[$i][0] $mdarray[$i][1]) " );
   prt( "asc ($ascarray[$i][0] $ascarray[$i][1]) " );
   prt( "dec ($decarray[$i][0] $decarray[$i][1])" );
   prt( "\n" );
}
my @ascnarray = sort mycmp_ascend @mdnarray;
my @decnarray = sort mycmp_decend @mdnarray;
for ($i = 0; $i < $cnt; $i++ ) {
   prt( " ".($i+1)." " );
   prt( "org ($mdnarray[$i][0] $mdnarray[$i][1]) " );
   prt( "asc ($ascnarray[$i][0] $ascnarray[$i][1]) " );
   prt( "dec ($decnarray[$i][0] $decnarray[$i][1])" );
   prt( "\n" );
}
# put least first
sub myasc_ascend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "-[".${$a}[0]."] < [".${$b}[0]."] asc\n" ) if $verb3;
      return -1;
   }
   if (${$a}[0] > ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."] asc\n" ) if $verb3;
      return 1;
   }
   prt( "=[".${$a}[0]."] = [".${$b}[0]."] asc\n" ) if $verb3;
   return 0;
}
sub myasc_decend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."] dec\n" ) if $verb3;  
      return 1;
   }
   if (${$a}[0] > ${$b}[0]) {
      prt( "-[".${$a}[0]."] > [".${$b}[0]."] dec\n" ) if $verb3;
      return -1;
   }
   prt( "=[".${$a}[0]."] = [".${$b}[0]."] dec\n" ) if $verb3;
   return 0;
}
# put least first
sub mycmp_ascend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "-[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;  
      return -1;
   }  
   if (${$a}[0] > ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;  
      return 1;
   }
   prt( "=[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;  
   return 0;
}
sub mycmp_decend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;  
      return 1;
   }
   if (${$a}[0] > ${$b}[0]) {
      prt( "-[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;  
      return -1;
   }
   prt( "=[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
   return 0;
}
sub prt {
   my ($t) = shift;  
   print "$t";
}
# eof - test3.pl

output:

test3.pl...Hello, World...
  Array has 4 members ...
 1 org (c cast) asc (a appl) dec (z zero)
 2 org (a appl) asc (b beat) dec (c cast)
 3 org (z zero) asc (c cast) dec (b beat)
 4 org (b beat) asc (z zero) dec (a appl)
 1 org (3 cast) asc (1 appl) dec (4 zero)
 2 org (1 appl) asc (2 beat) dec (3 cast)
 3 org (4 zero) asc (3 cast) dec (2 beat)
 4 org (2 beat) asc (4 zero) dec (1 appl)

top -|- index -|- samples


Arrays - scalar, array of arrays, and associative

There are two types of arrays used in Perl. The first is a scalar array, declared using '@', a simple list of elements, but it can be multi-dimensional, and the other is an associative array, called a hash, declared using '%', which is a set of element values, each associated to a key value. As with all Perl, the elements can be a string, or a number value. See multi-sort for sorting a multi-dimensional array.

top -|- index -|- samples


Scalar Arrays

A scalar array can be declared, using an '@', and cleared using -

code:

my @array = ();

A scalar array can be declared, using an '@', and initialised with elements, like -

code:

my @array = qw( Apple Orange Banana Pear );

The 'qw' is a built in function to aid in writing an array. It is functionally equivalent to writing -

code:

my @array = ( "Apple", "Orange", "Banana", "Pear" );

The count of the elements in an array can be found by -

code:

my $arrcnt = scalar @array;
print "Count in array2 = $arrcnt ...\n";

output:

Count in @array2 = 4 ...

The values stored in an array may be access simply using an index. The following extracts the 2nd element, that is, makes $val2 to contain the value 'Orange'. Note the index is zero based, and the array is addressed like a scalar, that is using '$' -

code:

$va2 = $array[1];
print "Value of item 2 in \@array2 is $va2 ...\n";

output:

Value of item 2 in @array2 is Orange ...

The set of elements in an array can be addressed successively by the code -

code:

print "List in \@array2 = ";
foreach my $val (@array) {
    print $val.' ';
  }
print "\n";

output:

List in @array2 = Apple Orange Banana Pear

Also scalar arrays can be multidimensional. The square brackets are used to declare these, like -

code:

my @mdarray = (
 [ "a", "b", "c" ],
 [ "d", "e", "f" ]
 );

In this case, the count would be two (2) from the code -

code:

my $arrcnt2 = scalar @mdarray;
print "Count in \@mdarray = $arrcnt2 ...\n";

output:

Count in @mdarray = 2 ...

Care must be taken in addressing elements in the multi-dimensional array, to ensure all indexes are within range. The following will address the 'b' and 'e' members, respectively -

code:

$e12 = $mdarray[0][1];
$e22 = $mdarray[1][1];
print "Value of item row 1, column 2 in \@mdarray is $e12 ...\n";
print "Value of item row 2, column 2 in \@mdarray is $e22 ...\n";

output:

Value of item row 1, column 2 in @mdarray is b ...
Value of item row 2, column 2 in @mdarray is e ...

To address all elements ... take care to get the maximum indexes correct - Perl does NOT emit an error when an index is beyond the limits of the array - it just returns 'nothing' ...

code:

print "List of elements: ";
for (my $i = 0; $i < 2; $i++) {
   for (my $j = 0; $j < 3; $j++) {  
      print $mdarray[$i][$j].' ';
   }
}
print "\n";

output:

List of elements: a b c d e f

Or a multi-dimensional array can be iterated with ...

code:

print "List of elements in \@mdarray: ";
foreach my $ref (@mdarray) {
   foreach my $el (@$ref) {  
      print "[$el] ";
   }
}
print "\n";

output:

List of elements in @mdarray: [a] [b] [c] [d] [e] [f]

As the above shows, a multi-dimensional scalar array is really an array of arrays, thus can be formed by the following syntax -

code:

@ar1 = qw(a1 a3 a3);
@ar2 = qw(b1 b2 b3);
@mdar = ();
push(@mdar, [@ar1]);
push(@mdar, [@ar2]);
$cnt = scalar @mdar;
print "mdar has $cnt members ...\n";
for ($i = 0; $i < $cnt; $i++) {
   print ' cnt='.($i + 1).': '.($mdar[$i][0]).' '.($mdar[$i][1]).' '.($mdar[$i][2])."\n";
}

output:

mdar has 2 members ...
cnt=1: a1 a3 a3
cnt=2: b1 b2 b3

To pop an array removes the final element from the array, and negative indexing into an array, starts from the last element. The following uses pop and a negative index on an array created by split on any periods in a file name ... scalar @a returns the number of elements in the array ...

code:

#!\Perl
sub my_file_name {
   my ($f) = shift;  
   my @a = split(/\./, $f);  
   my $cnt = scalar @a;  
   if ($cnt > 1) {  
      pop @a;
      return join( '.', @a);
   }
   return $f;
}
sub my_file_ext {
   my ($f) = shift;  
   my @a = split(/\./, $f);
   my $cnt = scalar @a;
   if ($cnt > 1) {  
      return $a[-1];
   }
   return '';
}
$fn = 'filename.ext';
$fn1 = 'filename.ext.bak';
$fn2 = 'filename';
print "[$fn] becomes [".my_file_name($fn)."]\n";
print "[$fn1] becomes [".my_file_name($fn1)."]\n";
print "[$fn2] becomes [".my_file_name($fn2)."]\n";
print "[$fn] becomes [".my_file_ext($fn)."]\n";
print "[$fn1] becomes [".my_file_ext($fn1)."]\n";
print "[$fn2] becomes [".my_file_ext($fn2)."]\n";

output:

[filename.ext] becomes [filename]
[filename.ext.bak] becomes [filename.ext]
[filename] becomes [filename]
[filename.ext] becomes [ext]
[filename.ext.bak] becomes [bak]
[filename] becomes []

Another example of an Array of Arrays ...

code:

#!/perl -w
# NAME: arrays01.pl
# AIM: Just some tests with an Array of Arrays
# 04/09/2007 geoff mclane - http://geoffair.net/mperl/
use strict;
use warnings;
# declaring an array of arrays
my @AoA = (
        [ "fred", "barney" ],
        [ "george", "jane", "elroy" ],
        [ "homer", "marge", "bart" ],
      );
# add to an existing row
push( @{ $AoA[0] }, "wilma", "betty");
push( @{ $AoA[2] }, "peter", "paul");
# accessing printing the arrays
foreach my $aref ( @AoA ) {
    prt( "whole [ @$aref ],\n" );
    prt( "1by1  [ ");  
    foreach my $k (@{$aref}) {
       prt( "$k " );
    }
    prt("]\n");
}
exit(0);
sub prt {
   my ($m) = shift;  
   print $m;
}
# eof - arrays01.pl

output:

whole [ fred barney wilma betty ],
1by1  [ fred barney wilma betty ]
whole [ george jane elroy ],
1by1  [ george jane elroy ]
whole [ homer marge bart peter paul ],
1by1  [ homer marge bart peter paul ]

Of course, pushing an array onto an array just extends the array ...

code:

@arr1 = qw( one two three );
@arr2 = qw( four five six );
my @narr = @arr1;
push(@narr, @arr2);
$cnt = scalar @narr;
foreach $item (@narr) {
   print "$item ";
}
print "\n"

output:

one two three four five six

And there is much more about arrays ...

top -|- index -|- samples


unicode - multi-byte character sets

It was not until I started to read data from the WIN32 registry did I need to take care of UNICODE multi-byte character sets ... and that was using -

use strict;
use warnings;
use Encode;
use Win32::Registry;
use Win32::TieRegistry( Delimiter => "#", ArrayValues => 0 );
my $pound = $Registry->Delimiter("/");

But in the first instance it was handling a zero terminated set of strings, double zero terminated at the end. Here I needed to split a string per /x00/ to get the set of strings ...

                               my @aent = split(/\x00/, $dat1);

top -|- index -|- samples


basename, splitpath & abs_path - parse a full path string.

While this is NOT a built-in function, it does come as part of the core ActivePerl, and is available through use File::Basename; declaration. Example -

code:

#!/perl -w
# NAME: basename.pl
# AIM: simple example of using fileparse, and basename ...
use strict;
use warnings;
use File::Basename;
my $fullname = 'C:\path1\path2\basename.txt';
  show_split( $fullname );
$fullname = 'C:\path1/path2/somename.html'; # mixed unix windows separator
show_split( $fullname );
exit(0);
# subs
sub show_split {
   my ($fil) = shift;  
   my ($name,$path,$suffix) = fileparse($fil);  
   print "name=[$name], path=[$path], suffix=[$suffix] ...\n";  
   my $filename = basename($fil,   ".".get_suffix($fil));  
   print "filename=[$filename] ...\n";
}
sub get_suffix {
   my ($f) = shift;  
   my @arr = split(/\./,$f);  
   return $arr[-1];
}
# eof - basename.pl

output:

name=[basename.txt], path=[C:\path1\path2\], suffix=[] ...
filename=[basename] ...
name=[somename.html], path=[C:\path1/path2/], suffix=[] ...
filename=[somename] ...

top -|- index -|- samples


But, remember, there is also splitpath ... note the use File::Spec::Functions ...

code:

#!/perl -w
# NAME: basename02.pl
# AIM: simple example of using fileparse, and basename ...
# see http://perldoc.perl.org/File/Basename.html
use strict;
use warnings;
use File::Basename;
use File::Spec::Functions qw[splitpath canonpath splitdir abs2rel];
my $fullname = 'C:\path1\path2\basename.txt';
show_split( $fullname );
$fullname = 'C:\path1/path2/somename.html'; # mixed unix windows spearator
show_split( $fullname );
$fullname = '..\..\relname.c'; # simple relative path
show_split( $fullname );
$fullname = 'C:\path1\path2\./relname2'; # without ext
show_split( $fullname );
exit(0);
# subs
sub show_split {
   my ($fil) = shift;  
   my ($name,$path,$suffix) = fileparse( $fil, qr/\.[^.]*/ );  
   print "name=[$name], path=[$path], suffix=[$suffix] ... \n";  
   my ($volume, $dir_path, $file) = splitpath( $fil );  
   print "volume=[$volume], path=[$dir_path], file=[$file] ... \n";
}
# eof - basename02.pl

output:

name=[basename], path=[C:\path1\path2\], suffix=[.txt] ...
volume=[C:], path=[\path1\path2\], file=[basename.txt] ...
name=[somename], path=[C:\path1/path2/], suffix=[.html] ...
volume=[C:], path=[\path1/path2/], file=[somename.html] ...
name=[relname], path=[..\..\], suffix=[.c] ...
volume=[], path=[..\..\], file=[relname.c] ...
name=[relname2], path=[C:\path1\path2\./], suffix=[] ...
volume=[C:], path=[\path1\path2\./], file=[relname2] ...

top -|- index -|- samples


And to convert a RELATIVE path, to an ABSOLUTE path ...

code:

#!/perl
use Cwd 'abs_path';
$path = 'C:\FG\12\fgfs\..\FlightGear\FlightGear.vcproj';
$apath = abs_path($path);
print "Relative path [$path]\n";
print "Absolute path [$apath]\n";

output:

Relative path [C:\FG\12\fgfs\..\FlightGear\FlightGear.vcproj]
Absolute path [C:/FG/12/FlightGear/FlightGear.vcproj]

There is always more than one way ;=)) To get the current work directory, use the 'Cwd' module, then as simple as $var = cwd(); ...

code:

use Cwd;
my $currdir = cwd();
print "Current directory: [$currdir]\n";

output:

Current directory: [C:/GTools/perl]

See also basename, splitpath & abs_path ...

top -|- index -|- samples


stat - get file information

Returns a 13-element list giving the status info for a file, typically as follows -

($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
$size,$atime,$mtime,$ctime,$blksize,$blocks)
 = stat($filename);

Or as a hash array reference, like as follows -

code:

use strict;
use warnings;
use File::stat;
my $filename = "clds3.jpg";
my $sb = stat($filename);
printf "File is %s, size is %s, perm %04o, mtime %s\n",
        $filename, $sb->size, $sb->mode & 07777,  
        scalar localtime $sb->mtime;

output:

File is clds3.jpg, size is 3567, perm 0666, mtime Sat May 22 19:20:00 2004

top -|- index -|- samples


unlink - delete a file.

This built in function deletes a file. It will not function on directories - The following creates and writes to a file is none exists, then deletes that file ...

code:

#!/perl
# NAME: unlink.pl
# AIM: To do a simple test on built in function, unlink ... 
# Note no -w above, else get additional warnings ...
use strict;
use warnings;
use File::stat;
my $file = 'tempunlink1.txt';
my $cnt = 0;
print "$0 ... Hello, World ...\n";
sub check_file($) {
   my ($fil) = shift;  
   my $sb = stat($file);  
   # if ( -f $fil) {  
   if ( defined $sb) {  
      print "File $fil exists ... \n";  
      print " Size = ". $sb->size . " bytes, dated " . scalar localtime $sb->mtime;  
      print "\n";  
      return 1;
   }  
   print "File $fil DOES NOT EXIST!\n";  
   return 0;
}
# main program
if ( ! check_file($file) ) {
   open OF, ">$file" or die "Unable to create file [$file] ...\n";  
   print OF "Message to file ...\n";  
   print OF "Another message to file ...\n";  
   close OF
}
if ( check_file( $file ) ) {
   print "Testing unlink built in function ...\n";  
   $cnt = unlink $file;  
   if ($cnt) {  
      print "File appears successfully deleted ...\n";
   } else {
      print "Failed unlinked ... $! ...\n";
   }
   check_file( $file );
} else {
   print "File does NOT appear to EXIST! ...\n";
}
exit(0); # end program
# eof - unlink.pl

output:

C:\GTools\perl\unlink.pl ... Hello, World ...
File tempunlink1.txt DOES NOT EXIST!
File tempunlink1.txt exists ...
Size = 50 bytes, dated Mon Mar  5 14:41:00 2007
Testing unlink built in function ...
File appears successfully deleted ...
File tempunlink1.txt DOES NOT EXIST!

top -|- index -|- samples


chr - generate ASCII output

If you want to generate a list of ASCII output, then 'chr' will convert a number, to ASCII, as follows -

code:

#!/Perl
# genascii.pl - 2007.02.20
my ($i);
for ($i = 32; $i < 127; $i++) {
   print "\n" if ((chr($i) eq 'A')||(chr($i) eq 'a'));  
   print chr($i);
}
print "\n";
# end genascii.pl

output:

 !"#$%&'()*+,-./0123456789:;<=>?@
 ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
 abcdefghijklmnopqrstuvwxyz{|}~

The sprintf function can also be used, like -
$char = sprintf("%c", $num);

The opposite is achieved by using 'ord'. That is converting a 'character' to a decimal value, like :-
$num = ord($char); ...

This small piece of perl script outputs a 255 byte extended ASCII chart ...

code:

#!C:\Perl
for (my $i = 1; $i < 256; $i++) {
   print sprintf( "%03d ", $i );  
   if ($i == 0) {  
      print "z ";
   } elsif ($i == 8 ) {
      print "d ";
   } elsif ($i == 9 ) {
      print "9 ";
   } elsif ($i == 7 ) {  
      print "b ";
   } elsif ($i == 10 ) {
      print "c ";
   } elsif ($i == 13 ) {  
      print "l ";
   } else {
      print sprintf( "%c ", $i );
   }  
   print sprintf( "%02X ", $i );
   if ($i && (($i % 8) == 0)) {
      print "\n";
   }
}
print "\n";

This is very useful to check the value of some character when you know its decimal, or hexadecimal value ... and how it will 'look' on the windows screen.

top -|- index -|- samples


gethostbyaddr - resolve an IP address to its domain name

The Socket module provides an easy way to resolve an IP address to the host name. The function is 'gethostbyaddr' will attempt to resolve an IP address to its respective host, using rDNS (reverse Domain Name System [or Service or Server]). The following small script takes an input of an IP address, and attempts to resolve the host name. The output shown is when $dgb1 = 1, for testing -

code:

#!/perl -w
# NAME: gethostbyip.pl
# AIM: Get the HOST name, given an IP address
use strict;
use warnings;
use Socket;
my $dbg1 = 0;     # test without input
my @ips = ();
my $iaddr = '';
my $ip = '';
if (@ARGV) {
   parse_args(@ARGV);
  } else {
   if ($dbg1) {  
      # just some samples  
      push(@ips, "192.168.1.150");  
      push(@ips, "203.8.188.169");
   } else {  
      die "Enter an IP number, form nn.nn.nn.nn\nto try to find the host name ...\n";
   }
}
# to convert IP address to an IP string
# ($a,$b,$c,$d) = unpack('C4',$addr[0]); or
# $straddr = inet_ntoa($iaddr);
foreach $ip (@ips) {
   print "IP address [$ip]\n";  
   $iaddr = inet_aton($ip); # convert address  
   my $name   = gethostbyaddr($iaddr, AF_INET);
   if (defined $name) {  
      print "resolved to name [$name] ...\n";
   } else {
      print "COULD NOT BE RESOLVED!\n";
   }
}
exit(0);
sub parse_args {
   my (@av) = @_;  
   my $cnt = 0;  
   while (@av) {  
      $cnt++;  
      my $a = shift @av; # get and move to next  
      if ($a =~ /\d+\.{1}\d+\.{1}\d+\.{1}\d+/) {  
         push(@ips, $a);
      } else {  
         die "Input [$a] does not appear to be an IP address of the form nn.nn.nn.nn ...\n";
      }
   } # while arguments
}
# eof - gethostbyip.pl

output:

IP address [192.168.1.150]
COULD NOT BE RESOLVED!
IP address [203.8.188.169]
resolved to name [adsl-1-169.lo1.lns1.server-access.com] ...

The script takes several seconds to run, because it tries very hard to resolve the first entry, before returning FAILED.

top -|- index -|- samples


gethostbyname - resolve a domain name to its IP address, or addresses

The Socket module provides an easy way to resolve an IP address from a host (DOMAIN) name. The function is 'gethostbyname' will attempt to resolve a domain name to its respective IP address(es), using DNS (Domain Name System [or Service or Server]). The following small script takes an input of a Domain Name, and attempts to resolve the IP address, or addresses. The output shown is when $dgb1 = 1, for testing -

code:

#!/perl -w
# NAME: gethost01.pl
# AIM: Get the HOST IP address, using the domain name 
use strict;
use warnings;
use Socket;
my @names = ();
my $dbg1 = 0;     # for testing without input
my $name = '';
if (@ARGV) {
   parse_arg(@ARGV);
} else {  
   if ($dbg1) {  
      @names = qw( nowhereknown.com geoffmclane.com home.exetel.com.au yahoo.com google.com macpcfirstaid.com
   adsl-1-169.lo1.lns1.server-access.com);
   } else {  
      die "NO INPUT! Input a domain name to find the IP address ...\n";
   }
}
foreach $name (@names) {
   showIPAddress($name);
}
exit(0);
sub showIPAddress {
   my ($nm) = shift;  
   print "Resolving [$nm] ...\n";  
   my @addr = gethostbyname($nm);  
   my $cnt = 0;
   if( !@addr ) {  
      print "CAN NOT RESOLVE $nm ... $! ...\n";  
      return;
   }
   @addr = map { inet_ntoa($_) } @addr[4 .. $#addr];  
   foreach my $k (@addr) {  
      $cnt++;
      print "$cnt: Resolves to IP [$k]\n";
   }
}
sub parse_args {
   my (@av) = @_;  
   my $cnt = 0;  
   while (@av) {  
      $cnt++;
      my $a = shift @av; # get and move to next  
      if ($a =~ /.*\.{1}.*/) {  
         push(@names, $a);
      } else {
         die "Input [$a] does not appear to be an IP address of the form aaa.bbb ...\n";
      }
   } # while arguments
}
# eof - gethost01.pl

output:

Resolving [nowhereknown.com] ...
CAN NOT RESOLVE nowhereknown.com ... Unknown error ...
Resolving [geoffmclane.com] ...
1: Resolves to IP [69.93.151.242]
Resolving [home.exetel.com.au] ...
1: Resolves to IP [220.233.0.13]
Resolving [yahoo.com] ...
1: Resolves to IP [66.94.234.13]
2: Resolves to IP [216.109.112.135]
Resolving [google.com] ...
1: Resolves to IP [72.14.207.99]
2: Resolves to IP [64.233.167.99]
3: Resolves to IP [64.233.187.99]
Resolving [macpcfirstaid.com] ...
1: Resolves to IP [63.241.136.202]
Resolving [adsl-1-169.lo1.lns1.server-access.com] ...
1: Resolves to IP [203.8.188.169]

The script may takes several seconds to run, because it tries very hard to resolve the first entry, before returning FAILED.

top -|- index -|- samples


goto - Jump to a label

goto LABEL - causes the current execution point to jump to the point referred to as LABEL. A 'LABEL' is a bare word, ending in a colon. A goto in this form cannot be used to jump into a loop or external function. You can only jump to a point within the same scope.
goto EXPR - expects EXPR to evaluate to a recognizable LABEL. In general, you should be able to use a normal conditional statement or function to control the execution of a program, so its use is deprecated.
goto &NAME - substitutes a call to the named subroutine for the currently running subroutine. The new subroutine inherits the argument stack and other features of the original subroutine; it becomes impossible for the new subroutine even to know that it was called by another name.

code:

#!/usr/bin/perl
use strict;
use warnings;
my $count = 0;
START:
$count = $count + 1;
if( $count > 4 ){
    print "Exiting program\n";
}else{
    print "Count = $count, Jumping to START:\n";
    goto START;
}

output:

Count = 1, Jumping to START:
Count = 2, Jumping to START:
Count = 3, Jumping to START:
Count = 4, Jumping to START:
Exiting program

top -|- index -|- samples


Dumper - dump any variable to see what it contains.

If you want to 'dump' a variable to see and understand its contents, then the following will do the trick ... that is it will stringified a perl data structures, suitable for printing. see http://perldoc.perl.org/Data/Dumper.html ... For example -

code:

#!/perl
use Data::Dumper;
use Win32::Registry;
$keyroot = $HKEY_CLASSES_ROOT;
print Dumper( $keyroot );

output:

$VAR1 = bless( { 'handle' => '-2147483648' }, 'Win32::Registry' );

You can also add the 'name' of the variable, like -

code:

#!/perl
use Data::Dumper;
use Win32::Registry;
$keyroot = $HKEY_CLASSES_ROOT;
print Data::Dumper->Dump([$keyroot], [qw(keyroot)]);

output:

$keyroot = bless( { 'handle' => '-2147483648' }, 'Win32::Registry' );

And it can be used in an OO way, which will yield the same result as the above -

code:

$d = Data::Dumper->new([$keyroot], [qw(keyroot)]);
print $d->Dump;

top -|- index -|- samples


flush - flush standard out

Output, from print and echo are normally buffered, at least until a LF (\n) is encountered. It is possible to set global flushing ON using :-

code:

$| = 1;

Or local $| = 1, for a particular set of outputs, in a function ... use sparingly, and carefully ;=)) as buffering of output helps with speed ...

top -|- index -|- samples


localtime

localtime converts the time(), or a file time, like $sb = stat($file); $sb->mtime;, to a 9-element array, with the time analyzed for the local time zone. The output can then be displayed in various ways :-

code:

#!/perl -w
# NAME: gentime.pl
# AIM: Just a simple example showing the use of 'localtime' builtin function.
# 29/07/2007 - geoff mclane - http://geoffair.net/mperl/index.htm
use strict;
use warnings;
my $tm = time();
my @timeData = localtime($tm);
print "$tm (seconds since system epoch - Midnight, January 1, 1970 GMT on Unix)\n";
print join(' ', @timeData); 
print " (Array of values)\n";
my $ct = get_date_time();
print "$ct - human readable form\n";
my $dt = get_YYYYMMDD_hhmmss($tm);
print "short $dt - alterative form\n";
sub get_date_time {
   my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
   my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
   my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset,
      $dayOfWeek, $dayOfYear, $daylightSavings) = localtime(time());
   my $year = 1900 + $yearOffset;
   my $theTime = "$hour:$minute:$second";
   my $theDate = "$weekDays[$dayOfWeek] $months[$month] $dayOfMonth, $year";
   return "$theTime, $theDate"; 
}
sub get_YYYYMMDD_hhmmss {
    my ($t) = shift;
    my @f = (localtime($t))[0..5];
    my $m = sprintf( "%04d/%02d/%02d %02d:%02d:%02d",
     $f[5] + 1900, $f[4] +1, $f[3], $f[2], $f[1], $f[0]);
    return $m;
}

output:

1227287209 (seconds since system epoch - Midnight, January 1, 1970 GMT on Unix)
49 6 18 21 10 108 5 325 0 (Array of values)
18:6:49, Fri Nov 21, 2008 - human readable form
short 2008/11/21 18:06:49 - alterative form

Quite a spiffy built-in function ;=))

top -|- index -|- samples


pop - pop element off array

Pops and returns the LAST value of the array, shortening the array by one element. Has an effect similar to -

       $ARRAY[$#ARRAY--]

If there are no elements in the array, returns the undefined value (although this may happen at other times as well). If ARRAY is omitted, pops the @ARGV array in the main program, and the @_ array in subroutines, just like shift.

top -|- index -|- samples


shift

Action: 'shift' a value off the top of an array.

code:

my @array = ( 'a', 'b', 'c' );
my $value = shift @array;
print "Shift popped [$value] off the top, leaving [".join(" ",@array)."]\n";

output:

Shift popped [a] off the top, leaving just [b c]

top -|- index -|- samples


unshift

Action: 'unshift' pushes a value onto the the top of an array.

code:

my @array = ( 'a', 'b' );
my $value = 'z';
unshift(@array,$value);
print "Add [$value] to top of array [".join(" ",@array)."]\n";

output:

Add [z] to top of array [z a b]

top -|- index -|- samples


ref() - like a typeof() - find out the type of thing being referenced

The value returned depends on the type of thing the reference is a reference to. Builtin types include:

    REF
    SCALAR
    ARRAY
    HASH
    CODE
    GLOB
    LVALUE (reference to a lvalue that is not a variable, like a function pos())
    IO (::Handle)
    VSTRING (points to version string)
    Regexp (from say qr//)
if (ref($r) eq "HASH") {
   print "r is a reference to a hash.\n";
}
if (!ref($r)) {
   print "r is not a reference at all.\n";
}

You can think of ref() as a typeof() operator, but note it can also return 'false/undefined'.

top -|- index -|- samples


references - reference to a variable, or to a routine, a 'sub', via a variable

Reference to variable: Kind of like C &address-of, a reference to a variable can be passed to a sub-routine. And that routine can thus change the variable, like -

code:

my $var = 10;
sub set_ref {
   my ($v) = @_;
   $$v = 20;
}
print "$var \n";
set_ref( \$var );
print "$var \n";

output:

10
20

Note use of '\' to pass the 'reference' (address-of), and the use of '$$' to address the variable.

Reference to sub: At certain time we may wish to call a particular sub-routine, according to an if switch ... setting a variable to $var = '\&subroutine, and then calling the 'service' via $var->( 'passed values' ) does this ...

code:

my $value1 = "<1 not set>";
my $value2 = "<2 not set>";
my ($valref, $serv);
sub set_value1 { $value1 = shift; }
sub set_value2 { $value2 = shift; }
sub type1 {
   my ($msg) = shift;
   prt( "Run TYPE1 ... $msg ...\n" );
}
sub type2 {  
   my ($msg) = shift;
   prt( "Run TYPE2 ... $msg ...\n" );
}
my $test = 1;
if ($test == 1) { 
   $serv = \&type1;  
   $valref = \&set_value1;
} else {
   $serv = \&type2;  
   $valref = \&set_value2;
}
$serv->( "This msg" );     # call the 'service', with value
$valref->( "IS SET" );     # set a global, with this value
prt( "value1 = $value1, value2 = $value2 ...\n" );
sub prt {  
   my ($t) = shift;  
   print $t;
}
# eof - subref.pl

output:

Run TYPE1 ... This msg ...
value1 = IS SET, value2 = <2 not set> ...

A simple sub-reference to a 'service' ... see also dereferencing

top -|- index -|- samples


 

unzip - using gzip, if you have it ...

Perl does not seem to have an 'unzip' built-in function, and I could not particularly find any 'free' unzip CPAN module, but it can be done another way if you have gzip available in your system. Here I have created a simple text file, with just two lines, and zipped it into a file called temp2.zip, and the following code is how to unzip, and extract those two line ...

code:

#!/perl -w
$file = 'temp2.zip';
open (INF, "gzip -d -c $file|") or die "I can't open $file\n" ;
@lines = <INF>;
close INF;
$cnt = scalar @lines;
print "Got $cnt lines ...\n";
foreach $line (@lines) {
   chomp $line;  
   print "$line\n" ;
}

output:

Got 2 lines ...
Line 1 in temp2.zip
Line 2

Note particularly the '|' after the file name, $file. This is a PIPE command, to send the gzip extracted data to perl ... running > gzip --help will show the command used of -d = decompress, and -c output to standard out (stdout) ...

A WIN32 port of gzip.exe can be downloaded from http://unxutils.sourceforge.net/ ... and probably other sites. Of course the folder that contains gzip.exe must be in the PATH environment variable.

top -|- index -|- samples


x - string repetition operator

This little gem, the 'x' operator gives a shortcut to repeating strings. All you have to do is put a string on the left side of the 'x' and a number on the right side. Like this :-

code:

my $msg = "Hello" x 5;
print "$msg\n";
# This is the same as "HelloHelloHelloHelloHello"

output:

HelloHelooHelloHelloHello

Of course the right hand number can be from a variable :-

output:

my $indent = 10;
my $msg2 = " " x $indent . "Hello";
print "$msg2\n";

output:

          Hello

Simple and elegant ;=))

top -|- index -|- samples


hex - conversion of hex digits to decimal, and vice versa ...

This simple built-in function, hex(), does the conversion to a decimal. There is no equivalent function to convert a decimal to hex, but sprintf("%2.2x", $num) does the trick.

code:

# hex conversions - from / to
my $color = '9a4fff';
my $color2 = 'FF4F9A';
my $argb = hex_color_2_rgb($color);
my $ahex = rgb_color_2_hex($argb);
  prt( "Color: $color returned ($argb) ...[$ahex]\n" );
my $argb2 = hex_color_2_rgb($color2);
my $ahex2 = rgb_color_2_hex($argb2);
  prt( "Color: $color2 returned ($argb2) ...[".uc($ahex2)."]\n" );
sub hex_color_2_rgb {
   my ($colr) = shift;  
   my $cl = length($colr);  
   my $rgb = '';  
   if ($cl == 6) {  
      for (my $i = 0; $i < 6; $i += 2) {  
         my $hclr = substr($colr,$i,2);  
         my $num = hex($hclr);  
         $rgb .= ',' if length($rgb);
         $rgb .= "$num";
      }
   } else {
      prt( "WARNING: Not 6 length hex color!\n" );
   }
   return $rgb;
}
sub rgb_color_2_hex {
   my ($argb) = shift;  
   my $hex = '';  
   my @arr = split(',',$argb);  
   if (scalar @arr == 3) {  
      $hex .= sprintf("%2.2x", $arr[0]);  
      $hex .= sprintf("%2.2x", $arr[1]);
      $hex .= sprintf("%2.2x", $arr[2]);
   } else {
      prt( "WARNING: Not an array of 3 comma separated values!\n" );
   }
   return $hex;
}
sub prt {
   my ($txt) = shift;
   print $txt;
  }

output:

Color: 9a4fff returned (154,79,255) ...[9a4fff]
Color: FF4F9A returned (255,79,154) ...[FF4F9A]

Simple but effective. Note that Perl handles the conversion of ASCII numbers to a decimal value transparently. Also see a Hexer, using a 'package' declaration, to 'hexify' a string. That is, convert a string of characters to a set of hex digits...

top -|- index -|- samples


parameters - passed to functions, and by reference returns ...

Parameters passed to a function arrive in the @_ special variable. And also using this @_ array, values can be returned, placed into passed variables. Like ...

code:

my $val = 0;
my $sqr = 0;
sub get_the_sum {
   my ($a, $b) = @_;  
   $_[2] = $a + $b;  
   $_[3] = $_[2] * $_[2];
}
get_the_sum( 1, 2, $val, $sqr );
prt( "Sum is $val ... Square is $sqr\n" );

output:

Sum is 3 ... Square is 9

So it can be seen, @_ not only passes variables into a function, but can also be used to return values in variables from the function ... neat ...

top -|- index -|- samples


__END__ - special end-of-file data ...

This __END__ denotes some special end-of-file data following, and <DATA> addresses it, like ...

code:

#!Perl -w
use strict;
use warnings;
print <DATA>;
exit(0);
__END__
This is the text to output ..
it can be anything
even with blank lines ...

Or to load the contents into a variable ...

#!Perl -w
use strict;
use warnings;
my $info = do { local $/; <DATA> }; # load it into a variable ...
print $info;
exit(0);
__END__
This is the text to output ..
it can be anything
even with blank lines ...

output: from both ...

This is the text to output ..
it can be anything
even with blank lines ...

So it can be used to say put HELP text, and thus is out of the way ... neat ...

top -|- index -|- samples


time

Perl have several built in functions to handle 'time'. That is seconds since system epoch (Midnight, January 1, 1970 GMT on Unix). There is also a package to handle high resolution timing.

Simple 'time':

This is a simple example, using local time -

code:

#!/perl -w
my $tm = time();
my @timeData = localtime($tm);
print "$tm\n";
print join(' ', @timeData);
print "\n";
my $ct = get_date_time();
print "$ct\n";
sub get_date_time {  
   my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);  
   my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);  
   my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek,
       $dayOfYear, $daylightSavings) = localtime(time());
   my $year = 1900 + $yearOffset;
   my $theTime = "$hour:$minute:$second";
   my $theDate = "$weekDays[$dayOfWeek] $months[$month] $dayOfMonth, $year";  
   return "$theTime, $theDate";
}

output:

1185726385
25 26 18 29 6 107 0 209 1
18:26:25, Sun Jul 29, 2007

The first is the seconds since epoch. The array is in the following order -

and finally a human readable time. A bigger example :-

code:

#!/perl -w
# NAME: gentime.pl
# AIM: Just a simple example showing the use of 'localtime' builtin function.
# 27/11/2008 Added 'gmtime', to get UTC/GMT time of a file.
# 29/07/2007 - geoff mclane - http://geoffair.net/mperl/index.htm
use strict;
use warnings;
use Time::gmtime;
### use Time::gmtime qw(:FIELDS); then $tm_hour, etc, can be used.
use File::stat;
my $tm = time();
my @timeData = localtime($tm);
print "$tm (seconds since system epoch - Midnight, January 1, 1970 GMT on Unix)\n";
print join(' ', @timeData); 
print " (Array of values)\n";
my $ct = get_date_time();
print "$ct - human readable form\n";
my $dt = get_YYYYMMDD_hhmmss($tm);
print "short $dt - alterative form\n";
my $ftm = stat($0)->mtime;
my $date_string = gmctime($ftm);
my $fdt = get_YYYYMMDD_hhmmss($ftm);
my $fdtu = get_YYYYMMDD_hhmmss_UTC($ftm);
print "$0 - $date_string, or\nlocal [$fdt], or\nUTC   [$fdtu]\n";
sub get_date_time {
   my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
   my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
   my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset,
      $dayOfWeek, $dayOfYear, $daylightSavings) = localtime(time());
   my $year = 1900 + $yearOffset;
   my $theTime = "$hour:$minute:$second";
   my $theDate = "$weekDays[$dayOfWeek] $months[$month] $dayOfMonth, $year";
   return "$theTime, $theDate"; 
}
sub get_YYYYMMDD_hhmmss {
    my ($t) = shift;
    my @f = (localtime($t))[0..5];
    my $m = sprintf( "%04d/%02d/%02d %02d:%02d:%02d",
        $f[5] + 1900, $f[4] +1, $f[3], $f[2], $f[1], $f[0]);
    return $m;
}
sub get_YYYYMMDD_hhmmss_UTC {
    my ($t) = shift;
    # sec, min, hour, mday, mon, year, wday, yday, and isdst.
    my $tm = gmtime($t);
    my $m = sprintf( "%04d/%02d/%02d %02d:%02d:%02d",
        $tm->year() + 1900, $tm->mon() + 1, $tm->mday(), $tm->hour(), $tm->min(), $tm->sec());
    return $m;
}
# eof - gentime.pl

output:

1227792043 (seconds since system epoch - Midnight, January 1, 1970 GMT on Unix)
43 20 14 27 10 108 4 331 0 (Array of values)
14:20:43, Thu Nov 27, 2008 - human readable form
short 2008/11/27 14:20:43 - alterative form
gentime.pl - Thu Nov 27 13:18:32 2008, or
local [2008/11/27 14:18:32], or
UTC   [2008/11/27 13:18:32]

top -|- index -|- samples


High Resolution Timing

The following is an example using the high resolution timing module:

code:

#!perl -w
# NAME: timing.pl
# AIM: Test high resolution timing
# 17/12/2008 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use Time::HiRes qw(gettimeofday tv_interval);       # provide more accurate timings
my @begin = gettimeofday();
my $cnt = 0;
sub bump_cnt {
    my ($c) = shift;
    $$c++;
}
sub run_test {
    my ($max) = shift;
    for (my $i = 0; $i < $max; $i++) {
        bump_cnt( \$cnt );
    }
}
run_test( 1000000 );
my @end = gettimeofday();
my $interval = tv_interval( \@begin, \@end );
print "$cnt iterations: Ran for $interval seconds ...\n";
# eof - timing.pl

output:

1000000 iterations: Ran for 0.796875 seconds ...

Note that the function tv_interval(...) takes a REFERENCE to an array, so the gettimeofday() function can be written as shown above, or used to directly generate a 'reference', using spare brackets, like -

my $begin = [ gettimeofday ];

There are also several other function related to this high resolution timer. See http://perldoc.perl.org/Time/HiRes.html for details.

top -|- index -|- samples


quotemeta (encode).

There are many meaning to 'encode' something, and quotemeta is a function that adds an escape character, '\' before every non-word character. It is very easy to get confused in the use of this 'escape' character. The first item, $root_dir, uses the double escape '\\', to add one '\' character, so the string in $root_dir only contains single '\' characters. But if this is used in a substitution string, like s/$root_dir// say, then perl again sees an escape character, and will complain about the character following it, so it has to be double escaped ... like ...

code:

my $root_dir = "C:\\FG\\20";
my $quoted = quotemeta($root_dir);
my $fixed = $quoted;
$fixed =~ s/\\:/:/;
print "root [$root_dir] became [$quoted] and [$fixed] ...\n";

output:

root [C:\FG\20] became [C\:\\FG\\20] and [C:\\FG\\20] ...

My main reason to use this and the fix for the escaped colon, is to be able to use the results in a substitution ...

An interesting regular expression using such double quoting would be -

my $PATH_PATTERN='(\\w|/|\\.)+';
my $INCLUDE_PATTERN = "^include[ \t]+((\\\$\\\(top_srcdir\\\)/${PATH_PATTERN})|(\\\$\\\(srcdir\\\)/${PATH_PATTERN})|([^/\\\$]${PATH_PATTERN}))[ \t]*(#.*)?\$";
if ($line =~ /$INCLUDE_PATTERN/) {
    my $path = $1;
    # ...
}

This is to find things like 'include $(top_srcdir)/test', and the like ...

top -|- index -|- samples


Errors - Perl has four error reports

Perl has four (4) special variables it uses to report errors: $!, $?, $@, and $^E. Each reports different sorts of error. See say http://www252.pair.com/comdog/mastering_perl/Chapters/12.error_handling.html, and other sites, for more information  ...

Operating System Errors - $!
The simplest errors occur when Perl asks the system to do something, but the system can't or doesn't do it for some reason. In most cases the Perl built-in returns false and sets $! with the error message. If you try to read a file that isn't there, open returns false and puts the reason it failed in $!, like :-

code:

#!/perl
open my( $fh ), '<', 'does_not_exist.txt'  
    or die "Couldn't open file! $!";

output:

Couldn't open file! No such file or directory at <script_name>.pl line 2.
Child Process Errors - $?
In the case of a sub-processes that a script starts, Perl uses $? to let you see the child process exit status. This is a little difficult to provide a simple sample, so none is provided.
Exception Errors - $@
Perl does not really have 'exception' handling, but if an error occurs in a block of code, it will stop that block of code, and put the error in $@. Here is a rough, simple example :-

code:

#!/perl
eval {
open my( $fh ), '<', 'does_not_exist.txt' or die "Couldn't open file! $!";
    };
if( $@ ) {
    print "Got an error ...$@\n"; # catch die message and handle it
}

output:

Got an error ... Couldn't open file! No such file or directory at <script_name>.pl line 3.
Operating System Specific Errors - $^E
In Windows, this is essentially the error message from GetLastError(). On VMS, OS/2, Windows, or MacPerl, you may get extra information than the form $!, but is probably not implemented in all systems. In this simple case, you can see it is essentially the same message :-

code:

#!/perl
open my( $fh ), '<', 'does_not_exist.txt' or die "Couldn't open file! $^E!";

output:

Couldn't open file! The system cannot find the file specified! at <script_name>.pl line 2.

Note, in all cases the error report includes the line number of the script.

top -|- index -|- samples


 

print - output some information ...

'print' is probably the most used function. It outputs strings, to the console, but by default it will be buffered until a 'line ending' is encountered, or the buffer is full ... so -

code:

my $msg = 'Hello, World!';
print "$msg\n";

output:

Hello, World!

Note the '\n' adds a line ending, and this will be flushed to output, otherwise the output will be buffered. To avoid buffering, set the special variable to true, like $| = 1;, then each 'print' will be immediately flushed, whether there is a line ending or not ....

top -|- index -|- samples


opendir, readdir, closedir - scan files in a directory...

'opendir', 'readdir' and 'closedir' are very cool functions to get a complete directory content... so -

code:

#!/perl -w
# NAME: opendir01.pl
# AIM: Open a directory, and get a file list with a specific extension
use strict;
use warnings;
my $in_folder = "C:\\FG\\27\\terragear-cs\\projects\\msvc";
sub prt($) {
   print shift;
}
sub get_files($) {
   my ($ind) = shift;
   my @dsp_files = ();
   my $cnt = 0;
   if (opendir( DIR, $ind )) {
      my @files = readdir(DIR);
      closedir DIR;
      foreach my $file (@files) {
         next if (($file eq ".") || ($file eq ".."));
         my $ff = $ind."\\".$file;
         if ( -d $ff ) {
            # what to do with sub-directories
         } else {
            if ((length($file) > 4) && (substr($file,-4) =~ /\.dsp/i)) {
               $cnt++;
               prt( "File $cnt: $file\n" );
               push(@dsp_files, $ff);
            }
         }
      }
   } else {
      prt( "ERROR: Unable to open directory [$ind]...\n" );
   }
   return @dsp_files;
}
prt( "$0 ... Processing $in_folder...\n" );
my @file_list = get_files( $in_folder );
exit(0);
# eof - opendir01.pl

output:

opendir01.pl ... Processing C:\FG\27\terragear-cs\projects\msvc...
File 1: airspace.dsp
File 2: dbfadd.dsp
... in my case through to ...
File 67: vpf-topology.dsp
File 68: wgs84offset.dsp

But note you do have to skip dot and double dot, that is '.' and '..' ;=)) And you could be recursive into sub-directories found by calling itself...

top -|- index -|- samples


HEREDOC

The so called 'heredoc' is a way to include MULTIPLE lines of text, preformatted.

code:

#!/usr/bin/perl -w
use strict;
use warnings;
my $text = <<"END_OF_TEXT";
Line 1
 line 2
  line 3
END_OF_TEXT
print "$text";

output:

Line 1
  line 2
   line 3

top -|- index -|- samples


eval EXPR

eval is a powerful beast! Essentially it runs the EXPR as a program in its own context. The following is an example of setting a Debug variable on, given just the numeric value of the variable...

code:

#!/usr/bin/perl -w
# 2010-07-07 - Example of setting a generated variable to a value using 'eval'
use strict;
use warnings;
my $dbg_v40 = 0;    # change this to 1
sub set_debug_item($) {
    my ($value) = shift;
    my $var = '$dbg_v'.$value;  # create desired variable name
    my $string = "$var".' = 1'; # create a program to set it
    eval $string;               # run the program
}
if ($dbg_v40) { print "Variable dbg_v40 is ON\n";
} else { print "Variable dbg_v40 is OFF\n"; }
set_debug_item(40); # set the variable
if ($dbg_v40) { print "Variable dbg_v40 is now ON\n";
} else { print "Variable dbg_v40 remains OFF\n"; }

output:

Variable dbg_v40 is OFF
Variable dbg_v40 is now ON

top -|- index -|- samples


strict - compiler declaration

During the compile, this declaration inhibits some perl table manipulation, and the output below shows the type of error message, if a problem is detected. Likewise 'warnings' and 'diagnostics' tell the compiler to offer a warning when it finds a problem.

code:

#!/usr/bin/perl
use strict; use warnings; use diagnostics;

output:

Can't use string (") as a SCALAR ref while "strict refs" in use at temp.pl
        line 19 (#1)
    (F) Only hard references are allowed by "strict refs".  Symbolic
    references are disallowed.  See perlref.

And it can be temporarily 'turned off' in say a particular function, as follows -

code:

 no strict 'refs'; # allow symbol table manipulation

For example...

code:

foreach (@symbols) {
    no strict 'refs'; # allow symbol table manipulation
    $typ .= "scalar " if (defined ${$_});
    $typ .= "array  " if (defined @{$_});

or

my @TTColors = qw(match orange regex green peach blue white grey);
for $name (@TTColors) {
   no strict 'refs'; # allow symbol table manipulation
   *$name = *{uc $name} = sub { "<TT class='$name'>@_</TT>" };
}

 For SURE, I normally place this declaration, plus at least the 'warnings' at the beginning of just about EVERY script I write. It has saved my bacon many, MANY times ;=))

top -|- index -|- samples


File Test Operators

Files test operators

-r -w -x  File is readable/writable/executable by effective uid/gid.
-R -W -X File is readable/writable/executable by real uid/gid.
-o -O File is owned by effective/real uid.
-e -z File exists/has zero size.
-s File exists and has non-zero size. Returns the size.
-f -d File is a plain file/a directory.
-l -S -p File is a symbolic link/a socket/a named pipe (FIFO).
-b -c File is a block/character special file.
-u -g -k File has setuid/setgid/sticky bit set.
-t Tests if filehandle (STDIN by default) is opened to a tty.
-T -B File is a text/non-text (binary) file. -T and -B return true on a null file, or a file at EOF when testing a filehandle.
-M -A -C File modification / access / inode-change time. Measured in days. Value returned reflects the file age at the time the script started. See also $^T in the section Special Variables.

top -|- index -|- samples


Special Variables

This is a list of special variables

The following variables are global and should be localized in subroutines:
$_ The default input and pattern-searching space.
$. The current input line number of the last filehandle that was read.
$/ The input record separator, newline by default. May be multicharacter.
$, The output field separator for the print operator.
$" The separator that joins elements of arrays interpolated in strings.
$\ The output record separator for the print operator.
$# The output format for printed numbers. Deprecated.
$* Set to 1 to do multiline matching within strings. Deprecated, see the m and s modifiers in section Search and Replace Functions.
$? The status returned by the last `...` command, pipe close or system operator.
$] The perl version number, e.g., 5.001.
$[ The index of the first element in an array, and of the first character in a substring. Default is 0. Deprecated.
$; The subscript separator for multidimensional array emulation. Default is "\034".
$! If used in a numeric context, yields the current value of errno. If used in a string context, yields the corresponding error string.
$@ The Perl error message from the last eval or do EXPR command.
$: The set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format.
$0 The name of the file containing the Perl script being executed. May be assigned to.
$$ The process ID of the currently executing Perl program. Altered (in the child process) by fork.
$< The real user ID of this process.
$> The effective user ID of this process.
$( The real group ID of this process.
$) The effective group ID of this process.
$^A The accumulator for formline and write operations.
$^D The debug flags as passed to perl using -D.
$^F The highest system file descriptor, ordinarily 2.
$^I In-place edit extension as passed to Perl using -i.
$^L Formfeed character used in formats.
$^P Internal debugging flag.
$^T The time (as delivered by time) when the program started. This value is used by the file test operators -M, -A and -C.
$^W The value of the -w option as passed to Perl.
$^X The name by which the currently executing program was invoked.
 
The following variables are context dependent and need not be localized:
$% The current page number of the currently selected output channel.
$= The page length of the current output channel. Default is 60 lines.
$- The number of lines remaining on the page.
$~ The name of the current report format.
$^ The name of the current top-of-page format.
$| If set to nonzero, forces a flush after every write or print on the currently selected output channel. Default is 0.
$ARGV The name of the current file when reading from <>.
 
The following variables are always local to the current block:
$& The string matched by the last successful pattern match.
$` The string preceding what was matched by the last successful match.
$' The string following what was matched by the last successful match.
$+ The last bracket matched by the last search pattern.
$1...$9...   Contain the subpatterns from the corresponding sets of parentheses in the last pattern successfully matched. $10... and up are only available if the match contained that many subpatterns.

top -|- index -|- samples


blank

Just a blank

code:

#!/usr/bin/perl
print "Just a blank\n";

output:

Just a blank

top -|- index -|- samples


References:

Another Perl reference: http://www.csci.csusb.edu/dick/samples/perl.html ...
Reference for Hash and Hash References:
 http://www.cs.mcgill.ca/~abatko/computers/programming/perl/howto/hash/ ...
Some words about XML: http://perl-xml.sourceforge.net/faq/ ...

Download

This is nothing more than a zip of my personal perl scripts -

link date size MD5
perl-05.zip 2009-06-24 3,116,040 15d87416fddcb8092db47eafaf20e38f
perl-01.zip 29/10/2008 1,653,344 d4d062a128c7ed9d24f9d30dadd4df1f

Each of these is also represented in samples

top -|- index -|- samples


internal alphabetic list: A B C D E F G H I J K L M N O P Q R S T U V W X Y Z

A: absolute path, address-of, and(&=), array, associative array,
B: basename,
C: chomp, chr, classes, closedir, conversion, CPAN, cwd,
D: delete, dereferencing, die, Dumper,
E: else, elsif, __END__, encode, Errors, eval, exit,
F: file test fileparse, flush, function,
G: gethostbyaddr, gethostbyname, goto,
H: hash, hash references, heredoc, hex, hires time,
I: if, index, installation-of-module - windows | unix
J: join,
K:
L: local, localtime,
M: multidimensional scalar array, my, module-installation - windows | unix
N:
O: opendir, operators, or(|=), ord, our,
P: package, parameters, pop, ppm, print, __PACKAGE__,
Q: quotemeta, qw,
R: readdir, ref, reference, regular expressions, require, rindex,
S: scalar array, scope, shift, shift(<<|>>), sort, special variables, split, splitpath, stat, strict, sub, subref, substr,
T: time, trim, typeof,
U: unicode, unless, unlink, unshift, unzip,
V:
W:
X: x (string repeat operator), xml
Y:
Z:

top -|- index -|- samples

checked by tidy  Valid HTML 4.01 Transitional


top -|- index -|- samples

EOF - perl_ref.htm