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/1565927168

perldoc

Always check out perldoc especially with perldoc -f function.

other useful doc

http://pleac.sourceforge.net/pleac_perl.html

http://learn.perl.org/

the 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 etc

a 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)

cheat sheet with examples

Another writeup

perlop in perldoc

PCRE

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/mylib
on 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/japh

http://use.perl.org/quotes.txt

http://www.perlmonks.org/

Perl history

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

srand
srand (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.html

there 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 smth
my $min = [$x => $y] -> [$y <= $x];

get ip address

For Windows
print `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

Sodoku

perl distribution under Win32

http://www.activestate.com/ they also have python and tcl

books 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

http://graphcomp.com/opengl

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.htm

Postgre 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.asp

http://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

http://ha.ckers.org/xss.html

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.html

proxy setup for CPAN and PPM

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

http://strawberryperl.com/

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

http://dev.perl.org/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

a web server

http://www.webmasterworld.com/forum13/1394.htm