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.
'if (...) cmd;' does not work. Use 'if (...) {cmd;}' instead. The same applies to loops.
Functions either return scalars or lists. They cannot return hashes. Instead return the reference to a hash: “return \%hash;”. The hash entries can then be directly accessed via “some_func()->{$key}”. Another example is sub test { return [1,2]; } ; print ${test()}[1]."\n";.
For doing crazy things like storing hashes in arrays look at “man perldsc”.
A complete perl documentation is available via ‘man perl’.
IMHO the most important perl documentation parts are perlfunc, the perl function reference, and perlop, both accessible from within any shell via the ‘man’ command.
If you need to replace an installed library by a patched one, you may use use lib somepath;.
It is generally a good idea to use the preamble
use strict;
use warnings;
use Data::Dumper;
print Dumper \$some_struct;
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…).`
Math::BigInt package.$SIG{CHLD}='DEFAULT'; to solve that problem. The -1 exit code indicates that the child has been terminated before perl was even able to set up a handler for the CHLD signal…Read the alarm doc page carefully! If the alarm handler goes off, commands like “print” may get interrupted without setting a corresponding return code…
~ $ 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] ) {...}
$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'
#!/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";
}
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]
@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++ ) {
}
}
$#some_array denotes the index of the last element
@array is the reference to the array. Try to print it!
Access to the array’s elements is done via $array[$integer]. Note the difference in the usage of $ and @!
Be aware of the following behaviour:
@a = ("a");
$ref = \@a;
print $ref->[0]; # prints out "a"
@a = ("b");
print $ref->[0]; # prints out "b" !!
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
]
};
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_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"}}
push(@arr,\%hash);
print $arr[0]{"key"};
foreach my $h (@arr) {
my %h = %{$h};
...
}
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>;”.
# 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
open FILE, "> filename";
print FILE "some text\n"; # no comma!
...
close FILE;
opendir DIR, "/home/my";
while($de = readdir DIR) {
if($de ne "." && $de ne "..") {
...
}
}
closedir DIR;
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.
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”.
$code = "1a3b";
my $codei = sprintf oct "0x$code";
$c = chr($codei);
...
Devel::LeakTrace::Fast#!/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
$dbh->{HandleError} = sub {LOGCONFESS shift;}; to log sql problems.))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;
}
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.
$ perl -e 'use Time::Piece; print gmtime()->strftime.$/;'
Fr, 17 Dez 2010 09:44:56 UTC
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
# 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;
print Devel::StackTrace->new()->as_string();
See: http://www.perlmonks.org/?node_id=640319
Or “perldoc -f caller”.
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”).
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!
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 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>
# /-- 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 = '%;$';
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
# 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
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;
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};'
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…
=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);
}
}
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' );
#!/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.
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
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 { ... }";
}
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...
}
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