leponceau.org

Programming And Stuff, You Know The Thing…

A Practical Perl Guide

Posted at — Mar 19, 2010

What is this?

What is Perl good for?

Mainly: system administration tasks like parsing files etc. IMHO (and in many others' opinions) it fills the gap between tasks that can be done on the command line by some shell interpreter like BASH and tasks that require to create whole applications. Of course, you can pretty well use Perl for larger projects, but you’ll also need to actually master Perl for that purpose pretty well. And mastering Perl is IMHO a much heavier task than to use C++ or even Java in a sane way.

General Notes

in all of your perl scripts. It eliminates many spelling errors and other basic problems. The [Data::Dumper](Data::Dumper) module may be used to analyze what you have at hand, ie. what ‘$some_struct’ contains (which can also be an array or a hash or…).`

Pitfalls

alarm-Handler and I/O etc.

Read the alarm doc page carefully! If the alarm handler goes off, commands like “print” may get interrupted without setting a corresponding return code…

Arrays and Lists in Scalar Context

 ~ $ perl -e 'sub a {(0,10);} if(a()) {print "OK".$/} else {print "NOT OK".$/}'
OK
 ~ $ perl -e 'sub a {(10,0);} if(a()) {print "OK".$/} else {print "NOT OK".$/}'
NOT OK
 ~ $ perl -e 'sub a {(10,10);} if(a()) {print "OK".$/} else {print "NOT OK".$/}'
OK

 ~ $ perl -e 'if(0,1) {print "OK".$/} else {print "NOT OK".$/}'
OK
 ~ $ perl -e 'if(1,) {print "OK".$/} else {print "NOT OK".$/}'
OK
 ~ $ perl -e 'if(1,0) {print "OK".$/} else {print "NOT OK".$/}'
NOT OK
 ~ $ perl -e 'if(1,1) {print "OK".$/} else {print "NOT OK".$/}'
OK

 ~ $ perl -e 'if(qw(1 0)) {print "OK".$/} else {print "NOT OK".$/}'
NOT OK

## BUT!!!
 ~ $ perl -e '@a=(1,0); if(@a) {print "OK".$/} else {print "NOT OK".$/}'
OK
~ $ perl -e 'sub a {@a=(10,0);@a;} if(a()) {print "OK".$/} else {print "NOT OK".$/}'
OK

 ~ $ perl -e 'sub a {$a=wantarray ? "arr":"scalar";print $a.$/;} if(a()) {}'
scalar
 ~ $ perl -e 'sub a {$a=wantarray ? "arr":"scalar";print $a.$/;} if(@_=a()) {}'
arr
 # ARRAY = LIST
 @a      = (1,2,0);

 $a[0]   == (1,2,0)[0]

 3 == scalar @a != scalar (1,2,0) == scalar 0 == 0

 scalar 1,2,0 == 1 != scalar (1,2,0) == scalar 0 == 0

 # ref LIST gives ARRAY of refs
 ( $a_ref, $b_ref ) = \( $a, $b );

 # useful:
 sub a { return @a; }
 if ( (a())[0] ) {...}

Debugging

Local Variables

$var = 0;
{
  $var = 1;
}
# '$var' is now set to 1
{
  my $var;
  $var = 2;
  print $var; # prints '2' to the console
}
print $var; # prints '1'

Using and Defining Functions

#!/usr/bin/perl
some_func("some_argument");
exit;
sub some_func {
  # restrict variables to local execution block (here: this function definition)
  my $some_var;
  # function arguments available as array '@_'
  print $_[0]."\n";
}

Complex Return Values

sub test {
  return [1,[2,3]];
}
sub test2 {
  return (1,[2,3]);
}
my ($a,$b) = test(); # will put [1,[2,3]] into $a, $b is undef
my ($a,$b) = test2(); # will put 1 into $a, [2,3] into $b.
# access the elements of [2,3]:
print ${$b}[1];
# access [2,3] as an array:
print join(",", @{$b});
# merge into one array: ($a and @a are treated as *different* variables!)
@a = ($a,@$b);
sub test3 {
  my @a=(1,2);
  my @b=(3,4);
  return (@a,@b);
}
my ($a,$b,$c,$d) = &test3(); # gives $a=1, $b=2, $b=3, ...
sub test4 {
  my @a=(1,2);
  my @b=(3,4);
  return (\@a,\@b);
}
my ($a,$b,$c,$d) = &test4(); # gives @$a=[1,2], @$b=[3,4], $b=undef, ...
push @$a, @$b; # gives @$a=[1,2,3,4]

Using Arrays

@some_array = (); # assign array with zero entries
# append '$some_value' to the array
push @some_array, $some_value;
# remove last element of array and store it in '$some_value'
$some_value = pop @array;
# print all array elements one by one
for ( $i = 0; $i <= $#some_array; $i++ ) { print $some_array[$i]."\n"; }
# print all -- the easy way
print join("\n", @some_array)."\n";
# create an array of words
@array = ("one", "two", "three");
@array = split(" ", "one two three"); # alternative solution
($one,$two,$three) = split(" ", "one two three");
my ($one,$two,$three) = split(" ", "one two three"); # same as 'my $one;...'
# looping over arrays of arrays
  for ( $i=0; $i<=$#codes; $i++ ) {
    for ( $j=0; $j<=$#{$codes[$i]}; $j++ ) {
    }
  }

so assigning a new list to an existing array variable does not (necessarily?) move the array location to a new memory position… which I personally consider a very nasty because very counter-intuitive behaviour.`

More:

use Data::Dumper;
%h = ();
$h{a}=[(1,2,3),4];
print Dumper \%h;
print scalar @{$h{a}};
print "\n";
$h{a}=[7,@{$h{a}}];
print Dumper \%h;
$VAR1 = {
          'a' => [
                   1,
                   2,
                   3,
                   4
                 ]
        };
4
$VAR1 = {
          'a' => [
                   7,
                   1,
                   2,
                   3,
                   4
                 ]
        };

Using Hashes

One of Perl’s greatest features (IMHO) is the easy access to hashes, thereby allowing a programmer to implement quite fast processing routines in nearly no time!

undef %hash; # 'initialize' hash (make sure it is empty)
$hash{$key} = $data; # store '$data' so we may access it later by its '$key'
# 'keys %hash' gives you an array of all keys
# print a comma-separated list of all keys in the hash:
print join(",", keys %hash);
# loop over all keys existing in the hash:
foreach $key (keys %hash) {
  print $key."\n";
}
# number of keys in a hash
print keys(%hash);
# delete entry
delete $hash{'some key value'};

If your keys are not unique, then you’ll have to decide on how to construct buckets. In the following example ‘$data’ is assumed to be a text string whose values we will separate within a bucket by using a comma:

undef %hash;
if(!defined($hash{$key})) {
  $hash{$key} = $data;
} else {
  $hash{$key} .= ",".$data;
}

Nested Hashes

$nested_hash{"a"}{"b"} = "some value";
# the key "a" refers to a hash with one single key, namely "b"
@keys_for_a = sort keys %{$nested_hash{"a"}}

Hashes Inside Arrays

push(@arr,\%hash);
print $arr[0]{"key"};
foreach my $h (@arr) {
  my %h = %{$h};
  ...
}

Operating on Files

Reading

open FILE, "< $filename";
while(<FILE>) { # reads a line and stores it in '$_'
  chomp; # remove new-line chars, same as 'chomp $_;'
         # do something nasty like printing it to the console...
  print $_."\n";
}
close FILE;

Let us enclose the file operation in a recursively called structure:

sub some_func {
  open FILE, "< $filename";
  while(<FILE>) { # reads a line and stores it in '$_'
    chomp; # remove new-line chars, same as 'chomp $_;'
    ...
    some_func();
  }
  close FILE;
}

That will mess up things considerably because recursively called instances will use the same file descriptor FILE. A correct solution would be:

sub some_func {
  my $file;
  open $file, "< $filename";
  while(<$file>) { # reads a line and stores it in '$_'
    chomp; # remove new-line chars, same as 'chomp $_;'
    ...
    some_func();
  }
  close $file;
}

See [“LinuxTools/Perl::IO::Socket::SSL”] for the fundamental difference between “print ($_=<$fh>);” and “print <$fh>;”.

Reading Program Output (Pipes)

# note the pipe symbol '|' at the end of the file argument
my $pid = open(FILE, "some_prog and maybe some arguments to it |") or die "failed to open pipe";
while ( <FILE> ) {
  ...
}
close FILE;
my $exitcode = $? >> 8; # exit code of program; set after closing the pipe

Writing to Files

open FILE, "> filename";
print FILE "some text\n"; # no comma!
...
close FILE;

Reading Directories

opendir DIR, "/home/my";
while($de = readdir DIR) {
  if($de ne "." && $de ne "..") {
    ...
  }
}
closedir DIR;

Displaying complex data structures

use Data::Dumper;
print Dumper \@datasets;

would give

$VAR1 = [
          {
            'request_id' => '1',
            'techauftrag_id' => '1'
          },
          {
            'request_id' => '2',
            'techauftrag_id' => '2'
          }
        ];

after filling the array with hashes.

Installing additional perl modules

There is a huge online repository of Perl modules, called CPAN. There is also a client called “cpan” that allows you to import modules from that repository. Just enter “cpan” on your console if it is installed.

There is also the possibility to install CPAN modules under your user account. See http://www.dcc.fc.up.pt/~pbrandao/aulas/0203/AR/modules_inst_cpan.html

Under Gentoo, you should consider g-cpan – it will create ebuilds for the CPAN packages. Running cpan as root under Gentoo will mess up your system “integrity”.

Parsing strings containing hexadecimal values

$code = "1a3b";
my $codei = sprintf oct "0x$code";
$c = chr($codei);
...

Regular Expressions

Profiling etc.

NYTProf Profiling Examples

#!/bin/bash
export PERL5LIB="./Devel-NYTProf-2.10/blib/lib:./Devel-NYTProf-2.10/blib/arch"
perl -d:NYTProf -e '$a=time();while(time()<$a+3){};'
./Devel-NYTProf-2.10/bin/nytprofhtml


#!/bin/bash
perl -e '
BEGIN {
    @INC = ( "./Devel-NYTProf-2.10/blib/lib", "./Devel-NYTProf-2.10/blib/arch", @INC );
}
$a=time();
while(time()<$a+3){};
'
export PERL5LIB="./Devel-NYTProf-2.10/blib/lib:./Devel-NYTProf-2.10/blib/arch"
./Devel-NYTProf-2.10/bin/nytprofhtml

Great Perl Modules

DBI

Stored Procedures and (DBD::)Sybase

sub exec_sp {
    my ( $sql ) = @_;
    my @arr = ();
    my $sth = $dbh->prepare ( $sql );
    $sth->execute;
    {
        while ( my $href = $sth->fetchrow_hashref ) {
            push @arr, $href;
        }
        redo if $sth->{syb_more_results}; # see "perldoc DBD::Sybase"
    }
    $sth->finish;
    return \@arr;
}

Using Time

use Time::Local;
$seconds = timegm(...);
$datestr = gmtime($seconds);
$seconds = timelocal(...);
$datestr = localtime($seconds);

See also http://www.aota.net/Script_Installation_Tips/perltime.php4.

You may want to avoid using functions like POSIX::mktime.

Full Time Format

$ perl -e 'use Time::Piece; print gmtime()->strftime.$/;'
Fr, 17 Dez 2010 09:44:56 UTC

Debian / Ubuntu

Some CPAN packages are missing in the Debian/Ubuntu archives. One may either use the cpan command line client to install them (but you won’t be able to uninstall them selectively afterwards in a nice fashion because it does not provive any remove command) or dh-make-perl as described here (get the tar archive from cpan.org, unpack it, run dh-make-perl inside it and there you have your deb package).

Update: the dh-make-perl tool may be used in an even more convenient manner:

# build the package for the Sys::SigAction perl module and install it using "dpkg"
dh-make-perl --install --cpan=Sys::SigAction
# build a problematic package like X::Osd for which tests tend to fail but which nonetheless works
dh-make-perl --install --cpan=X::Osd --notest

XML

Here-Documents

# solution derived from "Perl Kochbuch"
#!/usr/bin/perl
use strict;
use warnings;
sub dequote {
    my ( $str ) = @_;
    my $leading_ws = undef;
    my $a = $str;
    $a =~ s/^(\s*)/$leading_ws=(!defined($leading_ws)||length($1)<$leading_ws)?length($1):$leading_ws;/gme;
    $a = " " x $leading_ws;
    $str =~ s/^$a//gm;
    return $str;
}
print dequote <<EOF;
  test
    test
  test
EOF
print dequote <<EOF;
    test
  test
    test
EOF
exit 0;

Stack Trace

print Devel::StackTrace->new()->as_string();

See: http://www.perlmonks.org/?node_id=640319

Or “perldoc -f caller”.

fork() and pipe()

pipe() provides an easy way to let different processes communicate with each other, i.e. a parent process with it’s childs.

For more information and an example see section “Bidirectional Communication with Yourself” in perlipc (run “perldoc perlipc”).

Perl Installation in /home/???

wget -O - http://www.cpan.org/src/5.0/perl-5.12.3.tar.gz | tar xz

cd perl-5.12.3

# add  -A libpth=/usr/lib/x86_64-linux-gnu  to compile perl-5.12.3 on Ubuntu 11.04
./Configure -Dusethreads -Dinc_version_list=none -Dprefix=$HOME/${PWD##*-} -dse

make -j$(( 1 + $(grep -c ^proc /proc/cpuinfo) )) install

# add ~/bin to PATH (edit .bashrc)
# and update using cpanp to add readline support to cpanp, for example
$ cpanp
: i Term::ReadLine::Perl
: s conf prereqs 1; s save
: s selfupdate features
: s selfupdate all
: i Moose Time::HiRes Sys::SigAction DBD::mysql X::Osd
: i Config::Simple Config::Any Devel::NYTProf Exception::Class
: i Log::Dispatch Log::Log4perl XML::LibXML Data::ICal XML::TreePP
: i XML::XPath JSON JSON::XS Text::CSV DBD::CSV DateTime
: q
$ perl -V
Summary of my perl5 (revision 5 version 10 subversion 1) configuration:
  Platform:
    osname=linux, osvers=2.6.31-19-generic, archname=x86_64-linux-thread-multi
    uname='linux hp6730b 2.6.31-19-generic #56-ubuntu smp thu jan 28 02:39:34 utc 2010 x86_64 gnulinux '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.4.1', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
    libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.10.1.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.10.1'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector'
Characteristics of this binary (from libperl):
  Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV
                        PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP USE_64_BIT_ALL
                        USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES
                        USE_PERLIO USE_REENTRANT_API
  Built under linux
  Compiled at Mar  3 2010 15:58:23
  @INC:
    /home/perl/lib/5.10.1/x86_64-linux-thread-multi
    /home/perl/lib/5.10.1
    /home/perl/lib/site_perl/5.10.1/x86_64-linux-thread-multi
    /home/perl/lib/site_perl/5.10.1
    .
# now you can use #!/home/perl/bin/perl in your scripts!

Crazy Assignment Stuff

SWISH-PERL - Perl Interface to the SWISH-E Library
    use SWISHE;
    my $indexfilename1 = '/path/to/index1.swish';
    my $indexfilename2 = '/path/to/index2.swish';
    # To search for several indexes just put them together
    $indexfiles = "$indexfilename1 $indexfilename2";
    my $handle = SwishOpen( $indexfiles )
        or die "Failed to open '$indexfiles'";
    # Get a few headers from the index files
    my @headers = qw/WordCharacters BeginCharacters EndCharacters/;
    for ( @headers ) {
        my @h = SwishHeaderParameter( $handle, $_ );
        print "$_ for index 0 is $h[0]\n",
              "$_ for index 1 is $h[1]\n\n";
    }
    # Now search
    @standard = ('Rank', 'File Name', 'Title', 'Document Size');
    @props = qw/prop1 prop2 prop3/;
    $props = join ' ', @props;
    $sort  = 'prop1 asc prop2 desc';
    $query = 'meta1=metatest1';
    my $num_results = SwishSearch($handle, $query, 1, $props, $sort);
    if ( $num_results <= 0 ) {
        print ($num_results ? SwishErrorString( $handle ) : 'No Results');
        my $error = SwishError( $handle );
        print "\nError number: $error\n" if $error;
        return;  # or next.
    }
    my %results; # place to store the return values by name
    while(  @results{ @standard, @props } = SwishNext( $handle )) {
        print "\n";
        printf("%20s -> '%s'\n", $_, $results{$_}) for @standard, @props;
    }
    # No more queries on these indexes
    SwishClose( $handle );

Foreach: Labels and Last

foreach my $i ( 1,2,3 ) {
    foreach my $j ( 4,5,6 ) {
        print "$i - $j\n";
    }
}
1 - 4
1 - 5
1 - 6
2 - 4
2 - 5
2 - 6
3 - 4
3 - 5
3 - 6
OUTER_LOOP:
foreach my $i ( 1,2,3 ) {
    foreach my $j ( 4,5,6 ) {
        print "$i - $j\n";
        last OUTER_LOOP;
    }
}
1 - 4
foreach my $i ( 1,2,3 ) {
    foreach my $j ( 4,5,6 ) {
        print "$i - $j\n";
        last;
    }
}
1 - 4
2 - 4
3 - 4
foreach my $i ( 1,2,3 ) {
    foreach my $j ( 4,5,6 ) {
        last;
        print "$i - $j\n";
    }
}
<NO OUTPUT>

Prototypes

#     /-- required params
#     | /- optional params
#     v v
sub a(%;$) {
  print shift,"\n";
  print shift,"\n";
}
a(1,2,3,4);
use Data::Dumper;
print Dumper(prototype \&a);


1
2
$VAR1 = '%;$';

Function Call Context

sub a {
    if (wantarray) {
        print 'list context';
    } else {
        print 'scalar context';
    }
    print "\n";
    return 1;
}
$x = @{a()};
$x = @{(a())};
$x = (a());
$x =  1 + a();
$x = a() + 1;
$x = "a" + a();
$x = a() + "a";
($x) = scalar a();
@x = a() + 1;
($x) = a();
$x = [a()];
@x = a();
## RESULTS:
scalar context
scalar context
scalar context
scalar context
scalar context
scalar context
scalar context
scalar context
scalar context
list context
list context
list context

STDOUT/STDERR redirection

    # intercept DBI::Sybase output of "sp__helptext" which is sent to STDERR:
    #select STDERR; $| = 1;  # make unbuffered
    close STDERR or confess;
    open (STDERR, ">", \$src2) or confess;
    #select STDERR; $| = 1;  # make unbuffered
    #print STDERR "bla\n";
    my $ary_ref = $dbh->selectall_arrayref("sp__helptext $dspn");
    close STDERR or confess;
    open (STDERR, '>&', $olderr) or confess "Can't dup OLDERR: $!";
    #select STDERR; $| = 1;  # make unbuffered

temporary STDOUT redirection into variable

my $a='';
open BAK, '>&STDOUT' or die $!;
close STDOUT;
open STDOUT, '>', \$a or die $!;
print "test".$/;
close STDOUT;
open STDOUT, '>&BAK';
close BAK;
print STDOUT $a;

Shell Arguments Escape

Use quotemeta.

Resource Limits

use BSD::Resource;
setrlimit(RLIMIT_VMEM,$vmem_limit_mb*1024*1024,$vmem_limit_mb*1024*1024) or die;


## print out current values:
perl -e 'use Data::Dumper; use BSD::Resource; %a=%{get_rlimits()}; print Dumper {map { $t=$_; $t => scalar getrlimit($a{$t}) } keys %a};'

Daemonize

sub daemonize {
    chdir '/'               or die "Can't chdir to /: $!";
    open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
    open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
    defined(my $pid = fork) or die "Can't fork: $!";
    exit if $pid;
    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

Or just use some of the several Net::Server or SOAP::WSDL::Server implementations out there…

Change UID/GID

=head2
  see also http://www.cgisecurity.com/lib/sips.html for some explanation
  of $<, $>, $( and $)....
  ps -A -o pid,user,ruser,group,rgroup,cmd | grep mysmtpd
=cut
use English qw( -no_match_vars );
sub change_uid_and_gid {
    # change gid first... otherwise it may fail because we would have already lost
    # the privilege to do so...
    if ( my $gid = $c{'global.gid'} ) {
        if ( $gid !~ /^\d+$/ ) {
            my @res = getpwnam($gid) or LOGDIE("group name '$gid' unknown");
            $gid = $res[2];
        }
        if ( $gid =~ /^\d+$/ ) {
            my @res = getpwuid($gid) or LOGDIE("group id '$gid' unknown");
        } else {
            LOGDIE("bad gid '$gid'");
        }
        POSIX::setgid($gid);
        LOGDIE("failed to change real gid to $gid") if ($GID != $gid);
        LOGDIE("failed to change effective gid to $gid") if ($EGID != $gid);
    }
    if ( my $uid = $c{'global.uid'} ) {
        if ( $uid !~ /^\d+$/ ) {
            my @res = getpwnam($uid) or LOGDIE("user name '$uid' unknown");
            $uid = $res[2];
        }
        if ( $uid =~ /^\d+$/ ) {
            my @res = getpwuid($uid) or LOGDIE("user id '$uid' unknown");
        } else {
            LOGDIE("bad uid '$uid'");
        }
        POSIX::setuid($uid);
        LOGDIE("failed to change real uid to $uid") if ($UID != $uid);
        LOGDIE("failed to change effective uid to $uid") if ($EUID != $uid);
    }
}

Local Hash Elements

package pkg;
sub new {
    my ( $self, %opts ) = @_;
    $self = {
        %opts
    };
    bless $self, __PACKAGE__;
    return $self;
}
1;

#!/usr/bin/env perl
use pkg;
$p = new pkg (opt=>3);
use Data::Dumper;
print Dumper $p;
{
    local $p->{opt2};
    local $p->{opt2}->{asd} = 45;
    $p->{opt3} = 333;
    print Dumper $p;
}
print Dumper $p;
exit 0;

gives

$VAR1 = bless( {
                 'opt' => 3
               }, 'pkg' );
$VAR1 = bless( {
                 'opt3' => 333,
                 'opt' => 3,
                 'opt2' => {
                             'asd' => 45
                           }
               }, 'pkg' );
$VAR1 = bless( {
                 'opt3' => 333,
                 'opt' => 3
               }, 'pkg' );

but

#!/usr/bin/env perl
use pkg;
$p = new pkg (opt=>3);
use Data::Dumper;
print Dumper $p;
{
    local $p->{opt2} = 1;
    local $p->{opt2}->{asd} = 45;
    $p->{opt3} = 333;
    print Dumper $p;
}
print Dumper $p;
exit 0;

gives

$VAR1 = bless( {
                 'opt' => 3
               }, 'pkg' );
$VAR1 = bless( {
                 'opt3' => 333,
                 'opt' => 3,
                 'opt2' => 1
               }, 'pkg' );
$VAR1 = bless( {
                 'opt3' => 333,
                 'opt' => 3
               }, 'pkg' );

Local Hash Elements and Autovivification

#!/usr/bin/env perl
use pkg;
$p = new pkg (opt=>3);
use Data::Dumper;
print Dumper $p;
{
    local $p->{opt2}->{asd} = 45;
    $p->{opt3} = 333;
    print Dumper $p;
}
print Dumper $p;
exit 0;

gives

$VAR1 = bless( {
                 'opt' => 3
               }, 'pkg' );
$VAR1 = bless( {
                 'opt3' => 333,
                 'opt' => 3,
                 'opt2' => {
                             'asd' => 45
                           }
               }, 'pkg' );
$VAR1 = bless( {
                 'opt3' => 333,
                 'opt' => 3,
                 'opt2' => {}
               }, 'pkg' );

opt2 here gets autovivificated and is NOT localized.

create html docs from installed modules

cd
wget -O - http://www.cpan.org/src/5.0/perl-5.14.0.tar.gz | tar xz
rm -rf ~/h
cd /home/perl/5.14.0/lib
perl ~/perl-5.14.0/installhtml --splitpod /home/perl/perl-5.14.0/pod \
    --podroot=. --podpath=. --recurse \
    --htmldir=/home/perl/h \
    --htmlroot=/home/perl/h \
    --splithead=5.14.0/pod/perlipc --splititem=5.14.0/pod/perlfunc \
    --libpods=perlfunc:perlguts:perlvar:perlrun:perlop \
    --ignore=Porting/Maintainers.pm,Porting/pumpkin.pod,Porting/repository.pod \
    --verbose

C

Calling Perl Functions From C

Nested Named Subroutines And Closures

When inserting “use diagnostics;” into your perl code snippet, we get:

==> /var/log/apache2/error.log <==
Variable "$sth_last_ins_id" will not stay shared at
    /home/mywebdesk/htdocs/pl/histquote.pl line 31 (#1)
    (W closure) An inner (nested) named subroutine is referencing a
    lexical variable defined in an outer named subroutine.
    
    When the inner subroutine is called, it will see the value of
    the outer subroutine's variable as it was before and during the *first*
    call to the outer subroutine; in this case, after the first call to the
    outer subroutine is complete, the inner and outer subroutines will no
    longer share a common value for the variable.  In other words, the
    variable will no longer be shared.
    
    This problem can usually be solved by making the inner subroutine
    anonymous, using the sub {} syntax.  When inner anonymous subs that
    reference variables in outer subroutines are created, they
    are automatically rebound to the current values of such variables.
    
Subroutine get_last_ins_id redefined at /home/mywebdesk/htdocs/pl/histquote.pl
    line 30 (#2)
    (W redefine) You redefined a subroutine.  To suppress this warning, say
    
        {
        no warnings 'redefine';
        eval "sub name { ... }";
        }

Platform Compatibility

File Names

use File::Spec;
use File::Path;
use Cwd;

my @parts = File::Spec->splitdir(Cwd::getcwd());
my $root = File::Spec->catdir($parts[0]); # $root eq '/' on Linux, $parts[0] eq ''
pop @parts;
my $parent_dir_path = File::Spec->catdir(@parts);
if(! -d $parent_dir_path) {
    File::Path::mkpath($parent_dir_path); # makes not too much sense...
}

Threads

Use cpanp to unstall missing modules as user against system-wide perl installation

export USER_PERL_ROOT=~/perl_root
export PERL5LIB=$USER_PERL_ROOT/lib:$USER_PERL_ROOT/lib/site_perl
cpanp
> s conf makemakerflags PREFIX=~/perl_root ; s save ; quit
fakeroot cpanp -i Some::Module

Punycode

Net::IDN::Encode::domain_to_ascii()