Perl Tips and things to remember:
This file contains gems I discovered while learning perl and knew I'd lose
track of them unless I wrote them down. I review it from time to time to
refresh my memory and add new code gems as discovered.
# Help on perl
perldoc IO::File provides documentation on perl module IO::File
perldoc -q words searches the Frequently Asked Questions (FAQ) file
# Development aids
perl -c file.pl checks syntax on file.pl
perl -w -Mdiagnostics turns on warnings and detailed error messages for
diagnosing problems with code
# use underbars on long literal numbers
$val=65_535;
$pi=3.141_592_653_5;
# use {} to limit variable names
print "${var}suffix";
$y =~ /$foo[bar]/ # ambiguous
$y =~ /${foo}[bar]/ # substitute $foo and match an a,b or c
$y =~ /${foo[bar]}/ # substitute element of array: $foo[bar]
# a shorthand way to do a foreach on a single line.
foreach @tables { do_something };
grep { do_something, 0} @tables; # the zero will cause grep to return an empty array
# An alternate to join
local $" = "\n"; print "@x";
instead of print join("\n", @x);
# Array subsets/slices
@x[1,3..4] => ($x[1], $x[3], $x[4])
# when to use local and my
# use local to protect filehandles and $/ when slurping files
sub slurp {
my $f = shift;
{
local *F;
open(F, "<$f") or die "$f: $!";
my $contents;
{
local $/ = undef;
$contents = ;
} # $/ restored now
} # *F file closed now
return $contents
}
# use local when you use foreach to alias $_ or s/// to modify a string otherwise
if your function is called within a foreach loop you will clobber your callers array
i.e.
sub fix {
...
s/this/that/; # not safe if caller is looping an array
...
}
foreach (@array) { fix($_) } # will clobber @array
instead use
sub fix {
...
{ local $_;
s/this/that;
}
...
}
# use local to create a truly anonymous file handle
my $fh = do { local *FH };
# use local to define your own methods with syntax like sort { $a <=> $b } @list
# i.e. listjoin { $a + $b } @list1, @list2 -- returns an array which is the sum
# of each element of the two arrays.
sub listjoin(&\@\@) {
my ($code, $arr1, $arr2) = @_;
my @result;
while (@$arr1 && @$arr2) {
local $a = shift(@$arr1); # protect the global $a and $b
local $b = shift(@$arr2);
push(@result, &$code());
}
}
# printhash { "$a => $b\n"} %hash -- will print out keys and values of hash
sub printhash(&\%) {
my ($code, $hash) = @_;
local ($a, $b);
while (($a, $b) = each(%$hash)) {
print &$code();
}
}
# Using $` $' or $& sets a global variable sawampersand internally in perl and
# from there after all Regular Expression searches result in massive copying and
# thus are much slower. Avoid using $` $' and $&.
# Fortunately perl offers easy to use alternatives, that is
#
# instead of this you can use this
#
# $` of /pattern/ $1 of /(.*?)pattern/s
# $& of /pattern/ $1 of /(pattern)/
# $' of /pattern/ $+ of /pattern(.*)/s
# In general, apply `/^(.*)(pattern)(.*)$/s' and use $1 for $`, $2 for $&
# and $+ for $' ($+ is not dependent on the number of parens in the
# original pattern). Note that the `/s' switch can alter the meaning of
# `.' in your pattern.
# don't use lowercase barewords as may conflict with future reserved words
@days=(Mon,Tue,Wed) instead of @days=(mon,tue,wed)
use strict 'subs'; # limits use of barewords to prevent syntax errors
# double quoted string functions
\u \l force next character to upper/lower case
\U \L force all characters after to upper/lower case
\Q backslash all following non-alphanumeric characters
\E end \U \L or \Q
# character quoting in double quoted strings
\cC Control-C
# remove duplicate words in a string: paris in THE THE THE spring
# fails for the clothes you DON DON't fit
1 while s/\b(\w+) \1\b/$1/gi;
or s/ \b(\w+) \s (?= \1\b ) //gxi;
# custom quoting of strings
'' q// q() literal - no var interpolation
"" qq// qq() literal - with var interpolation
`` qx// qx() command - with var interpolation
() qw// qw() word list - no var interpolation
// m// m() pattern match - with var interpolation
s/// s/// s()[] substitution - with var interpolation
y/// tr/// tr()[] translation - no var interpolation
# here documents (heredoc)
$x = <<"" x 5; # use the next line only
This line is repeated five times
print <<'one', < function handles all these cases. It
expects to be called with a here document as its argument. It
looks to see whether each line begins with a common substring,
and if so, strips that off. Otherwise, it takes the amount of
leading white space found on the first line and removes that
much off each subsequent line.
sub dequote {
local $_ = shift;
my ($white, $leader); # common white space and common leading string
if (/^\s*(?:([^\w\s]+)(\s*).*\n)(?:\s*\1\2?.*\n)+$/) {
($white, $leader) = ($2, quotemeta($1));
} else {
($white, $leader) = (/^(\s+)/, '');
}
s/^\s*?$leader(?:$white)?//gm;
return $_;
}
print <<"EOF" =~ /^\s*\| ?(.*\n)/g;
| Attention criminal slacker, we have yet
| to receive payment for our legal services.
|
| Love and kisses
|
EOF
print < # matches all files in current directory
@files = glob($filemask);
while (<*.c>) { chmod0644, $_; }
readdir/grep will be faster than globbing because glob starts a subshell.
# get a list of all files ignoring . and ..
opendir THISDIR, "." or die "cant open dir";
@allfiles = grep !/^\.\.?$/, readdir THISDIR;
@allfiles = grep !/^\./, readdir THISDIR; # get all non-hidden files
@allfiles = grep -T, readdir THISDIR; # get list of all Text files
# use the find2perl method of finding files - symbolic links that are broken
find(\&wanted, 'dir1', 'dir2', ...);
sub wanted { -l and not -e and print "bogus link: $File::Find::name\n"}
($file) = ; # list context gets all matches
$file = ; # gets the next match and undef when no more matches
# not a good way to go if matching a single file
# alternate calls will return the file and 'false'
# regular expressions
m// and s/// modifiers
i case insensitive matching
m multiple line matching
s single line matching
x ignore whitespace unless backquoted - makes pattern more readable
(?#text) puts a comment in your regular expression
(?:...) like (...) but doesn't assign the match to $1..$9
(?=...) matches ... but doesn't include it in the matched string
(?!...) matches if ... is not present and doesn't include whatever it is in the matched string
(?i) (?m) (?s) (?x) same as /i /m /s /x as a modifier to the pattern match
# saving the $1.. varibles from a pattern match
($one, $two) = /(\w+) (\w+)/;
# range operator (expr .. expr) and (expr ... expr)
# used as a flip-flop toggle to select activity when a condition is met and cease activity
# when a second condition is met. Use .. if the activity can be stopped at the same time
# it is started. Use ... if the activity can only be stopped the next time through after
# starting.
print ".. range operator at 10 and 15\n";
for ($i=0; $i<30; ++$i)
{
$range = ($i == 10 .. $i == 15);
print $i,": ", $range,"\n" if $range;
# prints on iteration 10..15 only
# 10: 1
# 11: 2
# ...
# 14: 5
# 15: 6E0
}
print ".. range operator at 10 and 15\n";
for ($i=0; $i<30; ++$i)
{
$range = ($i == 10 ... $i == 15);
print $i,": ", $range,"\n" if $range;
# prints on iteration 10..15 only
# 10: 1
# 11: 2
# ...
# 14: 5
# 15: 6E0
}
print ".. range operator at 10 and >=10\n";
for ($i=0; $i<30; ++$i)
{
$range = ($i == 10 .. $i >= 10);
print $i,": ", $range,"\n" if $range;
# prints on iteration 10 only
# 10: 1E0
}
print ".. range operator at 10 and >=10\n";
for ($i=0; $i<30; ++$i)
{
$range = ($i == 10 ... $i >= 10);
print $i,": ", $range,"\n" if $range;
# prints on iteration 10 and 11 only
# 10: 1
# 11: 2E0
}
print if (3 .. /^$/); # print from line number 3 ($.==3) to (and including)
# the first blank line ($_=~/^$/)
s/^/> / if (/^$/ .. eof()); # insert '> ' at start of lines after (including)
# the first blank line found until end of file
# some pattern matching tricks
($new = $old) =~ s/old/new/; # make a modified string keeping the old one the same
$count = ($line =~ s/old/new/g); # changes the string and counts the changes
$count = tr/*/*/; # count the number of * characters in $_
$count = $sky =~ tr/*/*/; # count the number of * characters in another string
$Upper = "\U$string"; # better than using tr/a-z/A-Z/ because it will use locale information
while s/(\d)(\d\d\d)(?!\d)/$1,$2/; # insert commas in a number every 3rd digit
while s/\t+/' ' x (length($&)*8 - length($`)%8)/e; # expand tabs to 8-column spacing
s/%(.)/$percent{$1}/g; # replace %x escapes with entries from an associative array
s/%(.)/$percent{$1} || $&/ge; # replace %x escapes with entry from array or with the character escaped
s/^=(\w+)/&pod($1)/ge; # call a function on the matched string
s/(\$\w+)/$1/eeg; # nested /e evaluation allows substitution of $variables
# ternary tricks
($a_or_b ? $a : $b) = $c; # assigns $c to either $a or $b based on value of $a_or_b
# switch statement emulation. Uses the fact that a single block is a loop
# that is executed once and thus you can use next, last and redo to
# exit or restart the block. next will cause the continue block to execute
# last will skip it as will redo.
SWITCH: {
if (/^abc/) { $abc = 1; last SWITCH; }
if (/^def/) { $def = 1; last SWITCH; }
if (/^xyz/) { $xyz = 1; last SWITCH; }
$nothing = 1;
}
SWITCH: {
/^abc/ && do { $abc = 1; last SWITCH; };
/^def/ && do { $def = 1; last SWITCH; };
/^xyz/ && do { $xyz = 1; last SWITCH; };
$nothing = 1;
}
SWITCH: {
/^abc/ && do {
$abc = 1;
last SWITCH;
};
/^def/ && do {
$def = 1;
last SWITCH;
};
/^xyz/ && do {
$xyz = 1;
last SWITCH;
};
$nothing = 1;
}
SWITCH: {
/^abc/ and $abc = 1, last SWITCH;
/^def/ and $def = 1, last SWITCH;
/^xyz/ and $xyz = 1, last SWITCH;
$nothing = 1;
}
# A simple way to use $_ as a shorthand alias for a longer variable name
for ($some_ridiculously_long_variable_name) {
/match1/ and do { &something; last; };
/match2/ and do { &somethingelse; last; };
/match3/ and do { &someotherthing; last; };
die "unknown value for variable: '$_'";
}
# A way to do try ... catch - p.120 programming perl
# There is an issue with visibility of @_ because you can't do
# my @_ we have to use local @_
sub try (&$) {
my($try, $catch) = @_;
eval { &$try };
if ($@) {
local $_ = $@;
&$catch;
}
}
sub catch (&) { @_ }
try {
...do some stuff
die "EFileNotFound";
}
catch {
/EFileNotFound/ and print "File was not found\n";
};
# simulated multi-dimensional arrays using hashes - perl has real multi-d arrays now.
$foo{$a,$b,$c} == $foo{join($;, $a, $b, $c)}
# proper way to open a file in case the file has leading spaces or other weirdness
$file =~ s#^\s#./$&#; # preceed the filename with ./ if there's spaces
open FILE, "< $file\0";
# check if a module or package is installed. A module keeps its symbol table in
# a hash given by the name of the module with :: suffixed.
if (defined(%XYZ::)) { print "XYZ is present"; }
# requiring files
require Module; # includes Module.pm at run time
use Module (); # same as require but happens at compile time - () skips the import
use Module; # in addition to require it also does import() on the module
# Special Variable Mnemonics
$digit regex group match: like \digit
$& $MATCH regex match: like & in some editors
$` $PREMATCH regex prefix to match: ` often preceedes a quoted string
$' $POSTMATCH regex suffix to match ' often follows a quoted string
$+ $LAST_PAREN_MATCH regex last group match: be positive and forward looking
$* $MULTILINE_MATCHING regex multiline mode: * matches multiple things
$| $OUTPUT_AUTOFLUSH file handle auto flush: when you want your pipes to be piping hot
$% $FORMAT_PAGE_NUMBER format page number: % is page number in nroff
$= $FORMAT_LINES_PER_PAGE format lines per page: = has horizontal lines
$- $FORMAT_LINES_LEFT format lines left: lines_on_page - lines_printed
$^ $FORMAT_TOP_NAME current top of page format name: points to top of page
$~ $FORMAT_NAME current format name: takes a turn after $^
$_ $ARG default input and pattern-searching space: underline is the
underlying operand in certain operations
$. $INPUT_LINE_NUMBER $NR current input line number: many programs use "." to mean the current line number
$/ $INPUT_RECORD_SEPARATOR $RS input record separator: / is used to delimit line boundaries when quoting poetry
$, $OUTPUT_FIELD_SEPARATOR $OFS output field separator for print: what is printed when there is a "," in your
print statement
$\ $OUTPUT_RECORD_SEPARATOR $ORS output record separator for print: you set $\ instead of adding "\n" at the end
of print. Also, it's just like /, but it's what you get "back" from Perl.
$" $LIST_SEPARATOR this is like $, except that it applies to list values interpolated into a double
quoted string: it's what you get when you quote an array
$; $SUBSCRIPT_SEPARATOR $SUBSEP subscript separator for multi-dimensional array emulation: comma--the syntactic
subscript separator -- is a semicolon.
$^L $FORMAT_FORMFEED what a format outputs to perform a formfeed
$: $FORMAT_LINE_BREAK_CHARACTERS characters indicating where a word can be broken: a : in poetry is a part of a line
$^A $ACCUMULATOR the write accumulator for format lines:
$? $CHILD_ERROR status returned by last pipe close, backtick (``) command, or system operator:
similar to sh and ksh
$! $OS_ERROR $ERRNO returns the errno value or error string depending on context: what just went bang?
$@ $EVAL_ERROR syntax error message from last eval: where was the syntax error at?
$$ $PROCESS_ID $PID the process number of the Perl running this script: same as shells
$< $REAL_USER_ID $UID the real user ID of this process: it's the uid you came from, if you're running setuid
$> $EFFECTIVE_USER_ID $EUID the effective uid of this process: it's the uid you went to, if you're running setuid
$( $REAL_GROUP_ID $GID the real group ID of this process: parenthesis are used to group things. The real
gid is the group you left, if you're running setgid
$) $EFFCTIVE_GROUP_ID $EGID the effective gid of this process: parenthesis are used to group things. The effective
gid is the group that's right for you, if you're running setgid.
$0 $PROGRAM_NAME contains the name of the file containing the Perl script being executed: same as sh and ksh
$[ the index of the first element of an array and character of a substring: [ begins subscripts
$] $PERL_VERSION returns the version + patchlevel / 1000: Is this version of Perl in the right bracket?
$^D $DEBUGGING the current value of the debugging flags: value of the -D switch
$^F $SYSTEM_FD_MAX the maximum system file descriptor.
$^H internal compiler hints enabled by pragmatic modules.
$^I $INPLACE_EDIT current value of the inplace-edit extension: value of -i switch
$^O $OSNAME name of operating system that Perl was compiled for
$^P $PERLDB internal flag that the debugger clears so that it doesn't debug itself
$^T $BASETIME the time at which the script began running, in seconds since the epoch
$^W $WARNING the current value of the warning switch: the value is related to the -w switch
$^X $EXECUTABLE_NAME name that the Perl binary itself was executed as
$ARGV contains the name of the current file when reading from
# Sorting by several criteria
sub prospects
{
$money{$b} <=> $money{$a}; # descending by value
or
$height{$b} <=> $height{$a}; # descending by height
or
$age{$a} <=> $age{$b}; # ascending by age
or
$lastname{$a} cmp $lastname{$b}; # ascending by last name
or
$a cmp $b; # ensure sort order is stable
} # prospects()
@sortedclass = sort prospects @class;
# UUdecode example- programming perl p. 237
#!usr/bin/perl
$_ = <> until ($mode, $file) = /^begin\s*(\d*)\s*(\S*)/;
open(OUT, "> $file" if $file ne "");
while (<>) {
last if /^end/;
next if /[a-z]/;
next unless int((((ord() - 32) & 077) + 2) / 3) == int(length() / 4);
print OUT unpack "u", $_;
}
chmod oct $mode, $file;
# Count the number of set bits in a bit vector efficiently
$setbits = unpack "%32b*", $selectmask;
# Calculate a System V checksum - see sum manpage
undef $/;
$checksum = unpack ("%32C*", <>) % 32767;
# A Touch command
$now = $time;
@cannot = grep {not utime $now, $now, $_} @ ARGV;
die "$0: Could not touch @cannot.\n" if @cannot;
# Touch and create missing files
$now = time;
foreach $file (@ARGV) {
utime $now, $now, $_
or open TMP, ">>$file"
or warn "Couldn't touch $file: $!\n";
}
# Get first byte of string regardless of big-little endianness of the machine
$firstbyte = vec($foo, 0, 8);
# Interpolate a subroutine call into a string
print "sub returned @{[ mysub(1,2,3)]}\n";
print "expr = @{[ $n + 5]}\n";
print "expr = ${ \($n + 5) }\n";
# Making a "constant" scalar value - note, can't change it with $PI= but can just do *PI= again to change it.
*PI = \3.14159265358979;
use constant PI => 3.14159265358979; # another way to make a constant
# printing a constant
print "PI = @{[PI]}\n";
using a constant as a hash index
$hash{PI()} or $hash{+PI}
{ PI() => 'value'
PI , 'value'}
# Typeglob programming perl p.282
*pkg::sym{SCALAR} # \$pkg::sym
*pkg::sym{ARRAY} # \@pkg::sym
*pkg::sym{HASH} # \%pkg::sym
*pkg::sym{CODE} # \&pkg::sym
*pkg::sym{GLOB} # \*pkg::sym
*pkg::sym{FILEHANDLE} # internal filehandle, no direct equivalent
*pkg::sym{NAME} # "sym" (not a reference)
*pkg::sym{PACKAGE} # "pkg" (not a reference)
# what about write FORMAT variables?
# Retrieve the name of the current function
sub __func__ { (caller(1))[3] . '()' }
# display the name of the current function
sub __func__ { (caller(1))[3] . '(' . join(', ', @_) . ')' }
sub f {
print __func__ . ": message\n"; # easy
print "usage: @{[__func__]}\n"; # a little less easy
}
# Using perl with find to make things faster
# prevents many sub processes from starting if -exec unlink had been used.
find . -mtime +7 -print | perl -nle unlink # deletes all files older than a week
# You can use #ifdef and other C preprocessor stuff if you use the -P switch on the
# shebang line of your script. This causes the script to be preprocessed before
# perl interpretation -- be careful of comments beginning with if else or define though.
#!/usr/bin/perl -P
#define ONE
#ifdef ONE
print "ONE\n";
#else
print "TWO\n";
#endif
# You can use => as a substitute for a comma if it makes the code clearer.
kill HUP => -$$;
push @x => 1, 2, 3;
# Try an operation that may block and recover after a set time period if it does:
eval {
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm 10; # schedule an alarm in 10 seconds
flock (FH, 2); # a write lock that may block
alarm 0; # cancel the alarm
};
if ($@ and $@ !~ /alarm clock restart/) {die}
# perform a code block and prevent it from blocking by using a timeout
sub do_timeout($&)
{
my ($seconds, $code) = @_;
local $SIG{ALRM} = sub {die "alarm clock restart executing $code"};
alarm $seconds; # schedule an alarm in a few seconds
eval {
&$code; # execute the code block or subroutine passed in
alarm 0; # cancel the alarm
};
if ($@ and $@ !~ /^alarm clock restart/) {die $@};
} # noblock()
do_timeout 10, sub { print "Hello, World!\n"};
do_timeout 3, sub { sleep 100; print "Bye, World\n"};
do_timeout 3, sub { print "open" . $x / $y;};
# Additional perl tools
find2perl - convert find commands to perl script
perlguts - access to perl internals
perlcall - access to perl internals
# Debugger interaction
$DB::single = 1; # Will single step the next line and break into the debugger like the debugger s command
$DB::single = 2; # Will step over the next line and break into the debugger like the debugger n command
$DB::trace = 1; # Will turn on tracing like the debugger t command
To modify the debugger copy perl5db.pl from the perl library somewhere and modify it.
Also set PERL5DB environment variable to BEGIN { require "myperl5db.pl" }
Customize settings with ~/.perldb and/or ./.perldb
$DB::alias{'len'} = 's/len(.*)/p length($1)/';
$DB::alias{'stop'} = 's/^stop (at|in)/b/';
$DB::alias{'ps'} = 's/^ps\b/p scalar /';
$DB::alias{'quit'} = 's/^quit\b.*/exit/';
&parse_options("opt=val") # use this to set debugger options like the O command
sub afterinit { ... executed after debugger is initialized }
set environment PERLDB_OPTS to contain default options like the O debugger command
Use CPAN Term::ReadLine and Term::ReadKey for better command line completion support
PERL CPAN Module Archive
perl -MCPAN -e shell
install Module
Programming Examples for CPAN
This enables the programmer to do operations that combine
functionalities that are available in the shell.
# install everything that is outdated on my disk:
perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'
# install my favorite programs if necessary:
for $mod (qw(Net::FTP MD5 Data::Dumper)){
my $obj = CPAN::Shell->expand('Module',$mod);
$obj->install;
}
# list all modules on my disk that have no VERSION number
for $mod (CPAN::Shell->expand("Module","/./")){
next unless $mod->inst_file;
# MakeMaker convention for undefined $VERSION:
next unless $mod->inst_version eq "undef";
print "No VERSION in ", $mod->id, "\n";
}
# find out which distribution on CPAN contains a module:
print CPAN::Shell->expand("Module","Apache::Constants")->cpan_file
Or if you want to write a cronjob to watch The CPAN, you could list
all modules that need updating. First a quick and dirty way:
perl -e 'use CPAN; CPAN::Shell->r;'
If you don't want to get any output if all modules are up to date, you
can parse the output of above command for the regular expression
//modules are up to date// and decide to mail the output only if it
doesn't match. Ick?
If you prefer to do it more in a programmer style in one single
process, maybe something like this suites you better:
# list all modules on my disk that have newer versions on CPAN
for $mod (CPAN::Shell->expand("Module","/./")){
next unless $mod->inst_file;
next if $mod->uptodate;
printf "Module %s is installed as %s, could be updated to %s from CPAN\n",
$mod->id, $mod->inst_version, $mod->cpan_version;
}
If that gives you too much output every day, you maybe only want to
watch for three modules. You can write
for $mod (CPAN::Shell->expand("Module","/Apache|LWP|CGI/")){
as the first line instead. Or you can combine some of the above
tricks:
# watch only for a new mod_perl module
$mod = CPAN::Shell->expand("Module","mod_perl");
exit if $mod->uptodate;
# new mod_perl arrived, let me know all update recommendations
CPAN::Shell->r;
CPAN commands
i /pattern/ search for modules matching pattern
autobundle writes a bundle file listing all modules that are installed
the bundle file is at $CPAN::Config->{cpan_home}/Bundle directory
CPAN modules of interest
HTML::Tagset
HTML::Widgets::DateEntry
HTML::Widgets::Search
Mail::CheckUser
MIME::Lite::HTML
Log::TraceMessages
Sub::Curry
ex::override - override perl builtin functions
Parse::Tokens
Term::ProgressBar
Data::Dumper
Silly::Werder
Text::Autoformat - use to format my email
Devel::Symdump
DBIx::RecordSet
BingoX::Carbon - DB abstraction layer opensource.cnation.com
(
geocities.com/gurucoder/Tools) (
geocities.com/gurucoder)