Perl

From Omnia
Jump to navigation Jump to search

Perl Programming

See Perl Programming

READ

service:

Signals:

Hello World

#!/usr/bin/perl
print "Hello World\n";

References

Documentation

Perl functions A-Z - perldoc.perl.org - http://perldoc.perl.org/index-functions.html

One Liners

upper.sh:

echo $1 | perl -lane 'print " cp $_ " . uc ($_)' | sh

Variables

Scalars

$myvar = 1;
$myvar = "abc";

print $myvar;

Lists

Lists or arrays

my @mylist = ();
@mylist = ( 1, 2, 3 );
@mylist = ( "a", "b", "c" );

print @mylist;  # returns count
print "@mylist";  # prints list separated by spaces

Hash Variables

my %myhash = ();
%myhash = ("key1", "value1", "key2", "value2");
%myhash = ("key1" => "value1", "key2" => "value2");
$myhash{"key1"} = "value1";  # notice sigil
delete %myhash{"key1");

See #Hashes

Lexical Variables

my $x;

Note: Lexical variables (we'll see why later) or private variables because they're private. They're also sometimes called my variables because they're always declared with my. It's tempting to call them `local variables', because their effect is confined to a small part of the program, but don't do that, because people might think you're talking about Perl's local operator, which we'll see later. When you want a `local variable', think my, not local. [1]

Local

local $x;

This does not do what you think it does. See http://perl.plover.com/FAQs/Namespaces.html

Why have local at all? The answer is 90% history. Early versions of Perl only had global variables.

Function parameters

sub myfunc {
  my ( $var1, $var2, @leftover ) = @_;
}

Logic

if

Number Compare:

# NUMERIC COMPARATORS: == != < > <= >=
if (5 == 5) { print "== for numeric values\n"; }
if (5 >= 4) { print ">= for numeric values\n"; }

String Compare:

# STRING COMPARATORS: eq ne gt ge lt le
if ('moe' eq 'moe') { print "eq (EQual) for string values\n"; } 
if ('B' ge 'A') { print "ge (Greater-than Equal-to) for string values\n"; } 

Logical:

# LOGICAL COMPARATORS: && || !
# LOGICAL COMPARATORS: and or not
if (($number <= 10) && ($number > 0)) { ...}

Else:

if(...) { ... } else { ... }
if(...) { ... } elsif(...) { ... } else { ... }   # notice "elsif"

Unless: (opposite of if)

unless ($gas_money == 10) { ... }

Switch/Case:

  • There is no switch/case statement in perl

Sigils

Type Character Example Is a name for:
Scalar $ $cents An individual value (number or string)
Array @ @large A list of values, keyed by number
Hash % %interest A group of values, keyed by string
Subroutine & &how A callable chunk of Perl code
Typeglob * *struck Everything named struck

Quote and Quote-like Operators

from 'man perlop':

       While we usually think of quotes as literal values, in Perl they func-
       tion as operators, providing various kinds of interpolating and pattern
       matching capabilities.  Perl provides customary quote characters for
       these behaviors, but also provides a way for you to choose your quote
       character for any of them.  In the following table, a "{}" represents
       any pair of delimiters you choose.

           Customary  Generic        Meaning        Interpolates
               ’’       q{}          Literal             no
               ""      qq{}          Literal             yes
               ‘‘      qx{}          Command             yes*
                       qw{}         Word list            no
               //       m{}       Pattern match          yes*
                       qr{}          Pattern             yes*
                        s{}{}      Substitution          yes*
                       tr{}{}    Transliteration         no (but see below)
               <<EOF                 here-doc            yes*

               * unless the delimiter is ’’.

Constants

use constant BUFFER_SIZE    => 4096;
use constant PI             => 4 * atan2 1, 1;
use constant { MAX_SIZE => 5 , MIN_SIZE => 1 };

Loops

for

for($i=0;$i<100;$i++) {...}
for(;;) {...}  # infinite loop
for $i (0..10) { ... }

foreach

# 'foreach' is an alias of 'for'
foreach my $item (@items) { print $item; }
for my $item (@items) { print $item; }
foreach (@items) { print $_; }
for $i ($low..$high) { ... } # count from $low to $high

while

while ($i<100) {...}

next

# the 'next' keyword will continue to the next loop (similar to continue in C)
[SOME_LOOP] { if(...){ next; } }
[SOME_LOOP] { next if /^#/; }
[SOME_LOOP] { next if $filename =~ /^FTP_RULES.txt$/; }

last

# the 'last' keyword will exit the loop (similar to break in C)
[SOME_LOOP] { last if /^#/; }
[LOOP] { last if($line eq "end\n");

redo

# repeats the last loop
[SOME_LOOP] { redo if /^#/; }

labels

# tell next/last/redo to jump to specific loop level:
[SOME_LOOP] {
OUTER:
  while() {
     ...
     next OUTER if (...)
  }
}

Range Operator

for(1..100) { print; } # 1 to 100
foreach(1..100) { print; }
foreach $i (1..100) { print $i; }
foreach(A..Z) { print; }
@a = (1 .. 100);
@a = (1 .. $i);  # using variable

String Manipulation

String Length

$len = length( $str );

Concatenation

$foo = "one" . "two";
$foo .= "three";

Chomp

# removes trailing new line
chomp;  # operates on $_
chomp($line);

Remove white space

$str =~ s/^\s+//;  # remove leading whitespace
$str =~ s/\s+$//;  # remove trailing whitespace

Regular expression

if( $mystring =~ /hello/ ) {...}
if( $mystring =~ /$matchstring/ ) {...}
if( /hello/ ) {...}  # operated on $_
$mystring =~ m/this(.*)test/;  # $1 is set to match of (.*)
$str =~ m/.*?test/  # ? after .* forces non greedy mode (which minimally matches)

Substitution

s/fred/barney/g;  # substitution on $_
s/^\s+//;  # substitution on $_
$line =~ s/one/two/;

Substring

# substr EXPR,OFFSET,LENGTH,REPLACEMENT
# substr EXPR,OFFSET,LENGTH
# substr EXPR,OFFSET
substr $s, 4, 1  # 5th character (zero based)

Split

($item1, $item2) = split(" ", "$line);
@array = ( $string =~ m/../g );  # split every 2 characters

Join

# ('$"' holds default split character, which is the space)
$str = join( " ", @ARGV );
print join( $", @ARGV );  # equivalent
print "@ARGV";            # equivalent

Character Replacement

tr[a-z][A-Z];  # replace characters on $_
$line =~ tr[a-z][A-Z];  # converts lower case to upper case
$count = ( $line =~ tr[A-Z][a-z] );  # convert to lower case, and count matches

"Here" Document

print <<EOF;
Hello World.
EOF
print <<EOF;   # evaluates like ""
print <<"EOF"; # evaluates like ""
print <<'EOF'; # evaluates like 
print <<`EOF`; # executes commands

key value pair

Extract KEY=VALUE pair:

if( ($k,$v) = $string =~ m/(\w+)=(\w*)/ ) {
  print "KEY $k  VALUE $v\n";
}

Quote Constructs

Quote Constructs
Generic form allows you to choose quote character
Customary Generic Meaning Interpolates
q// Literal string No
"" qq// Literal string Yes
`` qx// Command execution Yes
() qw// Word list No
// m// Pattern match Yes
s/// s/// Pattern substitution Yes
y/// tr/// Character translation No
"" qr// Regular expression Yes

Lists and Arrays

Note: Single dimension arrays are called "lists". Lists can have multiple repeated items.

Create list/array:

@foo = ();
@foo = ("one", "two", "three");
@foo = (1, 2, 1);

List to Scalars:

( $first, $second, $third ) = @mylist;
( $first, $second, @all_others ) = @mylist;
$last_update_time = (stat($filename))[9];
($atime, $mtime) = (stat ($file) )[8,9];

Test for empty array:

if (@a) { # @a is not empty...
if (@ary != 0) { # @a is not empty...
Note: never be tempted to use defined on an array (or a hash for that matter). Simply testing the value of the @array in a scalar context is sufficient. The defined function makes little sense on any data type other than a $scalar. [2]

Count of items in list:

$count = $#foo + 1;  # Index of last element ($#foo = -1 on empty)
$count = @food; # implicitly force @foo into scalar context
print @food + 0; # implicitly force @foo into scalar context
$count = scalar(@food); # explicitly force @foo into scalar context

Append to array:

@foo = ( @foo, "four", "five");

Quoted Word array:

@myarray = qw/ 1 2 3 4 5 6 7 /;
@myarray = qw( 1 2 3 4 5 6 7 );

Dereference value (zero based):

print $foo[0];  # first item
print $foo[1];
print $foo[$#foo];  # last item, using index of last item

Remove item from list: [3]

delete $a[$index];  # removes an element by index number
my $index = 0;
while ($index <= $#items ) {
  my $value = $items[$index];
  print "testing $value\n";
  if ( $value == 1 or $value == 3 ) {
    print "removed value $value\n";
    splice @items, $index, 1;
  } else {
    $index++;
  }
}
@mylist = ('hello', 'world');
$remove_item = 'hello';
# cycle backwards to avoid missing an item
for( $i = $#mylist ; $i >= 0 ; $i-- ) {
  if( $remove_item eq $mylist[$i] ) {
    delete $mylist[$i];
}

Multidimensional Array:

$foo[0][0] = "e00";
$foo[0][1] = "e01";
$foo[1][0] = "e10";
$foo[1][1] = "e11";
$foo[1][2] = "e12";
@foo = (
  ['e00', 'e01' ],
  ['e10', 'e11', 'e12' ],
);

Loop through Multidimensional Array:

foreach $items (@foo) {
  foreach $item (@$items) {
    print $item . "\n";
  }
}

for my $i (0..$#foo) {
   for my $j (0..$#{$foo[$i]}) {        
      print "\$i = $i, \$j = $j, $foo[$i][$j]\n";
   }
}

Passed to a funciton:

my @my_list = @_;
my ( $item1, $item2, $item3, $all_others ) = @_;

Check if item in list:

$findme = 'test';
foreach $item in (@foo) {
  if( $item eq $findme ) ...;
}
my $element = 'Whatever you are searching for' ;
if (grep {$_ eq $element} @TheArray) {
 print "Element '$element' found!\n" ;
}

push/pop/shift/unshift:

@a = (1, 2, 3);

$newcount = push(@a, $item);  # append $item to end of list
$right_item = pop(@a);  # remove item from end of list

$newcount = unshift(@a, $item);  # add item to left
$left_item = shift(@a);  # remove one item from left

delete $a[$index];  # removes an element by index number

sleep

To sleep for [n] seconds

sleep [n];

Sleep less than a second:

# Sleep for 250 milliseconds
select(undef, undef, undef, 0.25);

Using usleep: [4]

use strict;
use warnings;

use Time::HiRes qw(usleep nanosleep);

# 1 millisecond == 1000 microseconds
usleep(1000);
# 1 microsecond == 1000 nanoseconds
nanosleep(1000000);

Hashes

NOTE: Pay close attention to the sigils

Create hash:

%foo = {};  # empty hash

Create hash from list:

%foo = ();       # empty list
%foo = @mylist;  # list of key, value pairs
%foo = ("key1", "value1", "key2", "value2");
%foo = ("key1" => "value1", "key2" => "value2");

Edit hash: (notice sigil)

$foo{"key1"} = "value1";  # by string
$foo{key1} = "value1";    # by bare word
$foo{$key} = "value1";    # by variable

Delete entry:

delete $foo{$key);

Dereference hash:

print $foo{"key1"}; # by string
print $foo{key1};   # by bare word
print $foo{$key};   # by variable
print %foo->{"key1"};  # using reference form

Get list of keys:

@keys = keys( %hash );

Hash count:

$count = scalar( keys( %hash ) );

Iterating through hash:

# sorted by keys
foreach $key (sort keys %foo) { print $foo{$key}; }

# potentially unsorted by keys
for $key ( keys %foo ) { ... }

# sorted by values
foreach $key ( sort { $foo{$a} cmp $foo{$b} } keys %foo) { print "$key $coins{$key}"; }

Sorting using custom sort methods:

sub hashValueAscendingNum {
   $grades{$a} <=> $grades{$b};
}
sub hashValueDescendingNum {
   $grades{$b} <=> $grades{$a};
}
print "\nGRADES IN ASCENDING NUMERIC ORDER:\n";
foreach $key (sort hashValueAscendingNum (keys(%grades))) {
   print "\t$grades{$key} \t\t $key\n";
}
print "\nGRADES IN DESCENDING NUMERIC ORDER:\n";
foreach $key (sort hashValueDescendingNum (keys(%grades))) {
   print "\t$grades{$key} \t\t $key\n";
}
@sorted = sort { $a <=> $b } @not_sorted # numerical sort
@sorted = sort { $a cmp $b } @not_sorted # ASCII-betical sort
@sorted = sort { lc($a) cmp lc($b) } @not_sorted # alphabetical sort

Get a list of hash keys sorted by value:

@sorted = sort { $hash{$a} cmp $hash{$b} } keys %hash;

Get a reverse sort of a list:

@sorted = sort { $b cmp $a } @list; 
# or
@sorted = reverse sort { $a cmp $b } @list;

Passing to function:

%first = ( one => "a" , two => "b", -three => "c" );
passhash( %first );
passhash( one => "a" , two => "b", -three => "c" );
sub passhash {
  (%items) = @_;
  for $key ( sort keys %items ) {
    print $key . " => " . $items{$key} . "\n";
  }
}

Files

File Modes

File Modes
mode operand create truncate
read <
write >
append >>

Note: Each of the above modes can also be prefixed with the + character to allow for simultaneous reading and writing.

Open and Read Files

Open format:

# open FILEHANDLE, MODE, EXPR

Open file:

# for input
open(MYFILE, $filename) or die "Can't open $filename: $!\n";
# for output
open MYFILE, ">", $filename or die "Can't open $filename: $!\n";
open MYFILE, ">filename" or die "Can't open $filename: $!\n";
# for append
open MYFILE, ">>", $filename or die "Can't open $filename: $!\n";

Note: $! contains the error message, if there is an error.

Read file lines:

while ($line = <MYFILE>) { ... }
foreach $line (<MYFILE>) {
  chomp $line;
  print $line . "\n";
}
@lines = <MYFILE>;

Read STDIN: (Diamond operator)

foreach my $line (<>) { ...}
foreach my $line (<STDIN>) { ...}

Write STDOUT:

print STDOUT "Hello World\n";

Write STDERR:

print STDERR "Hello World\n";

Write to file handle:

print MYFILE "Hello World\n";

Close file:

close(MYFILE);

Read a line and chomp:

chomp($line = <STDIN>);

Read one character at a time in "binary mode":

# read FILEHANDLE, SCALAR, LENGTH
# read FILEHANDLE, SCALAR, LENGTH, OFFSET
open FILE, "picture.jpg" or die $!;
binmode FILE;
my ($buf, $data, $n);
while (($n = read FILE, $data, 4) != 0) {
  print "$n bytes read\n";
  $buf .= $data; 
}
close(FILE);

Redirect STDOUT and STDERR

Saves, redirects, and restores STDOUT and STDERR:

#!/usr/bin/perl
open SAVEOUT, ">&STDOUT";
open SAVEERR, ">&STDERR";

open STDOUT, ">foo.out" or die "Can't redirect stdout";
open STDERR, ">&STDOUT" or die "Can't dup stdout";

select STDERR; $| = 1;  # enable autoflush, make unbuffered
select STDOUT; $| = 1;  # enable autoflush, make unbuffered

print STDOUT "stdout 1\n";  # these I/O streams propogate to
print STDERR "stderr 1\n";  # subprocesses too

system("echo 'hi'");  # uses new stdout/stderr

close STDOUT;
close STDERR;

open STDOUT, ">&SAVEOUT";
open STDERR, ">&SAVEERR";

print STDOUT "stdout 2\n";
print STDERR "stderr 2\n";

Similar Source: http://perldoc.perl.org/functions/open.html

See: perldoc -f open


Using IO:Handle:

use IO::Handle;

open INPUT,  '<', "input.txt"  or die $!;
open OUTPUT, '>', "output.txt" or die $!;
open ERROR,  '>', "error.txt"  or die $!;

 STDIN->fdopen( \*INPUT,  'r' ) or die $!;
STDOUT->fdopen( \*OUTPUT, 'w' ) or die $!;
STDERR->fdopen( \*ERROR,  'w' ) or die $!;

# prints to output.txt:
print "Hello Output File\n";

# reads everything from input.txt and prints it to output.txt:
print <>;

# prints to error.txt:
warn "Hello Error File\n";

Source: http://www.perlmonks.org/?node_id=11007

Tee STDOUT

Using external 'tee' program:

open (STDOUT, "| tee -ai log.txt");
print "blah blah"
close (STDOUT);

Source: http://www.unix.com/shell-programming-scripting/41812-perl-print-log-file-screen.html


Using File::Tee: (not included with base)

use File::Tee qw(tee);

# simple usage:
tee(STDOUT, '>', 'stdout.txt');

print "hello world\n";
system "ls";

# advanced usage:
my $pid = tee STDERR, { prefix => "err[$$]: ", reopen => 'my.log'};

print STDERR "foo\n";
system("cat /bad/path");
tee STDOUT, '>> /tmp/out', '>> /tmp/out2';
tee STDOUT, '>>', '/tmp/out', '/tmp/out2';

Source: http://search.cpan.org/~salva/File-Tee-0.06/lib/File/Tee.pm


Using IO:Tee: (not icnluded with base)

use IO::Tee;
$tee = IO::Tee->new(">> debuglog.txt", \*STDOUT);
print $tee "an error occurred on ".scalar(localtime)."\n";

Source: http://www.perlcircus.org/files.shtml


Using Tee for commands:

# from Perl
use Tee;
tee( $command, @files );
 
# from the command line
$ cat README.txt | ptee COPY.txt

Source: http://search.cpan.org/~dagolden/Tee-0.13/lib/Tee.pod


Ugly Windows Solution: (Based on http://www.xav.com/perl/lib/Pod/perlfork.html)

my $parent = 'CHILDPIPE';

open SAVEOUT, ">&STDOUT";
open SAVEERR, ">&STDERR";

pipe $parent, my $child or die;

$pid = fork();

print "PID: $pid \n";

if( $pid == 0 ) {
  print "CHILD: $pid\n";

  close($parent);
  open(STDOUT, ">&=" . fileno($child)) or die;
  open(STDERR, ">&=" . fileno($child)) or die;

  system( "adir" );

  open STDOUT, ">&SAVEOUT";
  open STDERR, ">&SAVEERR";
  exit 0;
} else {
  print "PARENT: $pid\n";
  open LOG, ">", "c:\\log.txt";
  
  close($child);
  while( $line = <KID> ) {
    print SAVEOUT "P: $line\n";
    print LOG "P: $line\n";
    #sleep 1;
  }
  print LOG "hi\n";
  close LOG;
  open STDOUT, ">&SAVEOUT";
  print "test\n";
  print SAVEOUT "P: $line\n";
  print SAVEOUT "PARENT END\n";
  print STDERR "PARENT END\n";
  print SAVEOUT "out\n"; 
  close $parent;
  exit 2;
}

File System

Perl Functions for filehandles, files, or directories

Delete Files:

unlink('delete-me.txt') or die "Could not delete the file!\n";

Move/Rename Files:

rename oldname, newname

File Functions:

chmod - changes the permissions on a list of files
chown - change the owership on a list of files
link - create a hard link in the filesytem 
rename - change a filename 
rmdir - remove a directory
symlink - create a symbolic link to a file 
truncate - shorten a file
unlink - remove one link to a file 

Check if file exists:

if( -e $filename ) ...

File Checks:

-e  File exists
-z  File exists, has a size of zero
-s  File exists, has non-zero size
-r  Readable
-w  Writable
-x  Executable
-T  text File
-B  binary File

Functions and Parameters

Calling a function

MyFunc $arg1, $arg2;
MyFunc($arg1, $arg2);

Function parameters:

sub MyFunc {
  ($arg1, $arg2, @argremaining) = @_;
}
sub MyFunc {
  $arg1 = shift;
  $arg2 = shift;
}

Application parameters are stored in @ARGV:

$pcount = @ARGV;
foreach $arg (@ARGV) { ... }

To get the process ID of the current perl program:

 print $$;

Command Line Parameters

Contains a list of parameters:

@ARVG

Parameter count:

$pcount = @ARGV;

Print first parameter:

print $ARGV[0];

Cycle through parameters:

foreach $ARG (@ARGV) { ... }

Cycle through text lines of parameters:

$pcount = @ARGV;
print "$pcount params: @ARGV\n";
while(<>) {
  print $ARGV . " - " . $_;
}

Math

Integer

Convert decimal number to integer:

$myint = int( $decimal );

Increment

Incremental and Decremental

$a++;
$a--;

Logical Operators

And  &&
Or   ||
Not  !
Xor  xor

Comparison

Num   String
==    eq
!=    ne
<     lt
>     gt
<=    le
>=    ge
<=>   cmp

Short Circuit Operation

$a && $b
$a and $b
$a || $b
$a or $b
open(FILE, "somefile") || die "Can't open somefile: $!\n";
logic operators return last value to assignment (careful with 'and' and 'or' due to precedence below '=')
 $value = $a || $b;
 $value = ($a or $b);  # parenthesis required due to 'or' having lower precedence to '=');

Random

# number between 0 and 1
my $random_number = rand();
# number between 0 and 100 (not including 100)
my $range = 100;
my $random_number = rand($range);
# random integer between 0 and 100 (not including 100)
my $range = 100;
my $random_number = int(rand($range));
# with offset
my $range = 50;
my $minimum = 100;
my $random_number = int(rand($range)) + $minimum;

Documentation See:

perldoc -f rand

Source: http://perlmeme.org/howtos/perlfunc/rand_function.html

time

time - Returns the number of non-leap seconds since whatever time the system considers to be the epoch

$now = time();
$first = time();
sleep(10);
$second = time();
print $first - $second;

Formatting:

# "Wed Apr 20 13:07:21 2011"
$STRING = localtime( time() );
$STRING = localtime($EPOCH_SECONDS);
use POSIX qw(strftime);
$STRING = strftime($FORMAT, $SECONDS, $MINUTES, $HOUR, $DAY_OF_MONTH, $MONTH, $YEAR, $WEEKDAY, $YEARDAY, $DST);
use Date::Manip qw(UnixDate); $STRING = UnixDate($DATE, $FORMAT);

struct

#!/usr/bin/perl

# see Perl 5.8 Documentation - Class::Struct - declare struct-like datatypes as Perl classes
# http://perl.active-venture.com/lib/Class/Struct.html
use Class::Struct;

struct structtemplate => {
	x => '$',
	y => '$'
};

@mylist = ();

for( $i = 0 ; $i < 10 ; $i++ ) {
	$obj = structtemplate->new();
    $obj->x($i);
    $obj->y('y'.$i);
	@mylist[$i]=$obj; 
}

# compact modify
@mylist[3]->x(8);
print @mylist[3]->x;

# verbose grab and modify item
$item = @mylist[3];
print $item->x;
$item->x(5);

# check modification
$item = @mylist[3];
print $item->x;

System Calls

Call program and get exit code:

# perldoc -f system
$exit = system("vi $file");
# return code is also stored in '$?'
# error message stored in '$!'

To capture the output from a command use merely backticks or "qx//", as described in "‘STRING‘" in perlop.

Call program and get string output:

$output = `$COMMAND`;
$output = qx/$COMMAND/;  # Lines stored in string
@output = `cat /etc/passwd`;  # Multiple lines stored in list
# exit code in $?

Switch to new program: (unless command fails)

# perldoc -f exec
exec( $COMMAND ) or print STDERR "couldn’t exec $COMMAND: $!";

Output one line at a time:

sub backtick(@)
{
    my $pid = open(KID, '-|');
    die "fork: $!" unless defined($pid);
    if ($pid) {
        my $output;
        while (<KID>) {
            print STDOUT $_;
            $output .= $_; # could be improved...
        }
        close(KID);
        return $output;
    } else {
        exec @_;
    }
}

my @cmd = ('/bin/ls', '-l');
my $output = backtick(@cmd);

Source: http://stackoverflow.com/questions/634508/how-can-i-send-perl-output-to-a-both-stdout-and-a-variable

Command Line

Test code syntax:

perl -c [file.pl]

Execute one liner code:

perl -e '...'

Wrap code:

#  while (<>){ ... }
cat [file] | perl -n -e '...'

# while (<>){ ... } print
cat [file] | perl -p -e '...'

Perl IDE

Perl Editor, Perl IDE - http://perlide.org/

Perl IDE and editor polls
  • Padre - The Perl Application Development and Refactoring Environment (written in Perl 5)
  • Eclipse - with the EPIC plugin or with Perlipse using dltk
  • ActiveState - proprietary Komodo IDE or free Komodo Edit
  • Kephra - Programmers Editor along perl-like Paradigms, written in Perl
  • Gvim - with Perl support
  • Emacs - with CPerl Mode

Perl IDE - http://www.softpanorama.org/Scripting/Perlorama/perl_programming_environment.shtml

Great tools will not make a bad programmer into a good programmer, but they will certainly make a good programmer better and they can make bad language acceptable (Java is one such example).

A good, modern IDE should at least have the following features:

  • A syntax-coloring text editor with language-specific help, pretty printing and macro language support (SlickEdit is one example of a very good programming editor, but it costs quit a lot).
  • Integrated syntax-checking (Komodo and SlickEdit has one)
  • Version control integration (Subversion, etc).
  • Access to library of templates, fragments, etc ("code-assist" infrastructure)
  • Access to symbol table or at least good XREF support. Perl has basic XREF generation capabilities via special module Xref, for example: perl -MO=Xref[,OPTIONS] scriptname.pl
  • A tree view of source files and resources.
  • Built-in debugger or integration with a good debugger (Komodo has a usable built-in debugger)

One possible "poor man IDE" is VIM. Vim has:

Epic Eclipse Perl Integration

EPIC - Eclipse Perl Integration - http://www.epic-ide.org/

EPIC is an open source Perl IDE (including editor and debugger) based on the Eclipse platform, compatible with Windows, Linux and Mac OS X. Whether you are into CGI scripting or full-fledged Perl projects with hundreds of modules, EPIC is the most feature-rich and extensible free Perl IDE available today, thanks to a seamless integration with all the major features and GUI conventions of Eclipse.

EPIC - How To Install - http://www.epic-ide.org/download.php

EPIC - User's Guide - http://www.epic-ide.org/guide/index.php

Other components Needed:

  • Install PadWalker for debugger:
    • perl -MCPAN -e "install PadWalker"

Padre

Padre, the Perl IDE - http://padre.perlide.org/

Padre is a Perl IDE, an integrated development environment, or in other words a text editor that is simple to use for new Perl programmers but also supports large multi-lingual and multi-technology projects.
Our primary focus is to create a peerless environment for learning Perl and creating Perl scripts, modules and distributions, with an extensible plug-in system to support the addition of related functionality and languages and to support advanced developers taking the editor anywhere they want it to go.

Open Perl IDE

Open Perl IDE - http://open-perl-ide.sourceforge.net/ Open Perl IDE | Download Open Perl IDE software for free at SourceForge.net - http://sourceforge.net/projects/open-perl-ide/

Open Perl IDE is an integrated development environment for writing and debugging Perl scripts with any standard perl distribution under Windows 95/98/NT/2000.

Install CPAN module

See CPAN

Test for module: [5]

perl -e 'use IO::Uncompress::Gunzip; print "OK\n";'
perldoc -l IO::Uncompress::Gunzip

Installation:

# debian
apt-get install libnet-snmp-perl

# redhat
yum install while (<>){ ... }

# perl method
perl -MCPAN -e 'install Net::SNMP'

note: package manager is usually preferred

Perl Slogan

"There's More Than One Way To Do It"
TMTOWTDI

Shebang Notation

#!/usr/bin/perl

Help

man perl
man perl[topic]
man perldata
man perfaq1
perldoc -f [function]

References

Array References:

@ary = ("one", "two", "three");
$aryref = \@ary;   # reference to array
print $aryref->[0];  # dereference array element
print ${$aryref}[0];  # dereference array element
@ary2 = @{$aryref};  # dereference whole array
foreach $ent ( @{$aryref} ) {...};  # dereference whole array
print ref($aryref);  # display reference type

Packages

Declare a name space:

# MySpace.pm in folder MyWorld/
package MyWorld::MySpace;
sub hello() { ... }

To use:

use MyWorld::MySpace;
MyWorld::MySpace::hello();

Note: A name space will continue until another package is declared or the end of file is reached.

To export default functions:

package MyWorld::MySpace;
our $VERSION = '1.00';
use base 'Exporter';      # allow for default functions to be exported
our @EXPORT = qw(hello);  # default functions to export
sub hello() { ... }

include

Perl's equivalents of "include" are use, require and do. [6]

Perl Monks - Including files http://www.perlmonks.org/?node_id=393426

modules

Classes

package Person;

sub new {
  my $self = {};
  $self->{NAME} = undef;
  bless($self);
  return $self;
}

sub name {
  my $self = shift;
  if (@_) { $self->{NAME} = shift }
  return $self->{NAME};
}

1;  # modules have to return any true value

Another form of new (with arguments):

my($class, %args) = @_;
my $self = bless({}, $class);
return $self;

Usage:

use Person;

$person = Person->new();
print $person->name("test");

Data Dumper

The standard Data::Dumper module is very useful for examining exactly what is contained in your data structure (be it hash, array, or object (when we come to them) ). When you use this module, it exports one function, named Dumper. This function takes a reference to a data structure and returns a nicely formatted description of what that structure contains.
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;

my @foo = (5..10);
#add one element to the end of the array
#do you see the error?
$foo[@foo+1] = 'last';

print Dumper(\@foo);

When run, this program shows you exactly what is inside @foo:

$VAR1 = [
          5,
          6,
          7,
          8,
          9,
          10,
          undef,
          'last'
        ];

Source: Programming in Perl - Debugging

__DATA__

__DATA__ &

   Perl uses the __DATA__ marker as a pseudo-datafile. You can use this marker to write quick tests which would involve finding a file name, opening that file, and reading from that file. If you just want to test a piece of code that requires a file to be read (but don't want to test the actual file opening and reading), place the data that would be in the input file under the __DATA__ marker. You can then read from this pseudo-file using , without bothering to open an actual file:
#!/usr/bin/env perl
use strict;
use warnings;

while (my $line = <DATA>) {
  chomp $line;
  print "Size of line $.:  ", length $line, "\n";
}

__DATA__
hello world

The $. variable keeps track of the line numbers of the file currently being processed via a while (<$fh>) { ... } loop. More explicitly, it is the number of the last line read of the last file read.

Source: Programming in Perl - Debugging

__FILE__ and __LINE__

These are two special markers that return, respectively, the name of the file Perl is currently executing, and the Line number where it resides. These can be used in your own debugging statements, to remind yourself where your outputs were in the source code:

print "On line " . __LINE__ . " of file " . __FILE__ . ", \$foo = $foo\n";
       

Note that neither of these markers are variables, so they cannot be interpolated in a double-quoted string


Source: Programming in Perl - Debugging

References

TODO

User input

$age = <>;

sleep

 sleep [seconds]

Getopts

Getopt::Long - perldoc.perl.org - http://perldoc.perl.org/Getopt/Long.html

use Getopt::Long;
use Getopt::Long;
my $data = "file.dat";
my $length = 24;
my $verbose;
$result = GetOptions ("length=i" => \$length, # numeric
                      "file=s" => \$data, # string
                      "verbose" => \$verbose); # flag

To get the remaining arguments, check @ARGV

Ping

use Net::Ping;
my $host = [IP OR ADDRESS];
$p = Net::Ping->new("icmp");
print "$host is down " unless $p->ping($host, 2);
$p->close();

$p->hires();
($ret, $duration, $ip) = $p->ping($host, 5.5);
printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
  if $ret;
$p->close();

http://perldoc.perl.org/Net/Ping.html

unsort lines

unsort.pl:

#!/usr/bin/perl -w

# @(#) randomize Effectively _unsort_ a text file into random order.
# 96.02.26 / drl.
# Based on Programming Perl, p 245, "Selecting random element ..."

# Set the random seed, PP, p 188
srand(time|$$);

# Suck in everything in the file.
@a = <>;

# Get random lines, write 'em out, mark 'em done.
while ( @a ) {
  $choice = splice(@a, rand @a, 1);
  print $choice;
}

source: http://www.linuxforums.org/forum/programming-scripting/59111-how-do-you-randomly-shuffle-lines-text-file.html

Windows Administration

mkdir

mkdir [FILENAME],[MASK]
mkdir [FILENAME]
mkdir $dir or die "Error: $!";

Source: http://perldoc.perl.org/functions/mkdir.html

Get MAC Address

# source: http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_20850500.html
$output = `ipconfig /ALL`;
if( $output =~ m/((?:[0-9A-F-]{2}-?){6})/i ) {
  print "Found Mac address: $1\n";
}

IO Buffering

Suffering from Buffering? - http://perl.plover.com/FAQs/Buffering.html

how to make the filehandle hot:

my $ofh = select LOG;
$| = 1;
select $ofh;

The key item here is the $| variable. If you set it to a true value, it makes the current filehandle hot. What's the current filehandle? It's the one last selected with the select operator. So to make LOG hot, we `select' it, set $| to a true value, and then we re-`select' whatever filehandle was selected before we selected LOG.

Compact version:

select((select(LOG), $|=1)[0]);

If you happen to be using the FileHandle or IO modules, there's a nicer way to write this:

use FileHandle;          # Or `IO::Handle' or `IO::'-anything-else
LOG->autoflush(1);       # Make LOG hot.


Recipe 7.12. Flushing Output - http://docstore.mik.ua/orelly/perl/cookbook/ch07_13.htm

Disable buffering by setting the per-filehandle variable $| to a true value, customarily 1 :

$old_fh = select(OUTPUT_HANDLE); $| = 1; select($old_fh);

Or, if you don't mind the expense, disable it by calling the autoflush method from the IO modules:

use IO::Handle; OUTPUT_HANDLE->autoflush(1);

INET Socket

IO::Socket::INET - perldoc.perl.org - http://perldoc.perl.org/IO/Socket/INET.html

Client

Server

$sock = IO::Socket::INET->new('127.0.0.1:25');

Multiplexing

Multiplexing filehandles with select() in perl - http://www.perlfect.com/articles/select.shtml

Multiplexing without threads

# Multiplexed Socket

use IO::Socket;
use IO::Select;

STDOUT->autoflush(1);

my $sock = new IO::Socket::INET (
       LocalHost => 'localhost',
       LocalPort => '7070',
       Proto => 'tcp',
       Listen => 1,
       Reuse => 1,
       );
die "Could not create socket: $!\n" unless $sock;

$sel = new IO::Select();
$sel->add($sock);

while(1) {

  # check for ready handle
  my ($rhlist) = IO::Select->select($sel, undef, undef, 0);

  # cycle through ready handles, if any
  foreach $rh ( @$rhlist ) {
    if ( $rh == $sock ) {
      # handle new connection
      $ns = $rh->accept();
      $sel->add($ns);
      print "-new-";
    } else {
      # handle existing connections
      $buf = <$rh>;
      if($buf) {
        # print buffer
        print "[$buf]";
      } else {
        # handle closed connections
        $sel->remove($rh);
        close($rh);
        print "-close-";
      }
    }
  }

  print ".";
  # yeld for 1 second
  IO::Select->select(undef, undef, undef, 1);
}

close($sock);

Select

"The idea behind select() is to avoid blocking calls by making sure that a call will not block before attempting it. How do we do that? Suppose we have two filehandles, and we want to read data from them as it comes in. Let's call them A and B. Now, let's assume that A has no input pending yet, but B is ready to respond to a read() call. If we know this bit of information, we can try readin from B first, instead of A, knowing that our call will not block. select() gives us this bit of information. All we need to do is to define sets of filehandles (one for reading, one for writing and one for errors) and ask call select() on them which will return a filehandle which is ready to perform the operation for which it has been delegated (depending on which set it is in) as soon as such a filhandle is ready." [7]

Perl, Sockets and TCP/IP Networking

Perl, Sockets and TCP/IP Networking. - http://www.perlfect.com/articles/sockets.shtml

Multiplexing filehandles with select() in perl. - http://www.perlfect.com/articles/select.shtml

Client

use IO::Socket;
my $sock = new IO::Socket::INET (
    PeerAddr => 'localhost',
    PeerPort => '7070',
    Proto => 'tcp',
    );
die "Could not create socket: $!\n" unless $sock;
print $sock "Hello there!\n";
close($sock);

Server

The first thing we need to do is to create a socket. We will use it to receive connections. The code below shows how to create a receiving socket. Note that we need to specify the local hostname and the port to which the socket will be bound. Of course, if the port is already in use this call will fail. Also note the 'Listen' parameter: this is the maximum number of connections that can be queued by the socket waiting for you to accept and process them. For the time being we will only accept a maximum of one connection at any time. (This means that a connection attempt while we're dealing with another connection, will return with an error like 'connection refused') Finally the 'Reuse' option tells the system to allow reuse of the port after the program exits. This is to ensure that if our program exits abnormally and does not properly close the socket, running it again will allow opening a new socket on the same port.

use IO::Socket;
my $sock = new IO::Socket::INET ( 
       LocalHost => 'localhost',
       LocalPort => '7070',
       Proto => 'tcp',
       Listen => 1,
       Reuse => 1,
       );
die "Could not create socket: $!\n" unless $sock;

my $new_sock = $sock->accept();
while(<$new_sock>) {
  print $_;
}
close($sock);

Kenneth's Echo Server

#!/usr/bin/perl

use IO::Socket;
my $sock = new IO::Socket::INET ( 
       #LocalHost => 'localhost',
       LocalPort => '7070',
       Proto => 'tcp',
       Listen => 1,
       Reuse => 1,
       );
die "Could not create socket: $!\n" unless $sock;

while (1) {
  my $new_sock = $sock->accept();
  print "New Connection: " . $new_sock->peerhost() . "\n";
  $new_sock->send("Hi " . $new_sock->peerhost() . "\r\n");
  while(<$new_sock>) {
    print "CLIENT: " . $_;
    $_ =~ s/(.*)\r\n/$1/;
    $new_sock->send("SERVER: [ $_ ]\r\n");
    if($_ =~ /quit/) {
    	close($new_sock);
    }
  }
}
close($sock);

threads

threads - perldoc.perl.org - http://perldoc.perl.org/threads.html

perlthrtut - tutorial on threads in Perl - http://www.xav.com/perl/lib/Pod/perlthrtut.html

CPAN

See CPAN

Regular Expression

See: Regular Expression

rxrx - Regexp::Debugger

Install:

cpan Regexp::Debugger

Usage:

rxrx
perl -MRegexp::Debugger -E 'Regexp::Debugger::rxrx(@ARGV)'

To set the regex:

/[SOMETHING]/

To set the string:

'[SOMETHING]'

To match:

m

To quit:

q

Commands:

     / : Enter a pattern
     ' : Enter a new literal string
     " : Enter a new double-quoted string
     m : Match current string against current pattern
q or x : quit debugger and exit
     h : help

Match Commands:

      - : back step
[enter] : forward step
      c : proceed visually quickly to the end

Warning: Arrow keys do not appear to work!

---

/usr/local/bin/rxrx

#! /usr/bin/env perl
use Regexp::Debugger;
Regexp::Debugger::rxrx(@ARGV);

__END__

=head1 NAME

rxrx - command-line REPL and wrapper for Regexp::Debugger

=head1 DESCRIPTION

See the documentation of L<Regexp::Debugger>.

=cut

keywords

linux perl