|
Short bits of code which will amaze, awaken, and amuse.
August 12, 2001
URL:http://www.drdobbs.com/web-development/tpj-one-liners/184416234
Courtesy of Mark-Jason Dominus.
To replace substring $x with an equal length substring $y, but preserving the case
of $x:Z
Courtesy of Dean Inada
Courtesy of Gisle Aas
#6 Primality
Courtesy of Abigail, [email protected]
#7 An Absurd Way To Convert From Decimal To Binary
Courtesy of Nathan Torkington
#8 How To Patch Your Netscape Binary To Enable Strong Encryption
Courtesy of Ian Goldberg
#9 How To Use The Perl Debugger as a Command-Line Interpreter
#10 Using PDL to Generate Fractals
Courtesy of Tuomas J.Lukka
Courtesy of Robin Williams
#12 DeMorgan's Rule
Little-known facts about qr// (new with Perl 5.005): it has a magic print value, and it's an object of type Regexp.
Courtesy of Tom Christiansen
Courtesy of Tuomas J. Lukka
#15 Primality Courtesy of Tuomas J. Lukka
#16
Courtesy of Mike Fletcher
#17
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' works.
Courtesy of Tom Christiansen
#18
Courtesy of Randal L. Schwartz
#19
Courtesy Sean M. Burke
#20 Results of the SunWorld reader survey (4,106 respondents)
Picking random elements from an array:
#22
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:
Courtesy of Brendan O'Dea
Seperate the header and body of a mail message into strings
Courtesy of the Perl Cookbook
#25
Courtesy of The Perl Cookbook
#26
Launching xterms with random colors. You might have to replace xterm with whatever command you use to launch a terminal window:
Courtesy of Tkil
#27
Lop off the latter half of an array:
Courtesy of The Perl Cookbook
#28
Courtesy of Peter J. Kernan
#29
This subroutine accepts a string and returns a true value if all of the parentheses, brackets, and braces in the string are balanced.
Courtesy Sean M. Burke
#30 --Andrew Clinick, discussing what Microsoft thinks of Perl
Short answer: They like it.
Anonymous
#31 Anonymous
#32 A trick for indenting here strings Courtesy of The Perl Cookbook
#33
Efficiently finding the position of the first and last
#34
$^O contains the name of your operating system.
#35 If Dr. Seuss were a Perl programmer Courtesy of Kevin Meltzer
#36
Neal Stephenson's latest novel, Cryptonomicon, includes a Perl cryptosystem
code-named Pontifex. You can read about it at
http://www.well.com/user/neal/cypherFAQ.html#12.
#37
Stripping the eighth bits from a string $s &= "\177" x length($s);
Given a string in $s, this one-liner turns all of the "funny" characters
(like or ) 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 and into N, for instance. Courtesy of Tom Christiansen
#38
Replacing tabs with spaces Courtesy of Abigail
#39
Printing all capitalized words
#40
A name game. Courtesy of Sean M. Burke
#41
Extracting balanced parentheses from a string
gives you the parenthesized substrings in order of appearance:
in a list context gives you list of substrings, opened on level 2:
in scalar context gives you the second substring: Courtesy of Paul Clinger
#42
Extract unique elements from a list given a key function
Courtesy of Don Schwarz
#43
Seven "Magic Cards." Have a friend think of a number from 1 to 100. Give them
cards one at a time and ask if their number is on the card. Mentally sum the first
digits of each card with a "yes" answer. Go into trance, say the magic word
"Ultrix!" and announce their number. Known to win bar bets.
Courtesy of Bill Huston
#44
Asteroid 2000 BF19 was thought to be on a potentially dangerous
approach path for us Terrans, with a possible impact in 2022. 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! -Based on email from Andrea Milani and Scott Manley
#45
Tracking the progress of a file as it downloads:
your_downloading_file -Courtesy Philippe Bruhat
#46
A full list of installed (but nonstandard) modules, and where
they are located:
-Courtesy William H. Asquith et al.
#1
Adding a long list of numbers on the command line:
perl -e 'print eval join("+", @ARGV)' 6 10 20 11
9 16 17 28 100 33333 14 -7
#2
A cheap alarm clock:
perl -e 'sleep(120); while (1) { print "\a" }'
#3 Using Perl from Emacs
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'
appeared in Issue 8
#4 Preserving case in a substitution
$string =~ s/($x)/"\L$y"^"\L$1"^$1/ie;
appeared in Issue 8
#5 Exploiting the F00F Pentium bug
require DynaLoader;
DynaLoader::dl_install_xsub("main::hangme",
unpack("I", pack("P4", "\xF0\x0F\xC7\xC8")));
hangme();
Do NOT execute this. It will crash your computer.
appeared in Issue 8
perl -le 'print "PRIME" if (1 x shift) !~ /^(11+)\1+$/' 19
Type this from your command line to test whether 19 (or any other integer of your choosing) is prime.
appeared in Issue 8
#!/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;
appeared in Issue 9
#!/usr/bin/perl -0777pi
s/TS:.*?\0/$_=$&;y,a-z, ,;s, $,true,gm;s, 512,2048,;$_/es
appeared in Issue 9
perl -de 0
use PDL; use PDL::IO::Pic;$a=zeroes 300,300;
$r=$a->xlinvals(-1.5,0.5);$i=$a->ylinvals(-1,1);
$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2*$r*$i+
$u;$d=$r**2+$i**2;$a=lclip($a,$_*($d>2.0)*($a==0));($r,
$i)=map{$_->clip(-5,5)}($q,$h);}$a->wpic("mandel.gif");
appeared in Issue 9
#11 The Game Of Life
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);
appeared in Issue 10
if (!$a || $b != $c) { ... }
is equivalent to
unless ( $a && $b == $c ) { ... }
#13
% perl -le 'print "My regex: ", qr/^watch/i'
My regex: (?i-xsm:^watch this)
$rob = qr/red/i;
if ($rob->match("Fred Flintstone")) {
print "Got obj fred!\n";
}
sub Regexp::match {
my $self = shift;
my $arg = @_ ? shift : $_;
return $arg =~ /$arg/;
}
appeared in Issue 11
#14
Transpose a two-dimensional array:
@matrix_t = map{my$x=$_;[map {$matrix[$_][$x]}
0..$#matrix]}0..$#{$matrix[0]};
appeared in Issue 11
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)]);
appeared in Issue 11
This code converts any GIF to an HTML table--each cell of the table corresponds to a pixel of the image. Use this to make your web advertisements seem like important content and circumvent Lincoln's Apache::AdBlocker. :
This code is online at http://tpj.com/one-liners.
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>"}
appeared in Issue 11
appeared in Issue 11
"Use m//g when you know what you want to keep, and split() when you know what you want to throw away."
appeared in Issue 11
Count the lines of pod and code in a Perl program:
@a=(0,0);while(<>){++$a[not m/
^=\w+/s .. m/^=cut/s]} printf"%d
pod lines, %d code lines\n",@a;
appeared in Issue 11
Which of the following open source products do you have installed for WORK use?
Perl 83%
Sendmail 74%
Apache 72%
Linux 64%
Tcl 52%
Python 24%
Which of the following open source products do you have installed for PERSONAL use?
Perl 79%
Linux 77%
Apache 63%
Sendmail 61%
Tcl 55%
Python 34%
#21
srand;
$item = $array[rand @array];
perl -ni -e "!$g&&s/^.*(%!.*)/$1/&&$g or print;last if /^%%
EOF/"
#23
In the movie Sphere, the commands that Harry typed to translate the message were taken from Tom Christiansen's FAQ:
$BSD = -f '/vmunix'; if ($BSD) {system "BIN
cbreak </dev/tty >/dev/tty 2>&1
sub set_break { # &setset_cbreak(1) or &set_cbreak(0)
local($on) = $_[0];
local($sgttyb,@ary);
require 'sys/ioctl.ph';
appeared in Issue 12
#24
while (<>) {
$in_header = 1 ../^$/;
$in_body = /^$/ ..eof();
appeared in Issue 12
Simple numeric tests:
warn "has nondigits" if /\D/;
warn "not a natural number" unless /^\d+$/;
warn "not an integer" unless /^'?\d+$/;
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+))?$/;
appeared in Issue 12
perl -e '$fg=rand 2**24; do { $bg = rand
2**24 } while (unpack("%32b*", pack "N",
($bg^$fg)&0xe0e0e0) < 8); ($fg, $bg) =
map { sprintf "#%06x", $_ } $fg, $bg;
exec("xterm", "-fg", $fg, "-bg", $bg);'
appeared in Issue 12
$#array /= 2;
appeared in Issue 12
perl -0nal012e '@a{@F}++; print for sort keys %a'
Extracts, sorts, and prints the words from a file.
appeared in Issue 13
sub is_balanced {
my $it = $_[0];
$it =~ tr/()[]{}//cd;
while ($it =~ s/\(\)|\[\]|\{\}//g) { 1 }
return !length($it);
}
appeared in Issue 13
"Regular expressions are to strings what math is to numbers."
appeared in Issue 13
perl -e 'print "Internet Time @",
int (((time + 3600) % 86400)/86.4), "\n";'
Swatch's Internet Time, heralded as a revolutionary way
of measuring time independent of geography. See
http://www.swatch.com for details.
appeared in Issue 13
($definition = <<'FINIS') =~ s/^\s+//gm;
The five varieties of camelids are the familliar
camel, his friends the llama and the alpaca, and
the rather less well-known guanaco and vicuna.
FINIS
appeared in Issue 13
occurrences of a substring in a string
$first = index($string, $substring);
$last = rindex($string, $substring);
Some scalars that Perl defines for you:
$^T contains the time at which your program began.
$O contains the name of your program
#!/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\n";
appeared in Issue 14
appeared in Issue 14
perl -0011 -pi -e '/\011/&apm;&($_="$'")' filename
appeared in Issue 14
perl -ne 'push@w,/(\b[A-Z]\S*?\b)/g;END{print"@w"}' file
s<^([bcdfghjklmnpqrstvwxyz]*)(\w+).*>
<$1$2 $1$2 $1o $1$2 / Bonana-Fanna-Fo-F$2 /
Fe Fi Mo M$2 / $1$2!>i;
appeared in Issue 15
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;}$,
="\n" ;print pars
(@ ARGV )#
pars('()', "(123 (456) (789) 0)")
(123 (456) (789) 0),(456),(789)
pars('()', "(123 (456) (789) 0)", 2)
(456),(789)
(456)
appeared in Issue 15
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
# for each name.
appeared in Issue 15
for $a(0..6){$b=1;for $c(1..100){if($c&2**$a){printf
"%3d ",$c;print"\n"if!($b++%10)}}print"\n\n\n"}
appeared in Issue 15
appeared in Issue 17
perl -e 'BEGIN{$|=1;$f=$ARGV[0];$s=(stat$f)[7];$t=time}
while(sleep 1){printf"\r$f %s bytes at %.2f Kb/s ",
$_=(stat$f)[7],($_-$s)/1024/(time-$t)}'
appeared in Issue 17
#!/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\n",
" Usage: pmods.pl -l # list each module and all its directories\n",
" pmods.pl -s # list just the module names\n";
}
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\n"; # print module names
map { print " $_\n" } $inst->directories($mod) if($opt_l);
}
appeared in Issue 17
#47
Print a message if a daylight savings time change occurs within the next 5 days:
print "\aTIME CHANGE COMING!\n"
if (localtime(time))[8] ne (localtime(time+5*24*60*60))[8];
-Courtesy J.D. Laub
#48
Reverse for syntax to print out Perl's include path:
perl -e 'print "$_\n" for @INC'
#49
You can create a reference to a scalar like so:
$ref = \$var;
In recent versions of Perl, you can also say:
$ref = *var{SCALAR};
The same holds for other data types.
#50
Upcoming in Perl 5.6:
A new keyword, our, which is like my but is package-aware.
#51
$^O contains the name of your operating system.
#52
The Data::Dumper module, bundled with Perl, can save data
structures to disk as strings that can be read in by another program.
Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.