This page is a list of random things I came across when learning this language.
related topic: Catalyst
Goodbye World
I really like it:
print "goodbye world\n"; unlink $0
cperl-mode in emacs
Replace the default perl-mode, add to .emacs file(defalias 'perl-mode 'cperl-mode) (custom-set-variables '(cperl-indent-level 4) '(cperl-continued-statement-offset 4) )
to access perldoc "M-x cperl-perldoc"
to customize, use "customize-mode" or "customize-face" and etc.
more info at http://www.emacswiki.org/cgi-bin/wiki/CPerlMode
auto completes words using dabbrev call
;; auto complete
(defadvice cperl-indent-command
(around cperl-indent-or-complete)
"Changes \\\\[cperl-indent-command] so it autocompletes when at the end of a word."
(if (looking-at "\\>")
(dabbrev-expand nil)
ad-do-it))
(eval-after-load "cperl-mode"
'(progn (require 'dabbrev) (ad-activate 'cperl-indent-command)))
see the Emacs page for syntax checking within emacs
install package
on \*nix: perl -MCPAN -e "install Net::Telnet"on Win32: ppm install Net-Telnet
Tk book
http://proquest.safaribooksonline.com/1565927168perldoc
Always check out perldoc especially with perldoc -f function.other useful doc
http://pleac.sourceforge.net/pleac_perl.htmlthe book "programming perl" is also worth reading, it is written by L.Wall T.Christiansen and J.Orwant.
debug
start with perldebtut; "h-h" will display help page; some common commands:
v to view code
s to step through
c <line> to continue until <line>
p $data{$key}
x %data
x \%data
don't forget to try perldb in emacs
perl data structure
perlreftut and perldsc should be very useful to start with some examples on arrays of arrays, hashes of arrays, arrays of hashes, hashes of hashes and etca stub could be:
...
push @{$filelist{$run}}, $datafile;
...
print $filelist{$run}[$index];
...
"->" operator, the following work the same:
${$href}{$key};
$href->{$key};
regexp
some links for regexp:short one with some examples(it is actually part of a short tour of PERL)
file manipulation
very simple file operation
open L, ">$listname" || die "individual list file $listname not open";
print L join "\n", @{$filelist{$run}};
close L;
Packages
using CPAN module to search and install modules:perl -MCPAN -e 'shell'type "h" will show a list of commands
when installing a new module, it will need make, on Windows, you can use nmake which is available in Mircosoft's knowledge base (id: 132084)
install module to non-standard places:
perl Makefile.PL LIB=/home/foobar/mylib PREFIX=/home/foobar/mylibon how to install modules refer to http://www.cpan.org/misc/cpan-faq.html
Misc
some interesting web sites
http://www.perl.com/CPAN/misc/japhhttp://use.perl.org/quotes.txt
Find prime numbers
print "2 ".join " ", grep { $i = $_; eval eval {join "&&", map "$i%$_", 2..int sqrt $i + 1}} 3..100;
prime number using regexp from TPJ
print (((1 x $_)=~/^(11+)\1+$/)?"":"$_ ") for (2..100);
Fahrenheit to Celsius
($temp -= 32) *= 5/9;
random numbers
srandsrand (time ^ $$ ^ unpack "%L*", `ps axww | gzip`);Frequently called programs (like CGI scripts) that simply use "time ^ $$" for a seed can fall prey to the mathematical property that "a^b == (a+1)^(b+1)" - from perlfunc
Bloom Filter
http://www.perl.com/pub/a/2004/04/08/bloom_filters.htmlthere is an example on implementation using SHA1
sort ip address in different ways
#!/usr/bin/perl -w
my @ips = qw(
212.211.123.1
142.11.12.155
12.11.23.41
12.211.123.1
68.11.123.1
68.11.12.1
68.12.23.21
21.211.12.1
21.211.123.1
);
# Computing a single packed-string sortkey, cool, not by me
$\ = "\n";
my @sorted_ips = map
substr($_, 4) ,
sort map pack('C4' => /(\d+)\.(\d+)\.(\d+)\.(\d+)/)
. $_ , @ips;
print join("\n", @sorted_ips);
print;
# my stupid schwartizian transform
print join("\n", map {$_->[1]} sort {$a->[0] <=> $b->[0]} map {
@temp=split /\./, $_;
$test = "";
foreach (@temp) {$test = $test.(sprintf "%03d", $_);}
[(substr $test, 0, -1), $_];
} @ips);
print;
# another try
print join "\n", map { substr $_, 12; } sort map {
/(\d+)\.(\d+)\.(\d+)\.(\d+)/;
(sprintf "%03d%03d%03d%03d", $1, $2, $3, $4).$_;
} @ips;
print;
# this is not too bad
print join("\n", sort {
$a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; ($a1, $a2, $a3, $a4) = ($1, $2, $3, $4);
$b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; ($b1, $b2, $b3, $b4) = ($1, $2, $3, $4);
$a1 <=> $b1 || $a2 <=> $b2 || $a3 <=> $b3 || $a4 <=> $b4;
} @ips);
get min
from smthmy $min = [$x => $y] -> [$y <= $x];
get ip address
For Windowsprint `ipconfig` =~ /ip.+: (\d+\.\d+\.\d+\.\d+)/si?"$1\n":'';For Linux
print `/sbin/ifconfig` =~ /addr:(\d+\.\d+\.\d+\.\d+)/i?"$1\n":'';
calculate
I still don't know how to do it by shell
ls -s1 *root | perl -e 'while(<>){/\s*(\d+)\s+/;$t+=$1;}print $t'
solving sodoku
Sodokuperl distribution under Win32
http://www.activestate.com/ they also have python and tclbooks to start
Perl Programming Intermediate Perl and etc.All of these can be found on safari. (UI library has a subscription to it)
save a file
If you are using LWP::Simple, just use getstore
getstore($url, $filename);
or using get:
$file = get($url); binmode($file); ... then save the file
using Image::Magick
First, install ImageMagick. For Windows, the installer (6.3.3) now will setup the ppm module for ActiveState Perl. However, when I did this under Windows, in order to run it, I need to copy the "CORE_RL*.dll" files into "C:\Perl\site\lib\auto\Image\Magick" because perl will complain cannot load "Magick.dll" when you try to use this module.
A example to put 2 pictures (both have size = 640x480 ) side by side:
sub merge_png
{
my ($fname1, $fname2, $outname, $DEL) = @_;
my ($img, $img1, $img2);
my ($wid, $hgt) = (640, 480);
$img = Image::Magick->new(size => ($wid*2)."x".$hgt);
$img->Read("xc:white");
$img1 = Image::Magick->new();
$img1->Read($fname1);
$img2 = Image::Magick->new();
$img2->Read($fname2);
$img->Composite(image => $img2, gravity => 'West');
$img->Composite(image => $img1, gravity => 'East');
$img->Write(filename => $outname);
undef $img;
undef $img1;
undef $img2;
if ($DEL) {
unlink $fname1, $fname2 || die "unable to delete $fname1 and $fname2\n";
}
}
OpenGL
Under windows, a ppm package could be found at
or
http://www.bribes.org/perl/wopengl.html
Documentation for OpenGL is at opengl.org
My notes is here
DBI
good talk http://search.cpan.org/src/TIMB/DBI_AdvancedTalk_2004/index.htmPostgre SQL
when accessing array data, e.g. with the type "int[]", I get segfault when calling getrow_array to retrieve columns that contains any of the array data filed. I am using perl 5.8.0, DBI 1.38 and DBD::Pg 1.31 and PostgreSQL 8.1.2
It seems that there are people who share the same problem, below is an example:
http://www.arcknowledge.com/gmane.comp.lang.perl.modules.dbi.general/2003-12/msg00009.html
the fix is using a newer version of DBD::Pg
To get DBD:Pg on Windows, using ppm is better because the ppm below includes msvcr71.dll and the ssl libs:
The DBD-Pg ppm is now also available with the ssl dlls included: 5.8: ppm install http://dbdpgppm.projects.postgresql.org/DBD-Pg-5.8s.ppd 5.6: ppm install http://dbdpgppm.projects.postgresql.org/DBD-Pg-5.6s.ppd
install modules with non-root access
while in cpan, use
o conf makepl_arg "LIB=~/myperl/lib \
INSTALLMAN1DIR=~/myperl/man/man1 \
INSTALLMAN3DIR=~/myperl/man/man3 \
INSTALLSCRIPT=~/myperl/bin \
INSTALLBIN=~/myperl/bin"
about things other than perl module with non-root http://www.bugzilla.org/docs/2.22/html/nonroot.html
the cpan conf are saved in ~/.cpan/CPAN/MyConfig.pm
get version number of a module
print $MODULE::NAME::VERSION;
send mail
open SENDMAIL, "|/usr/sbin/sendmail -t" or die "$0: fatal: could not open sendmail: $!\n"; print SENDMAIL "To: user\@example.org\n"; print SENDMAIL "Subject: message\n\n"; print SENDMAIL "Message body\n"; close SENDMAIL;this is a buggy unportable unscalable error prone example
see http://sial.org/howto/perl/sendmail/
pack source code into executable
there are several ways to do it one tool is called pp : http://search.cpan.org/~autrijus/PAR-0.85/script/pp, it also works under Windows
for reference, see http://par.perl.org/
example
pp --gui -o win32.exe win32.pl
find uniq items
perl -F'\s+' -ane '$h{$F[3]}++; END{print join "\n", keys %h}' run6pp200-warnmap.txt
list crash record
perl -lne '/(\w{3}\s+\d+)/;$h{$1}++; END{print "$_ $h{$_}" for sort {$h{$a} <=> $h{$b}} keys %h}' watch-log.txt
-l option
perl -le 'print "Hello World"'
-i option
perl -i -pe 's/\bPHP\b/Perl/g' file.txt
(from perlrun)
some examples about slurping files
http://www.perl.com/pub/a/2003/11/21/slurp.html
print file list as a tree
My favorite font doesn't have the line drawing characters, so I used ASCII characters: "|", "-" and so on. The Term::ANSIColor doesn't work on Win32, but using Win32::Console::ANSI will solve the problem.
(this program also have some simple regexp support)
#!/usr/local/bin/perl -w
###################################################
#
# emulate the DOS "tree.com" program
#
# Ruizhe Yang, 20070813
#
###################################################
use strict;
use File::Basename;
use Getopt::Long;
eval {require Win32::Console::ANSI};
if ($@ && $^O =~ /win32/i) {
print "need Win32::Console::ANSI on Windows";
exit 1;
}
use Term::ANSIColor qw(:constants);
my %h;
my ($showfile, $showcount, $showcolor, $newmode) = (0, 0, 0, 0);
my ($cdir, $cfile) = (0, 0);
my ($re, $ire);
GetOptions("f" => \$showfile,
"c" => \$showcount,
"l" => \$showcolor,
"n" => \$newmode,
"i=s" => \$ire,
"r=s" => \$re);
if ($ire && $re) {
print "cannot use both -i and -r\n";
exit 1;
}
$re = '.' if (!$ire && !$re);
my @stack = ();
my ($DIR, $PATTERN);
if (!$ARGV[0] || -d $ARGV[0]) {
$DIR = $ARGV[0] || '.';
$PATTERN = '*';
} else {
$DIR = dirname $ARGV[0] || '.';
$PATTERN = basename $ARGV[0] || '*';
}
printdir($DIR, -1, 0);
print "\nFILES = $cfile, DIRS = $cdir\n\n" if $showcount;
sub printdir
{
my ($here, $level, $flag) = @_;
my $name = basename $here;
#$name = "[$name]" if !-d $here && $showfile;
$name = (-d $here)?BOLD.BLUE.$name.RESET:RED.$name.RESET if !$showcolor;
print calcstring($level, $flag), $name, "\n";
if (-d $here) {
my @dirlist;
for (grep {-d} <$here/*>) {
if (!$newmode ||
($newmode && (hasfile($_) ||
(($re && basename($_) =~ /$re/) ||
($ire && basename($_) =~ /$ire/i))))) {
$cdir++;
push @dirlist, $_;
}
}
if ($showfile) {
for (grep {!-d} <$here/$PATTERN>) {
if (($re && basename($_) =~ /$re/) ||
($ire && basename($_) =~ /$ire/i)) {
$cfile++;
push @dirlist, $_;
}
}
}
#@dirlist = sort @dirlist;
for my $idx (0..$#dirlist) {
my $subdir = $dirlist[$idx];
$stack[$level + 1] = ($idx == $#dirlist)?0:1;
my $temp = ($idx == $#dirlist)?1:0;
printdir($subdir, $level + 1, $temp);
}
}
}
sub calcstring
{
my ($level, $flag) = @_;
my $ret = '';
for (0..$level - 1) {
$ret .= $stack[$_]?"| ":" ";
}
$ret .= $flag?"`---":"|---" if $level > -1;
}
sub hasfile
{
my ($path) = @_;
for (keys %h) {
return 1 if ($path eq $_);
}
my @temp = glob("$path/$PATTERN");
my $flag = ($#temp + 1)?1:0;
if ($flag) {
$flag = 0;
for (@temp) {
$flag = 1 if (($re && basename($_) =~ /$re/) ||
($ire && basename($_) =~ /$ire/i));
}
}
if ($flag) {
$h{$path} = 1;
return 1;
} else {
for my $dir (grep {-d} <$path/*>) {
for (keys %h) {
return 1 if ($dir eq $_);
}
if (hasfile($dir)) {
$h{$dir} = 1;
return 1;
}
}
return 0;
}
}
__END__
time zone
http://www.aota.net/Script_Installation_Tips/perltime.php4
HTML entity
http://www.w3schools.com/tags/ref_entities.asphttp://www.owasp.org/index.php/Cross_Site_Scripting
ppm with proxy under Windows
need an environment var called http_proxy with format like this "http://ip:port", then restart your shell if you are using one
ppm Repositories
http://win32.perl.org/wiki/index.php?title=PPM_Repositories
.pl association under Win32
use ftype
ASSOC .pl=PerlScript FTYPE PerlScript=c:\strawberry\perl\bin\perl.exe %1 %*
Unicode
refer to perlunicode: e.g. to match Chinese characters:
/\p{Han}+/
also, \p{P} for punctuations.
xss
libgd on Windows
ppm install http://theoryx5.uwinnipeg.ca/ppms/GD.ppd
make a service under Windows
Win32::Daemon is good enough
a example is at http://www.roth.net/perl/scripts/scripts.asp?DirMon.pl
Basically, Win32::Daemon::State() is used to conduct the flow of the program. Before you run the service, create/remove needs to be performed.
This module can be installed with ppm if you have ActiveState Perl. It can also be downloaded at ftp://www.roth.net/pub/ntperl/Daemon/
CPAN ppm search
http://cpan.uwinnipeg.ca/htdocs/faqs/cpan-search.htmlproxy setup for CPAN and PPM
- proxy is http://proxy.sec.bnl.local:3128
- CPAN.pm : Set the ftp_proxy environment variable
- PPM : Set the HTTP_proxy environment variable
Windows XP look GUI
by default, the GUI you get from wx library is not with XP look and feel;
the different looks of controls such as buttons are the difference between version 5 and 6 of comctl32.dll
http://search.cpan.org/~mbarbon/Wx-0.79/Wx.pm
install wxWidgets and wxPerl for Win32 : http://search.cpan.org/dist/Wx/docs/INSTALL.pod
to get native XP look, create a file "perl.exe.manifest" where perl.exe is.
The file's content is like this
http://search.cpan.org/~mbarbon/Wx-0.79/Wx.pm
more reference
http://blogs.msdn.com/junfeng/archive/2004/11/02/251318.aspx
Win32 Console
http://search.cpan.org/~jdb/libwin32-0.28/Console/Console.pm
Another perl distribution for Win32
ImageMagick to convert mpeg movie from jpg files
Shell cannot pass too many paramters, so use this:
convert \*.jpg test.mpg
find module location
perldoc -l Module::Name
put commas into a number for every 3 digits
my $str = '12345678901234';
1 while ($str =~ s/(\d)((\d{3},)*)(\d{3})$/$1,$2$4/);
print "$str\n";
make Tk window stay on top
Tk::StayOnTop
implemented by calling Win32 API function under Windows
Win32::GUI compilation problem
got the following error because the file in the archive is readonly:
Failed to open GUI.rc for writing at ./build_tools/updateRC.pl line 63. Checking RC file ... NMAKE : fatal error U1077: 'C:\Windows\system32\cmd.exe' : return code '0xd'
http://www.nabble.com/cygwin-patches-for-1.05-td11846508.html
compiling wxWidgets under Vista using mingw and msys
to install wxWidgets follow the instruction found at docs/msw/INSTALL
use ppm to get Wx modul
range operator
from pleac at sf.net
#-----------------------------
while (<>) {
if (/BEGIN PATTERN/ .. /END PATTERN/) {
# line falls between BEGIN and END in the
# text, inclusive.
}
}
while (<>) {
if ($FIRST_LINE_NUM .. $LAST_LINE_NUM) {
# operate only between first and last line, inclusive.
}
}
#-----------------------------
while (<>) {
if (/BEGIN PATTERN/ ... /END PATTERN/) {
# line is between BEGIN and END on different lines
}
}
while (<>) {
if ($FIRST_LINE_NUM ... $LAST_LINE_NUM) {
# operate only between first and last line, but not same
}
}
#-----------------------------
# command-line to print lines 15 through 17 inclusive (see below)
perl -ne 'print if 15 .. 17' datafile
# print out all <XMP> .. </XMP> displays from HTML doc
while (<>) {
print if m#<XMP>#i .. m#</XMP>#i;
}
unicode in string literal
e.g. "\x{6d4b}\x{8bd5}" to get this string:
print sprintf('\\x{%x}', ord) for split '', $yourstring
XS and C++
http://www.johnkeiser.com/perl-xs-c++.html
open gz files
an example from perldoc - perlfunc:
$filename =~ s/(.*\.gz)\s*$/gzip -dc < $1|/; open(FH, $filename) or die "Can't open $filename: $!";
Win32 registry
http://www.xav.com/perl/site/lib/Win32/Registry.html
http://www.le-berre.com/perl/perlreg.htm
Open multiple putty sessions
A Tk interface to read all sessions from registry then run them all.
#!/usr/local/bin/perl -w
use strict;
use Win32::Registry;
use Tk;
use subs qw(RunSession RunAll);
my $PUTTY = 'C:\Users\ruizhe\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\putty.exe';
my $PUTTYKEY = 'Software\SimonTatham\PuTTY\Sessions';
my @SESSIONS;
my @CONFWIN = qw(0 1 1 1 1);
my $keys;
$::HKEY_CURRENT_USER->Open($PUTTYKEY, $keys) or die "cannot open $PUTTYKEY\n";
$keys->GetKeys(\@SESSIONS);
my $main = MainWindow->new;
$main->configure(-title => 'Putty start');
my @lblSession;
my @butStart;
my @txtWin;
$main->bind('<Alt-s>' => \&RunAll);
for my $i (0..$#SESSIONS) {
my $sessionName = $SESSIONS[$i];
$sessionName =~ s/%(\d\d)/chr(hex $1)/ge;
$lblSession[$i] = $main->Label(-text => $sessionName, -anchor => 'e');
$lblSession[$i]->grid(-row => $i, -column => 0, -sticky => 'ew');
$butStart[$i] = $main->Button(-text => 'run', -takefocus => 0, -command => sub {RunSession($i)});
$butStart[$i]->grid(-row => $i, -column => 2);
$txtWin[$i] = $main->Text(-width => 10, -height => 1, -wrap =>'none');
$txtWin[$i]->bind('<FocusIn>' => [$txtWin[$i], 'selectAll']);
$txtWin[$i]->bind('Tk::Text', '<Key-Tab>', 'focusNext');
$txtWin[$i]->bind('Tk::Text', '<Return>', \&RunAll);
$txtWin[$i]->insert('end', $CONFWIN[$i]);
$txtWin[$i]->grid(-row => $i, -column => 1);
}
$main->Button(-text => 'QUIT',
-width => 10,
-underline => 0,
-background => 'yellow',
-command => [$main => 'destroy'],
-takefocus =>0)->grid(-row => 0, -column => 3);
$main->Button(-text => 'START ALL',
-width => 10,
-underline => 0,
-background => 'red',
-foreground => 'white',
-command => \&RunAll,
-takefocus =>0)->grid(-row => 1, -column => 3);
MainLoop;
sub RunAll {
RunSession($_) for 0..$#SESSIONS;
}
sub RunSession {
my $i = shift;
my $sessionName = $SESSIONS[$i];
$sessionName =~ s/%(\d\d)/chr(hex $1)/ge;
for (0..$txtWin[$i]->get('1.0', 'end') - 1) {
my $cmd = "start \"\" \"$PUTTY\" -load \"$sessionName\"";
system($cmd);
}
}
System tray example
http://www.perlmonks.org/?node_id=342422
Perl6
some introspection example
http://blog.plover.com/prog/perl/Help.pm.html
PowerPoint
built from Win32::OLE, see
http://search.cpan.org/dist/Win32-PowerPoint/lib/Win32/PowerPoint.pm
there is one section explained how it's done
another example of manipulating PPT with Win32::OLE1
http://www.perlmonks.org/?node_id=491983
Find window under Win32
get thread id and process id with window handle:
use Win32::GUI (); my ($threadid, $procid) = Win32::GUI::GetWindowThreadProcessId($hwnd);
Find command line parameters and file name with process id
use Win32::Process::CommandLine
http://aspn.activestate.com/ASPN/Mail/Message/perl-win32-users/2166979
making new module
Use the Module::Starter module to build basic structure for a new module: (instead of h2xs)
module-starter --module=Parse::ISF --author="Ruizhe Yang" --email="razor@cpan.org"
see http://www.perlmonks.org/index.pl?node_id=158999
When using ExtUtils::MakeMaker, 'make distcheck' will check the files against the file MANIFEST and report anything different.
md5sum
in the rare case you don't have md5sum on your system but have Digest::MD5 (but usually you should try "openssl md5 < filename" first)
#!/usr/local/bin/perl -w use Digest::MD5; use strict; my $fn = shift; my $md5 = new Digest::MD5->new; open F, "$fn" or die "cannot open $fn"; binmode F; print "$fn ", $md5->addfile(*F)->hexdigest, "\n"; __END__
check byteorder
perl -MConfig -le 'print $Config{byteorder}'
rollback the cursor for a filehandle
seek FILEHANDLE,0,0
as in http://www.perlmonks.org/?node_id=15757
Migrate perl modules to different machines or backup, etc
use autobundle in CPAN module
http://www.bradandkim.net/?p=80