I once subscribed to the newsprint version of The Onion, a humor newspaper better known for their web site (www.theonion.com). On the Web, of course, The Onion doesn’t have to worry much about layout: their articles can be as long or as short as necessary. But on paper, they need to fill every square inch on every page with either content or ads. When room is left over, they insert a dummy article consisting of the phrase “Passers-by were amazed by the unusually large amounts of blood” repeated over and over. There were times when I wished I had done the same with TPJ.
Up until TPJ #13, I did all The Perl Journal ’s layout myself, and I almost always deferred it until a few days before printing. Magazines and newspapers typically lay out advertisements first, and flow the text around them. In contrast, I was always tweaking the articles up until the last minute, sometimes changing the length by enough that I ended up with substantial empty space on the page. Starting with TPJ #7, I began to amass a collection of “Perl One-Liners” for sprinkling around the magazine whenever I needed to fill a column-inch or two. Very few of them were actually one line, but the name stuck, and I present 65 of them here for your use and amusement.
They’re divided into two sections: Useful and Not So Useful. All the one-liners are available on the book’s web site at http://www.oreilly.com/catalog/tpj3.
49 useful code snippets from TPJ follow. They’re organized (very roughly) from most useful to least.
$^O
contains the name of
your operating system.
$^T
contains the time at
which your program began.
$0
contains the name of
your program.
Run the widget
program
bundled with Perl/Tk for an excellent run-through of all the
important widgets, complete with cut-and-pasteable source
code.
To apply a Perl expression EXPR
to a
region:
C-u M-| perl -pe 'EXPR
'
To apply EXPR
to the entire
buffer:
C-x h C-u M-| perl -pe 'EXPR
'
(Courtesy Mark Jason Dominus.)
Efficiently finding the position of the first and last occurrences of a substring in a string:
$first = index($string, $substring); $last = rindex($string, $substring);
This is faster than using regular expressions.
warn "has nondigits" if /D/; warn "not a natural number" unless /^d+$/; # rejects -3 warn "not an integer" unless /^-?d+$/; # rejects +3 warn "not an integer" unless /^[+-]?d+$/; warn "not a decimal number" unless /^-?d+.?d*$/; # rejects .2 warn "not a decimal number" unless /^-?(?:d+(?:.d*)?|.d+)$/; warn "not a C float" unless /^([+-]?)(?=d|.d)d*(.d*)?([Ee]([+-]?d+))?$/;
(Courtesy The Perl Cookbook.)
This prints all elements of the @INC
array, which is where Perl searches
for modules and library files.
perl -e "print qq($_ ) for @INC"
sub unique (&@) { my ($c,%hash) = shift; grep { not $hash{&$c}++ } @_ }
@list = unique { $_ } @list; # Remove duplicate strings from @list. @obj = unique { $_->name } @obj; # Only include one object for each name.
(Courtesy Don Schwarz.)
Any of these snippets will work:
perl -pale '@F{@F}=()} for(sort keys%F){' perl -la0ne 'print for sort keys%{{map{$_,1}@F}}' perl -la0ne '@a{@F}++;print for sort keys%a' perl -la0pe '}for (sort keys%{{map{$_,1}@F}}){'
(Courtesy Peter J. Kernan.)
@a = (0,0); while (<>) { ++$a[not m/^=w+/s .. m/^=cut/s] } printf "%d pod lines, %d code lines ", @a;
(Courtesy Sean M. Burke.)
sleep
can only sleep for an
integral number of seconds. If you wanted to sleep for 0.25 seconds,
here’s how:
select(undef, undef, undef, 0.25);
This script reports on available modules more cleanly:
#!/usr/bin/perl -w use strict; # all variables must be declared use Getopt::Std; # import the getopts method use ExtUtils::Installed; # import the package use vars qw($opt_l $opt_s); # declaring the two option switches &getopts('ls'), # $opt_l and $opt_s are set to 1 or 0 unless($opt_l or $opt_s) { # unless one switch is true (1) die "pmods: A utility to list all installed (nonstandard) modules ", " Usage: pmods.pl -l # list each module and all its directories ", " pmods.pl -s # list just the module names "; } my $inst = ExtUtils::Installed->new(); foreach my $mod ( $inst->modules() ) { # foreach of the installed modules my $ver = $inst->version($mod); # version number of the module $ver = ($ver) ? $ver : 'NONE'; # for clean operation print "MODULE: $mod version $ver "; # print module names map { print " $_ " } $inst->directories($mod) if($opt_l); }
(Courtesy William H. Asquith et al.)
To replace substring $x
with an equal length substring $y
, but preserving the
case of $x
:
$string =~ s/($x)/"L$y"^"L$1"^$1/ie;
(Courtesy Dean Inada.)
To find the longest common prefix of two strings $x
and $y
:
($x ^ $y) =~ /^( *)/; print substr($x, 0, length($1));
If $x
were foobar
and $y
were football
, the above snippet would print
foo
—handy for allowing users to
abbreviate commands with the minimum number of letters.
The longest common suffix:
((reverse $x) ^ (reverse $y)) =~ /^( *)/; print substr($x, -length($1));
If $x
were camel
and $y
were caramel
, the above snippet would print
amel
.
(Courtesy Jarkko Hietaniemi.)
perl -0777e 'printf "begin 444 $ARGV[0] %s` end ",pack "u*",<>' filename
To uudecode a uuencoded file:
perl -ne 'print unpack "u*",$_' file.uu
(Courtesy Gurusamy Sarathy.)
Use m//g
when you know what
you want to keep, and split
when
you know what you want to throw away.
(Courtesy Randal Schwartz.)
@matrix_t = map { my $x = $_; [map { $matrix[$_][$x]} 0..$#matrix] } 0..$#{$matrix[0] };
(Courtesy Tuomas J. Lukka.)
Ever wish backquotes didn’t interpolate variables? qx()
is a synonym for backquotes, but if
you use single quotes as a delimiter, it won’t
interpolate:
qx'echo $HOME'
passes the string echo
$HOME
to your shell without interpreting $HOME
as a Perl scalar.
(Courtesy Tom Christiansen.)
$s &= "177" x length($s);
Given a string in $s
, this
one-liner turns all of the “funny” characters (like Ã) into regular
seven-bit ASCII characters. It works by ANDing the bit
representation of each character with 127, which removes the eighth
bit. That turns à into L, for instance.
(Courtesy Tom Christiansen.)
Replace 17 with whatever number you want to test. If the
number is prime, this snippet will print PRIME
, and nothing otherwise:
perl -le 'print "PRIME" if (1 x shift) !~ /^(11+)1+$/' 17
(Courtesy Abigail.)
sub f{for(2..sqrt($_[0])){return($_,f($_[0]/$_))if!($_[0]%$_)}return$_[0]} print join",",f(720); print " ";
(Courtesy Tuomas J. Lukka.)
qr
-strings are actually
objects:
$rob = qr/red/i; if ($rob->match("Fred Flintstone")) { print "Got obj fred! "; } else { print "No obj fred. "; } sub Regexp::match { my $self = shift; my $arg = @_ ? shift : $_; return $arg =~ /$arg/; }
This prints Got obj
fred!
.
qr
has a magic print value.
For instance, if you print a regex like so:
perl -le 'print qr/^watch/i'
you’ll see this, showing that the i
modifier is active and the x, s
, and m
modifiers are inactive, and that the
regex is non-capturing:
(?i-xsm:^watch)
(Courtesy Tom Christiansen.)
This snippet lops off the latter half of an array:
$#array /= 2 if @array;
(Courtesy The Perl Cookbook.)
This snippet prints a message if a daylight savings time change occurs within the next 5 days:
print "aTIME CHANGE COMING! " if (localtime(time))[8] ne (localtime(time+5*24*60*60))[8];
(Courtesy J.D. Laub.)
To track the progress of a file as it downloads:
perl -e 'BEGIN{$|=1;$f=$ARGV[0];$s=(stat$f)[7];$t=time} while(sleep 1){printf" $f %s bytes at %.2f Kb/s ", $_=(stat$f)[7],($_-$s)/1024/(time-$t)}' your_downloading_file
(Courtesy Philippe Bruhat.)
You can put this snippet anywhere in your program; when it
finishes, the END
block will be
triggered and the total running time of your program will be
printed:
END { no integer; printf(STDERR "Running time: %5.2f minutes ",((time - $^T) / 60)); }
The Data::Dumper module, bundled with Perl, can save data structures to disk as strings that can be read in by another program.
# indent your here doc ($definition = <<'FINIS') =~ s/^s+//gm; The five varieties of camelids are the familiar camel, his friends the llama and the alpaca, and the rather less well-known guanaco and vicuña. FINIS
(Courtesy The Perl Cookbook.)
Replace xterm
with whatever
command you use to launch a terminal window:
perl -e '$fg = rand 2**24; do { $bg = rand 2**24 } while (unpack("%32b*", $bg^$fg) < 10); ($fg, $bg) = map { sprintf "#%06x", $_ } $fg, $bg; exec("xterm", "-fg", $fg, "-bg", $bg);'
(Courtesy Tkil.)
If you’re trying to get Windows to generate a PostScript file, but it wraps the file with PCL junk, you can remove it with this:
perl -ni -e "!$g&&s/^.*(%!.*)/$1/ && $g or print; last if /^%%EOF/"
This snippet of PDL code graphs the figure shown in Figure 48-1:
use PDL; use PDL::Graphics::TriD; $s = 40; $a = zeroes 2*$s, $s/2; $t = $a->xlinvals(0,6.284); $u = $a->ylinvals(0,6.284); $o = 5; $i = 1; $v = $o - $o/2*sin(3*$t) + $i*sin$u; imag3d([$v*sin$t, $v*cos$t, $i*cos($u) + $o*sin(3*$t)]);
(Courtesy Tuomas J. Lukka.)
This subroutine returns true if and only if all parentheses, brackets, and braces in the given string are balanced:
sub is_balanced { my $it = $_[0]; $it =~ tr/()[ ]{}//cd; 1 while $it =~ s/()|[]|{}//g; return !length($it); }
(Courtesy Sean M. Burke.)
use strict ;sub pars {my( $l,$r )=map{ "Q$_" }split// ,shift; my(@s,@r ,$i,$o, $v);for( split/([ $l$r])/, shift){ /$l/and $s[++$o]= ++$i;for $v(1..$o)# {$r[$v].= $_ if$s[$v] >0}/$r/and $s[(grep## $s[$_]== $i,0..$#s) [0]]=-$i ,--$i<0&& last;}($i= shift)? wantarray ?@r[grep -$s[$_ ]==$i,0.. $#s]:$r [$i]: splice@r, 1;}$, =" " ;print pars (@ ARGV )#
Basic usage of the pars
subroutine that this onomatolexical program provides:
pars('()', "(123 (456) (789) 0)")
prints the three parenthetical expressions:
(123 (456) (789) 0),(456),(789)
You can request a particular depth. In list context, this expression:
pars('()', "(123 (456) (789) 0)", 2)
prints the level-2 expressions:
(456),(789)
In scalar context, the 2
is
interpreted to mean the second parenthetical expression:
(456)
(Courtesy Paul Kulchenko.)
Each cell of the table corresponds to a pixel of the image:
use GD; $f = '#ffffff'; $T = table; sub p {print @_} p "<body bgcolor=$f>"; for (@ARGV) { open *G,$_ or (warn("$_: $!") && next); $g = GD::Image->newFromGif(G) || (warn $_ , ": GD error" and next); @c = map { $_ != $g->transparent ? sprintf '#' . ('%.2x'x3), $g->rgb($_) : $f } 0..$g->colorsTotal; p "<$T border=0 cellpadding=0 cellspacing=0>"; ($x, $y) = $g->getBounds; for $j (0..$y) { p "<tr>"; for ($i=0; $i<$x; $i++) { $s=1; $s++ && $i++ while ($i+1 < $x && $g->getPixel($i+1,$j) == $g->getPixel($i,$j)); p "<td bgcolor=", $c[$g->getPixel($i,$j)], " colspan=$s> " } } p "</$T>" }
(Courtesy Mike Fletcher.)
16 not so useful code snippets from TPJ follow.
“Regular expressions are to strings with math is to numbers.”
(From an Andrew Clinick column, discussing what Microsoft thinks of Perl. Short answer: they like it, because it can be used “anywhere” via Microsoft’s ActiveX scripting mechanism.)
Asteroid 2000 BF19 was thought to be on a potentially
dangerous approach path for us Terrans, with a possible impact in
2022. However, a Perl program called clomon.pl
showed that the asteroid cannot
come any closer than 0.038 AU for the next fifty years. Sleep
tight!
(Courtesy Andrea Milani and Scott Manley.)
($x,$y)=(41,31); $x&1&&$y&1&&$x>1&&$y>1||die; @M=(1)x($x*$y); sub K { $M[my$p=$_[0]]=0; while($d = ($p>$x*2)*$M[$p-2*$x] | ($p<$x*($y-2))*$M[$p+2*$x]*2 | ($p%$x!=$x-2)*$M[$p+2]*4 | ($p%$x!=1)*$M[$p-2]*8) { $d&1<<($i=3&int rand $d)||redo; $M[$p+($j=$i==0?-$x:$i==1?$x:$i==2?1:-1)]=0; K($p+2*$j) } } K($x+1); $M[1]=$M[-2]=0; while(@M){$_=join'',splice@M,0,$x;tr<01>< #>;print$_," "}
The above snippet generates mazes that look like this:
# ####################################### # # # # # # # # # ### ### # # # ##### # ####### # ### # # # # # # # # # # # # # # # # ##### # ####### # # # # ### # ##### # # # # # # # # # # # # # # # # # ### ### ### # # ####### # # # # # # # # # # # # # # # # # # # # # # ### # # # ####### # ### # # # ##### # # # # # # # # # # # # # # # # # # # # ### # # ########### # # # ####### # # # # # # # # # # # # ### ### ### ########### # # ##### # ### # # # # # # # # # # # # # # # ##### ### # # ### ##### # ##### # # # # # # # # # # # # # # # # # # # ### # # # ### # # # # # ### # ### # # # # # # # # # # # # # # # # # # # # ######### # # # # ##### ### # ### # # # # # # # # # # # # # ############# # # ############# # ### # # # # # # # # # # # # ##### # ### # # # ### ##### # ##### # # # # # # # # # # # # # # # # # ### ######### ############### # # # # # # # # # # # ### # ############# # # ####### ####### # # # # # # # # # # # ##### # ########### ### # ##### ### # # # # # # # ####################################### #
(Courtesy Sean M. Burke.)
Neal Stephenson’s novel Cryptonomicon includes a Perl cryptosystem code-named Pontifex. You can read about it at http://www.well.com/user/neal/cypherFAQ.html#12 and http://www.counterpane.com/solitaire.html. The source code is at http://www.counterpane.com/sol.pl.
Harry used parts of the Perl FAQ to translate a message. In the first shot, this not-quite-syntactically-correct snippet could be seen:
$BSD = -f '/vmunix'; if ($BSD) { system "BIN cbreak </dev/tty >/dev/tty 2>&1
In the second shot:
set_cbreak(0) local($on) = $_[0]; local($sgttyb,@ary); require 'sys/ioctl.ph';
(Courtesy Brendan O’Dea.)
#!/usr/bin/perl ($decimal, $binary) = (shift, ''), $SIG{USR1} = sub { $binary .= "0" }; $SIG{USR2} = sub { $binary .= "1" }; do { kill $decimal & 1 ? 'USR2' : 'USR1', $$; $decimal >>= 1; } while ($decimal); print scalar reverse $binary;
Swatch’s Internet Time, heralded as a “revolutionary” way of measuring time independent of geography:
perl -e 'print "Internet Time @", int(((time + 3600) % 86400)/86.4)'
This snippet of PDL code implements Conway’s game of Life (pictured in Figure 48-2).
use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d; $d = byte( random(zeroes(40,40)) > 0.85 ); $k = byte [[1,1,1],[1,0,1],[1,1,1]]; do { imagrgb [$d]; $s = conv2d($d,$k); $d &= ($s<4); $d &= ($s>1); $d |= ($s==3); } while (!twiddle3d);
(Courtesy Robin Williams and Tuomas J. Lukka.)
This snippet goes through each character of standard input and uppercases it half the time:
perl -ne 'foreach(split//){rand()<0.5?print:print uc;}'
(Courtesy Kyle Burton.)
On certain older Pentium-based systems, this code will crash the computer:
require DynaLoader; DynaLoader::dl_install_xsub("main::hangme", unpack("I", pack("P4", "xF0x0FxC7xC8"))); hangme();
We provide it here for diagnostic purposes only.
(Courtesy Gisle Aas.)
This prints 7 Magic Cards.
for $a(0..6){$b=1;for $c(1..100){if($c&2**$a){printf "%3d ",$c;print" "if!($b++%10)}}print" "}
Have a friend think of a number from 1 to 100. Show them the cards one at a time and ask if their number is on the card. Mentally sum the first digit of each card for which the answer is yes. The final sum will be their number. (This trick is known to win bar bets.)
(Courtesy Bill Huston.)
sub merge { my $enses; do { not $ave; my $inking, @body; push @me, @down; }; foreach $econd (%brings) { my $oluble, @existence; closer_to_your; drowning_beauty; } }
%secretly = ( confidence => 0xFADED, under => 0xFED, lost => 0xDEAD, ); sub conscious { setpriority $cushion, $the, $fall or return $to_safer_ground; } print "I am ",conscious(143); $i_am = $secretly{lost};
#!/usr/bin/perl # # Will give errors if run with -w, so don't use -w :) # Tested on NT with AS (5.005), GS (5.004_02), and Solaris 2.6 (5.004_04) if ("a packet hits a pocket") { On: a; socket(ON, A ,PORT,"") && the bus is interrupted as a very-last-resort && the address of the memory makes your floppy disk, abort; } else { "The socket packet pocket has an"; error: to-report; } if ("your cursor finds a menu item") { "followed by a dash" && "the double clicking icon"; puts: your-items-in-the-trash && your data is corrupted cause the index("doesn't", "hash"); } else { "Your situation is hopeless" && Your system's gonna crash; } if ("the label on the cable") { On-the-table, at-your-house; Says_the; sub network {"is connected to the button on your mouse"}; BUT: Your-packets, want-to; {/tunnel to another protocol/}; that's: repeatedly-rejected; {/by the printer/}; "down the hall" && "YOUR SCREEN is all distorted"; {/by the side effects of Gauss/}; so: "your icons", in-the-window; "are as wavy as a souse"; } else { YOU: "may as well reboot" && "go out with a !"; CAUSE: /Sure as Im a poet/; THIS: suckers-gonna-hang; } print "Seuss as a tech writer - Kevin Meltzer ";
(Courtesy Kevin Meltzer.)
One function to bless them all,
One list to derive them,
One arrow to call them through,
Preorder search to bind them.
(Courtesy Damian Conway.)
Perl was born December 18, 1987.
Zodiac sign: Sagittarius.
Chinese zodiac: Rabbit, signifying docility, gentleness, nonconformity, and longevity.
On December 18 in history, Keith Richards, Steven Spielberg, Brad Pitt, Paul Klee, Mohammed Ali, and Ty Cobb were born. The golf tee was patented, slavery was abolished in the United States, New Jersey became a state, and the UN unanimously condemned hostage-taking.