TutorialonPerlBasics

PracticalExtractionandReportLanguage

By
SritharDurairajIBMIndia

Introduction

WhatisPerl?
Perlisaprogramminglanguage.PerlstandsforPracticalExtraction
andReportLanguage.Itisainterpreterlanguage.Itisallaboutsmall,
quickprogramsandlooselytypedlanguage.VersionsofPerlpriorto
5areveryoldandveryunsupported.

Speedofdevelopment
Editatextfile,andjustrunit.Noseparatecompilerneeded.
Power
Regularexpression.objects,sockets...everythingasystems
administratorcouldwant.Addthewealthofmodulesavailable
onCPAN(www.cpan.org)
Usability&Portability
PerlsupportsOOprogramming,Reusable,Packageetc.Perl
codeisplatformindependent.

FirstStep

Createaperlscript(*.pl)withfollowingline.printHello
World\n;Extentionshouldbe.plor.PL.
Savethefileandrunthefollowingcommandfromthefolder
wherethescriptfileexist.perlMyFirst_Perl.pl
SeetheoutputHelloWorldonthescreen.
Ifthefirstnonspacecharofalineis'#'thenthelineis
considerascomment.
Shebang
#!/usr/bin/perl
or
#!/usr/local/perl5/bin/perl
Exceptlastline,allotherlinesshouldendwith';'

ABCDofPerlProgramming

Variables
TherearethreebasictypeofvariablesinPerl.Looselytyped
language.Alltypeofvariablesareprefixedwithasymboleto
denotethetypeofvariable(Scalar$,Array@,Associated
Array%).
Examplescripttodemonstrateonhowtohandlethevariables.

======================================================
#ArrayExample
@names=("Muriel","Gavin","Susanne","Sarah","Ram");
print"Theelementsof\@namesare@names\n";
print"Thefirstelementis$names[0]\n";
print"Thethirdelementis$names[2]\n";
print'Thereare',scalar(@names),"elementsinthearray\n";
#ScalarExample
$num=10;
$num++;
$num;
$num+=3;
print"\$numis$num\n";

Cont...

#AssociatedArraryExample
%countries=('NL','TheNetherlands','BE','Belgium','DE','Germany','MC','Monaco','ES','Spain');
print"Enterthecountrycode:";
chop($find=<STDIN>);
$find=~tr/az/AZ/;
print"$countries{$find}hasthecode$find\n";
foreach(keys%countries){
print"Thekey$_contains$countries{$_}\n";
}
while(($code,$name)=each%countries){
print"Thekey$codecontains$name\n";
}
==============================================================
%my_hash

@my_array

IndexNo

Value

Key

Value

TheNetherlands

NL

TheNetherlands

Belgium

BE

Belgium

Germany

DE

Germany

Monaco

MC

Monaco

Spain

EC

Spain

print"$my_array[1]";

print"$my_hash{'BE'}";

Arrays
*)scalar(@my_array):returnsnumberofelementsinthearray.
*)$#my_array:returnsmaximumnumberofindexi.e.
$#my_array==scalar(@my_array)1
*)Lastelementofanarray:$my_array[$#my_array],
@my_array[1]
*)Individualelements:$names[$x],@names[0..2,4]
*)FunctionsonArrays:push,pop,shift,unshift,splice

Function

Description

Syntax

push

Addsvaluetotheendofthearray

push(@target,add1,add2,
@source[2..4])

pop

Removesandreturnsvaluefromendof
array

$last=pop(@names)

shift

Removesandreturnsvaluefrombeginning $first=shift(@names)
ofarray

unshift

Addsvaluetothebeginningofarray

unshift(@names,$first);

splice

Removeand/orAddelementsfromthe
targetarray.If3rdparameteris0thenitdo

notremoveanyelementfromtarget.

splice(@target,offset,
no_of_element_to_remove,
@add[2..4])

SnippettodemonstrateArraymodification
@names=("Muriel","Gavin","Susanne","Sarah","Ram");
print"Names::@names\n";
print"Numberofelements::",scalar(@names),"MaxIndex::$#names\n";
print"Thefirst,second,thirdandfifthelementsare@names[0..2,4]\n";
print"a)Thelastelementis$names[$#names]\n";
#oneway
print"b)Thelastelementis@names[1]\n"; #differentway
$last=pop(@names);
print"POP::Names:@names\nLast:$last\n";
push(@names,$last);
print"PUSH::Names:@names\nLast:$last\n";
$first=shift(@names);
print"SHIFT::Names:@names\nFirst:$first\n";
unshift(@names,$first);
print"UNSHIFT::Names:@names\nFirst:$first\n";
@cities=("Brussels","Hamburg","London","Breda");
splice(@names,1,2,@cities[1..3]);
print"SPLICE::Names::@names\nCITIES::@cities\n";

AssociatedArray
Action

Example

Assigning

$countries{PT}='Portugal';
or
%countries=('NL','Netherlands','BE','Belgium');

Deleting

delete$countries{NL};

Allthekeys

printkeys%countries;

Allthevalues

printvalues%countries;

ASliceofHash

print@countries{'NL','BE'};

Howmanyelements?

printscalar(keys%countries);

Doesthekeyexist?

print"It'sthere!\n"ifexists$countries{'NL'};

IterationintheFORloop

foreach(keys%countries)
{print"Thekey$_contains$countries{$_}\n";}
or
print"Thekey$_contains$countries{$_}\n"foreachkeys
%countries;

IterationintheWHILEloop

while(($code,$name)=each%countries)
{print"Thekey$codecontains$name\n";}

or
print"Thekey$codecontains$name\n"while($code,

ArithmeticOperators

Operators

Operator

Description

Example

Addition

$c=$a+$b

Subtraction

$c=$a$b

Multiplication

$c=$a*$b

Division

$c=$a/$b

**

Exponents

$c=$a**$b=>7**7=49

Modulus

$c=$a%$b=>7%7=0

AssignmentOperators&Stringconcatenationoperator
Operator

Description

Example

+=

Addition

$a+=$b

Subtraction

$a=$b

*=

Multiplication

$a*=$b

/=

Division

$a/=$b

**=

Exponents

$a**=$b=>$a**=7

%=

Modulus

$a%=$b=>$a%=7

RelationalOperators
Operator

Example

Defined

Result

==,eq

5==5

Test:Is5equalto5?

True

Test:Is7notequalto2?

True

Test:Is7lessthan4?

False

Test:Is7greaterthan4?

True

Test:Is7lessthanorequalto11?

True

Test:Is7greaterthanorequalto11?

False

5eq5
!=,ne

7!=2
7ne2

<,lt

7<4
7lt4

>,gt

7>4
7gt4

<=,le

7le11

LogicalOpertors
>=,ge
7>=11
Operator
&&,and

7<=11

||,or

Defined
7ge11
AssociatestwovariablesusingAND

AssociatestwovariablesusingOR

Example
if(($x&&$y)==5)...
if(($x||$y)==5)...

IFloop

ConditionalLoops

if(Booleanexpression)
{Statement1;}
elsif(Booleanexpression)
{Statement2;}
else
{Statement3;}
Example:
if($x==7||$yeq"perl")
{print"X::$xY::$y\n;}
elsif($x==6&&$yeq"perl")
{print"X::$xY::$y\n;}
else
{print"Nomatch;}

FORloop
for($x=0;$x<=$#names;$x++)

{print"Index::$xValue::$names[$x]\n;}


print"$name\n"foreach$name(@names);
print"Thekey$_contains$countries{$_}\n"foreachkeys%countries;
print"Name::$_"for(@names);
for$i(55..75){printchr($i);}ORfor(55..75){printchr($_);}

WHILEloop
while(<booleanexpression>)
{statement1}
while($count<=7)
{print"Count::$count\n";$count++;}
print"Thekey$codecontains$name\n"while($code,$name)=each%countries;
while(<FILE_HANDLER>)
{chomp($_);print"LineNO:$.Line::$_\n);}

$dir=shift||'.';
opendirDIR,$dirordie"Can'topendirectory$dir:$!\n";

while($file=readdirDIR)
{print"Foundafile:'$file'\n";}

NEXT

Placeitinsidetheloop.itwillstopthecurrentiterationandgoontothenextone.

CONTINUE
Executedaftereachloopiterationandbeforetheconditionalstatementisevaluated.A

goodplacetoincrementcounters.

LAST
Laststopstheloopingimmediately(likebreak).

REDO
Redowillexecutethesameiterationoveragain.

Example:

$count=0;$redo=0;
while($count<=7){
if($count==4)

{print"SkipFour!\n";next;}
print"$count\n";
if($redo==0&&$count==2)
{$redo=1;redo;}
lastif$count==6;
}
continue
{$count++;};

TheTruthAccordingtoPerl

TherearemanyPerlfunctionswhichtestforTruth.Someareif,while,
unless.Soitisimportantyouknowwhattruthis,asdefinedbyPerl.
Therearethreemainrules:

1.Anystringistrueexceptfor""and"0".
2.Anynumberistrueexceptfor0.Thisincludesnegativenumbers.
3.Anyundefinedvariableisfalse.Aundefinedvariableisonewhich
doesn'thaveavalue,iehasnotbeenassignedto
Example:

&isit;#$test1isatthismomentundefined
$test1="hello";&isit;#astring,notequalto""or"0"
$test1=0.0;&isit;#$test1isnowanumber,effectively0
$test1="0.0";&isit;#$test1isastring,butNOTeffectively0!
subisit
{
if($test1){print"$test1istrue\n";}#tests$test1fortruthorno

else{print"$test1isfalse\n";}#elsestatementifitisnottrue
}

$name
='Mark';
$goodguy='Tony';
if($name==$goodguy){
print"Hello,Sir.\n";
}else{
print"Begone,evilpeon!\n";
}
Somethingseemstohavegonewronghere.ObviouslyMarkisdifferenttoTony,sowhydoes
perlconsiderthemequal?
MarkandTonyareequalnumerically.Weshouldbetestingthemasstrings,notasnumbers.
Todothis,simplysubstitute==foreqandeverythingwillworkasexpected.
$foo=291;$bar=30;
if($foo<$bar)
{print"$fooislessthan$bar(numeric)\n";}
if($foolt$bar)
{print"$fooislessthan$bar(string)\n";}
The'lt'operatorcomparesinastringcontext,andofcourse<comparesinanumericcontext.
Alphabetically,thatisinastringcontext,291comesbefore30.Itisactuallydecidedbythe
ASCIIvalue,butalphabeticallyiscloseenough

Comparisonoperatoraccordingtodatatype
Comparison

Numeric

String

Equal

==

eq

NotEqual

!=

ne

Greaterthan

>

gt

Lessthan

<

lt

Greaterthanorequalto

>=

ge

Lessthanorequalto

<=

lt

TheGoldenRuleofComparisons

*ifyouaretestingavalueasastringthereshouldbeonlylettersin
yourcomparisonoperator.
*ifyouaretestingavalueasanumberthereshouldonlybenonalpha
charactersinyourcomparisonoperator
*Youcantestnumbersasstringandviceversa.Perlnevercomplains.

Subroutines

InPerl,subroutinesarefunctionsaresubroutines.

Subroutinescantakeparametersanditcanreturnvalues.Thereisno
declarationofsubroutineorfunctioninPerl.
subName
{
my($v1,$v2..$vn)=@_;
.....
return($var1,$var2);(or)return(\@a1,\@a2);
}
my($var1,$var2)=&Name($v1,$v2,@v3);print"V1::$var1,V2::$var2\n";
ormy($a1,$a2)=&Name($v1,$v2,@v3);print"A1::@$a1,A2::@$a2\n;
or&Name($v1,$v2,@v3);

Parameterspassedtoasubroutinesarestoredinaspecialarrayvariable
'@_',Commandlineparametersarestoredinaspecialarrayvariable
'@ARGV'.

Subroutinescanreturn(oneoremore)scalar,(oneormore)array
references.

Namespace&VariableScope

Namespaceisnothingbutacollectionofvalididentifiersinthecurrent
scopeoftheprogramorcode.

Scopingreferstovisibilityofvariables.Adynamicvariableiscreatedvia
local()andisjustalocalvalueforaglobalvariable,whereasalexical
variablecreatedviamy()ismorelikeCauto.
$myvar=10;$localvar=10;
print"Before=>My::$myvarlocal::$localvar\n";
&sub1();
print"After=>My::$myvarlocal::$localvar\n";
subsub1#myvar=20localvar=20

{my$myvar=20;local$localvar=20;print"sub1:My:$myvarlocal:$localvar\n";&sub2();}sub
sub2#myvar=10localvar=20
{print"sub1:My:$myvarlocal:$localvar\n";}

The''usestrict''pragmawillenforcethatallvariablesareeitherlexical,or
fullclassifiedbypackagename.
#!/usr/bin/perl
usestrict;
my$x=10;#youcannotusesimple$x=10
print"X::$x\n;

Snippettoexplainthesubroutine

$x=10;$y=20;$z=30;$area=0;
&printXY();
&swap();
&printXY();
&printMyXY();
my($area,$vol)=&area($x,$y,$z);
print"Area::$areaVol:$vol\n";
my($w1,$w2)=&wordfunc("HelloWorld"); #Assignthearrayreferencestoscalars
print"@$w1and@$w2\n"; #deference,ieaccess,thearraysreferredto
subswap
{$t=$x;$x=$y;$y=$t;}
subprintXY
{print"XY::X=>$xY=>$y\n";}
subprintMyXY
{my$x=100;my$y=200;print"MyXY::X=>$xY=>$y\n";}
subarea
{my($x,$y,$z)=@_;my$area=$x*$y;my$vol=$x*$y*$z;return($area,$vol);}

subwordfunc
{my$phrase=shift;
my(@words,@word1,@word2); #declarethreevariableslexically
@words=split/\s+/,$phrase; #splitthephraseonwhitespace
@word1=split//,$words[0]; #createarrayoflettersfromthefirstword
@word2=split//,$words[1]; #andthesecond

return(\@word1,\@word2); #returnreferencestothetwoarraysscalars
}

Q(uote)functions&UserInput

Therearefourquotefunctionsinperl.
qwQuotewords
qqDoublequote
qSinglequote
qxSinglequoteandexecutethesystemcommand

my@arr=qw(onetwothree);#equaltomy@arr=('one','two','three')
my$foo=7;
my$q=q(itis'worth'$foo);
my$qq=qq(itis"worth"$foo);
my$who=qx(whoami);
print"ARR::@arrq::$qqq::$qqWHO::$who\n";

UserInputi.e.readstdinfilehandler

%countries=('NL','TheNetherlands','BE','Belgium','DE','Germany','MC','Monaco','ES','Spain');
print"Enterthecountrycode:";
chomp($find=<STDIN>);
$find=~tr/az/AZ/;
print"$countries{$find}hasthecode$find\n";

FalsevaluesVsExistence

Perldoeshaveafunctiontotestifsomethingexists.Existence,inPerlterms,meansdefined.

InPerl,wecandeleteascalarvariableusing'undef'.Todeleteakeyvaluepairfromahashusedelete
$arr{'key'}.
$car="HondCity";
&CheckCar;
$car="";&CheckCar;
undef$car;&CheckCar;
subCheckCar
{
print"Caristrue!$car\n"if$car;
print"Carexists!!$car\n"ifdefined$car;
}

Multidimensionarray
my@arr=([1,2,3,'four'],['one','two','three',4]);
print"arr[0][0]=$arr[0][0]\n";
my@row1=qw(000102);
my@row2=qw(101112);
my@row3=qw(202122);
my@arr=(\@row1,\@row2,\@row3);
for($i=0;$i<3;$i++)
{
for($j=0;$j<3;$j++)
{print"arr[$i][$j]=$arr[$i][$j]\n";}
}

FileOperations

InPerl,wecanperformfollowingfileoperations
read,write,append,writewithautobackup.
Read:
my$file="myfile.txt";
openRF,$fileordie"Cannotopen$file:$!\n";
print"LINE:$.is:$_"while(<RF>);
Write:
my$file="myfile.txt";
openOUT,">$file"ordie"Cannotwrite$file:$!\n";
for$i(1..10)
{printOUT"$i:Thetimeisnow:",scalar(localtime),"\n";}
closeOUT;
Append:
my$file="myfile.txt";
openOUT,">>$file"ordie"Cannotwrite$file:$!\n";
for$i(11..15)
{printOUT"$i:Thetimeisnow:",scalar(localtime),"\n";}
closeOUT;

ARGV:
perlmyscript.plmyfile.txt
printwhile<>;orprint<>;

Writeafilewithanautoback.Followingcodedemonstratethesame.
@ARGV="myfile.txt";
$^I=".bk";#letthemagicbegin
while(<>){
tr/AZ/az/;#anothernewfunctionsneakedin
print;#thisgoestothetempfilehandle,ARGVOUT,
#notSTDOUTasusual,sodon'tmesswithit!
}

*)Thenameofthefiletobeinplacededitedistakenfromthefirstelementof@ARGV.Inthiscase,
thatismyfile.txt.Thefileisrenamedtoitsexistingnameplusthevalueof$^I,iemyfile.txt.bk
*)Thefileisreadasusualbythediamondoperator<>,placingalineatatimeinto$_.
*)Anewfilehandleisopened,calledARGVOUT,andnoprizesforguessingitisopenedonafile
calledmyfile.txt.Theoriginalmyfile.txtisrenamed.
*)TheprintprintsautomaticallytoARGVOUT,notSTDOUTasitwouldusually.

Readafilewitharecordorlinedelimiterotherthendefaultnewline
char.
$SHOP="shop.txt";
$/="\n\n";
openSHOPordie"Can'topen$SHOPforread:$!\n";
@list=<SHOP>;#dumps*all*of$SHOPinto@list
foreach(@list){
print"Itemsare:\n$_\n\n";
}

Printparagraphsusing<<TAG
$var='variableinterpolated';
print<<PRT;
Thisisalonglineoftextwhichmightbetoolongtofitonjustoneline
andIwasright,itwastoolongtofitononeline.Infact,itlookslike
itmightverywelltakeuptoFOUR,yesFOURlinestoprint.
Thisisvar"$var'
PRT

Readdirectories,Directoriesarespecialfiles.Aslikenormalfiles,we
canreaddirectoryentries.Therearetwofamouswaystoreada
directoryentries.
<*>

readdir

$dir=shift||'.';
$type=qq(txt);
chdir$dirordie"Can'tchdirto$dir:$!\n";
while(<*>)
{
print"Foundafile:$_\n"ifT;
}
print"\nNOWONLYTEXT(*.txt)FILE
ONLY\n\n";
while(<*.$type>)
{print"Foundafile:$_\n";}

$dir=shift||'.';
opendirDIR,$dirordie"Can'topen
directory$dir:$!\n";
while($file=readdirDIR){
nextif$file=~/^\./;
print"Foundafile:'$file'\n"ifT"$dir/
$file";
}
closedirDIR;

InvokeSystemCommandorProcess
Perlcanstartexternalcommands.Therearefivemainwaystodothis.
*system
*exec
*CommandInput,alsoknownas`backticks`
*Pipingdatafromaprocess
*Quoteexecute(qx)
EXEC

'exec'stopsthecurrentperlscriptandstartstheexternalcommandorprocess.Ifitcan'tstarttheexternal
process,itshouldreturnwithanerrorcode.TheexecfunctiondoesworkproperlyonthestandardPerl
distribution.Thisdoesn'tworkproperlyunderPerlforWin32.

SYSTEM

'system'switchtheprocesscontextfromperlscripttotheexternalprocess.Soyoucanseetheoutputof
externalprocess.Controlcomesbacktocallingperlscriptoncetheprocesshascompleted.Notsowithexec,
whichwillterminateyourperlscriptifitissuccessful.Successfulsystemcallreturns0.Anunsuccessfulone
returnsavaluewhichyouneedtodivideby256togettherealreturnvalue.
system('whoami');print"\n\nResult:$?\n\n";

Backticks

These``aredifferentagaintosystemandexec.Theyalsostartexternalprocesses,butreturntheoutputofthe
process.

$user=`whoami`;print"Useris$user\n";

OpeningaProcess

Theproblemwithbackticksisthatyouhavetowaitfortheentireprocesstocomplete.Thisisa
bigproblemifyouhavelargereturncodesorslowprocesses.
Wecanopenaprocess,andpipedatainviaafilehandleinexactlythesamewayyouwould
readafile.Thecodebelowisexactlythesameasopeningafilehandleonafile,withtwo
exceptions
1.Weuseanexternalcommand,notafilename.That'stheprocessname,inthiscase,'lsl'.
2.Apipe,ie|isappendedtotheprocessname.
openLIST,"lsltr|"ordie"Cannotexecutelsltr:$!";
while(<LIST>)
{print"$.$_";}

Quoteexecute

Anythingwithinqx()isexecuted,anddulyvariableinterpolated.systemoutputstheresultof
thecommandtothescreenwhereasqxdoesnot.
while(<*.txt>)
{
print"$_WC::",qx(wcl$_),"\n";
}

Whentouseexternalcalls

YoushouldusePerlfunctionswherepossibleratherthancalling
externalprogramsbecausePerl'sfunctionsare
*portable
*faster
*don'tusuallyrequireregexingtofindtheresultyouwant
*don'trelyonoutputinaparticularformat,whichmightbechanged
inthenextversionofyourOSorapplication;
*morelikelytobeunderstoodbyaPerlprogrammerforexample,
$files=`ls`;onaUnixboxmeanslittletosomeonethatdoesn'tknow
thatlsistheUnixcommandforlistingfiles,asdirisinWindows.
Avoidusingbackticks(``)allovertheplacewhensystemwilldo.
Youmightgetaverylargereturnvaluewhichyoudon'tneed.

InbuildFunctions

Perlhasnumberofinbuildfunctions.Followingarefewprimaryfunctions.
Split,Join,Grep,Map,Sort.

Split

'split'isusedtosplitthegivenstringbasedonaregex.1stargumentisaregexspecifyingwhattospliton,2nd
argumentisastring,whichwewanttosplitand3rdargumentisoptionalone,whichspecifynoofreturn
valuesfromsplitfunction.

$_='Piper:PA28:Archer:OOROB:Antwerp';
@details=split/:/,$_;
print"$_\n"foreach(@details);
@details=split/:/,$_,3;
print"$_\n"foreach(@details);
openRF,"mark.csv"ordie"cannotopenthefile$file:$!\n";
$,=',';
while(<RF>)
{printsplit/\|/,$_;}

Join

'join'isusedtojoinanarrayofelementswithadelimiter.1stargumentisadelimiterstring,remaining
argumentsaretobemergedasreturnvalue.

$sep=",";@arr=qw(onetwothree);
$join=join$sep,@arr,"four";

print"JOIN::$join\n";

Grep

'grep'isusedtopickamatchingstringoutofgivenarray.1stargumentisaregextoselectthe
string.2ndparameterisanarrayofstrings,outofwhichwehavetoselectmatchstrings.

@stuff=qw(flyingglidingskiingdancingpartiesracing);
@new=grep/ing/,@stuff; #Creates@new,whichcontainsmatching'ing'elements
$matched=grep/ing/,@stuff;
@sel_rep=grep{s/ing//if/^[gsp]/}@stuff;
printjoin":",@stuff,"\n";
printjoin":",@new,"\n";
print"Matchednoofelements::$matched\n";
print"Selectivereplace::@sel_rep\n";

Map
Mapworksthesamewayasgrep,inthattheybothiterateoveralist,andreturnalist.There
aretwoimportantdifferenceshowever
*)grepreturnsthevalueofeverythingitevaluatestobetrue;
*)mapreturnstheresultsofeverythingitevaluates.Thereturnvaluesaredependonthe
function(1stparameter)usedtoevaluatethelist.

@letters=(a,b,c,d,e);
@ords=mapord,@letters;
printjoin":",@ords,"\n";
@chrs=mapchr,@ords;
printjoin":",@chrs,"\n";

Owngrepandmapfunctions

1stparameterofgrepormapisafunction,whichisusedtoevaluatetheentriesofgivenlist.
Youcandefineyourownfunctiontoevaluatetheelements.Returnvalueofthefunctionis
usedbygrepormaptoreturnfinalresult.
@stuff=qw(flyingglidingskiingdancingpartiesracing);
printjoin":",@stuff,"\n";
@mapped=map{&isit}@stuff;
@grepped=grep{&isit}@stuff;
printjoin":",@mapped,"\n";
printjoin":",@grepped,"\n";
subisit
{
($word)=/(^.*)ing/;
if(length$word==3)
{return"ok";}
else
{return0;}
}

Sorting
'sort'isusedtosortarrayofelements,Wearegoingtoseethreetypeofsortsimplesort,
Numericsort,andsortingmultiplelists.

SimpleSort
%countries=('NL','The

Netherlands','BE','Belgium','DE','Germany','MC','Monaco','ES','Spain');
foreach(sortkeys%countries){
print"Thekey$_contains$countries{$_}\n";
}
foreach(reversesortkeys%countries){
print"Thekey$_contains$countries{$_}\n";
}

*keysreturnsalist
*sortexpectsalistandgetsonefromkeys,andsortsit
*reversealsoexpectsalist,soitgetsoneandreturnsit
*thenthewholelistisforeach'dover.

NumericSort

Simplesortcomparestheelementsasstring.Todonumericsort,youdefineyourown
functionusing$aand$bvariables.Youmustfollowperlstandardtodefineasortfunction.
*Youmustuse$a,$btocomparetwovalues.
*Return1if$aisgreaterthan$b
*Return1if$bisgreaterthan$a
*Return0if$aand$bareequal

%countries=('976','Mongolia','52','Mexico','212','Morocco','64','NewZealand','33','France');
foreach(sortsupersortkeys%countries)
{print"$_$countries{$_}\n";}
foreach(sort{$a<=>$b}keys%countries)
{print"$_$countries{$_}\n";}
subsupersort{
if($a>$b)
{return1;}
elsif($a<$b)
{return1;}
else
{return0;}
}

SortingMultipleLists

Youcansortseverallistsatthesametime.

%countries=('976','Mongolia','52','Mexico','212','Morocco','64','NewZealand','33','France');
@nations=qw(ChinaHungaryJapanCanadaFiji);
@sorted=sortvalues%countries,@nations;
foreach(@nations,values%countries){
print"$_\n";
}
print"#\n";
foreach(@sorted)

{print"$_\n";}

ImportantStringFunctioninPerl
Chop

Removesthelastcharacterfromastringirrespectiveofwhateveritis.

chop($var=<STDIN>);orchop($var);

Chomp

Removeslineendingcharactersfromastringorarrayofstrings.
NOTE:Itremovesonlythelineendingcharacter(\n).
chomp($var=<STDIN>);orchomp($var);

Eval

Evaluatesperlcode,thenexecutesit.Anyerrorsarereturnedinthe@avariable.
$a=10;$b=20;$c="\$a+\$b";
print"$c=",eval$c,"\n";#prints$a+$b=30

Index

ThisfunctionreturnsthepositionofthefirstoccuranceofthespecifiedSEARCHstring.IfPOSITION
isspecified,theoccuranceatorafterthepositionisreturned.Thevalue1isreturnediftheSEARCH
stringisnotfound.

indexSTRING,SEARCH,POSITION
indexSTRING,SEARCH

Length

Returnsthelengthofthestringinbytes.

lengthSTRING

Lc

Convertsallcharactersinthestringtolowercase.

$var=lcSTRING;

Lcfirst

Takesastringandretrunsitwiththefirstcharacterinlowercase.

$var=lcfirstSTRING;

Rindex

ThisfunctionreturnsthepositionofthelastoccuranceofthespecifiedSEARCHstring.If
POSITIONisspecified,theoccuranceatorbeforethepositionisreturned.Thevalue1is
returnediftheSEARCHstringisnotfound.
rindexSTRING,SEARCH,POSITION
rindexSTRING,SEARCH

Substr

Thisfunctionsupportsthreesetsofpassedvaluesasfollows:

substr(STRING,OFFSET)
Returnsallcharactersinthestringafterthedesignatedoffsetfromthestartofthepassedstring
substr(STRING,OFFSET,LEN)
Returnsallcharactersinthestringafterthedesignatedoffsetfromthestartofthepassedstringupto
thenumberofcharactersdesignatedbyLEN
substr(STRING,OFFSET,LEN,REPLACEMENT)
ReplacesthepartofthestringbeginningatOFFSETofthelengthLENwiththeREPLACEMENT
string.

Uc

Convertsallcharactersinthestringtouppercase.
ucString

Ucfirst

Takesastringandretrunsitwiththefirstcharacterinuppercase.
ucfirstString
Example:

$mypath=qq(c:\\dir1\\dir2\\dir3\\file.txt);
$file=substr($mypath,rindex($mypath,"\\")+1);
$path=substr($mypath,0,rindex($mypath,"\\")+1);
$drive=substr($mypath,0,index($mypath,":")+1);
$drive=ucfirst($drive);
$replace=substr($mypath,(length$mypath)3,3,"csv");
print"mypath=$mypathlength=",length$mypath,"\n";
print"Drive=$drivePath=$pathfile=$fileoffset=$offsetmypath=$mypathreplaced=$replace\n";

RegularExpression(PowerofPerl)

Regularexpressionisarulewritteninsytacticalnotion.Regexisshort
name.

SimpleRegularExpression
$string=~/pattern/;

print"CapitalofIndia?";
chomp($_=<STDIN>);
print"Youranswerwas:$_\n";
if($_=~/delhi/){
print"Correctanswer!!\n";
}
else
{print"YoubetterleaveIndiaplease:)\n";}

CasesenstivityofRegex
$string~=/pattern/i;

if($_=~/delhi/i)
{print"Correctanswer!!\n";}

CharacterClasses
Squarebracketsenclosessinglecharactertobematched.Youcanuse
morethenoneclasssetinanexpression.Youcanspecifyrangeof
characterstobematchedusing''i.e.AZ.Ifyouwanttomatcha
specialcharacter,youmustescapeiti.e.[\K].Negationcharacter
classisalsopossible[^sa].
@names=qw(KarlsonCarleonKarlaCarlaKarinCarinaeedanotherword);
print"@names\n";
foreach(@names){
if(/[KC]arl/){
print"SimpleMatch!/[KC]arl/::$_\n";}
if(/[KCZ]arl[sa]/)
{print"MatchMulticlass/[KCZ]arl[sa]/::$_\n";}
if(/[JL]ari/)
{print"Matchcharrange/[JL]ari/::$_\n";}
if(/[KCZ]arl[^sa]/)
{print"MatchNegation/[KCZ]arl[^sa]/::$_\n";}
if(/[\K]ee/)
{print"SpecialcharMatch/[\K]ee/::$_\n";}
}

Matchingatspecificpoints
Youcanmatchapatternatbeginningorendofgivenstring.Tomatch
atendofaline,use'$'attheendofsearchpattern.Tomatchapattern
atbeginningofaline,usecaret'^'atthebeginningofsearchpattern.
@mail_ids=qw([email protected]@[email protected]@gmail.com);
foreach(@mail_ids)
{print"gmailids::$_\n"if/gmail\.com$/;
print"Raja'sIDs::$_\n"if/^raja/i;}

Negatingtheregex
Ifyouwanttonegatetheentireregexchange=~to!~
@names=qw(KarlsonCarleonKarlaCarlaKarinCarinaeedanotherword);
print"@names\n";
foreach(@names){
if($_!~/[KC]arl/)
{print"Negate!~/[KC]arl/::$_\n";}
if(!/[KC]arl/)
{print"Negate~/[KC]arl/::$_\n";}
}

ReturningtheMatch
Toreturnamatchingpartofagivenstringenclosethepatternwithinparens.
$_='Myemailaddressis<[email protected]>.';
/<(raj)\@(netcat.co.in)>/i;
print"Foundit!$1at$2\n";

*,+moreflexibilityofregex
*means0ormoreofthepreviouscharacter
+means1ormoreofthepreviouscharacter

$_='Myemailaddressis<[email protected]>.';

print"Match1worked:$1:"if/(<*)/i;
$_='<Myemailaddressis<[email protected]>.';
print"Match2worked:$1:"if/(<*)/i;
$_='Myemailaddressis<[email protected]<<<<>.';
print"Match3worked:$1:"if/(<*>)/i;
$_='HTML<I>munging</I>timeishere<I>again</I>!.';
/<I>(.*)<\/I>/i;
print"Longmatch::$1\n";
/<I>(.*?)<\/I>/i;
print"Stingymatch::$1\n";

1)Match1istrue.Itdoesn'treturnanything,butitistruebecausethereare0<atstartofthestring.
2)Match2works.Afterthe0<atthestartofthestring,thereis1<sotheregexcanmatchthattoo.
3)Match3works.Afterthefailingonthefirst<,itjumpstothesecond.Afterthat,thereareplentymoreto

matchrightupuntiltherequiredending.
4)JustaddaquestionmarkandPerldoesstingymatching

TheDifferenceBetween+and*
Itisimportanttoknowthedifferencebetween+and*
$_='Thenumberis2200andthedayisMonday';
($star)=/([09]*)/;
($plus)=/([09]+)/;
print"Staris'$star'andPlusis'$plus'\n";
$_='Myemailaddressis<[email protected]>!.';
/<([^>]+)/i;
print"Foundit!$1\n";

1)That$starhasnovalue.Itmanagedtomatch0ormorecharactersfrom0to9attheverystartof
thestring.
2)Thesecondregexwith$plusworkedalittlebetter,becausewearematchingoneormore
charactersfrom0to9.Therefore,unlessone0to9isfoundthematchwillfail.Oncea09is
found,thematchcontinuesaslongasthenextcharacteris09,thenitstops.

Reusingthematch\1
'()'returnsthematchedstring,andItcanbereusedwithinthesameregex
toformapreviouslymatchedunknowstring.Forexample,ifwearenot
sureaboutwhatHTMLtagwehavetomatch,thenyoucanusethe
followingsnippet.
$_='HTML<I>munging</I>timeishere<I>again</I>!.';
/<(.*?)>(.*?)<\/\1>/i;
print"Foundit!$2\n";

Easywaytoescapingspecialcharacters
Ifyouwanttomatchthefollowing;http://www.cpan.org/thenthe
regexwouldbe/http:\/\/www\.cpan\.org\//.Tomakeitmoresimple,
Perlallowsyoutopickyourdelimiter,ifyouprefixitwith'm'.
m#http://www\.cpan\.org/#;Wecangofurthermoretoescapevery
thingbyquotingeverything.m#\Qhttp://www.cpan.org/\E#;The\Q
escapeseverythingupuntil\Eortheregexdelimiter.

SubsitutionandYetMoreRegexPower
Toreplacebitsofstring,forexample,'us'with'them'.s/Us/them/;It
replacesonlythefirstoccurance.Itmakeaglobalreplacementuse/g.
s/Us/them/g;Itfailtodoglobalreplacementbecausebydefaultregex
iscasesensitive,use/ig.s/Us/them/ig;Tomakeitmorefitchangeitas
followss/us([,.])/them\1/igors/\bus(\W)/them\1/ig;[\W]=[^\w].
$_='Us?Thebususuallywaitsforus,unlessthedriverforgetsus.';

print"\$_::$_\n";
s/Us/them/;print"s/Us/them/::$_\n";
s/Us/them/g;print"s/Us/them/g::$_\n";
s/Us/them/ig;print"s/Us/them/ig::$_\n";

$_='Us?Thebususuallywaitsforus,unlessthedriverforgetsus.';

s/us[,.]/them\1/ig;print"s/us[,.]/them\1/ig::$_\n";

'x'asanoperatoratprint.\dwhichmeansanythingthatisadigit,that
is09.\D,whichisanythingexcept09.Tonegateanyconstruct,
simplycapitaliseiti.e\W\Detc
print"Enteranumber:";

chop($input=<STDIN>);
if($input=~/\D/)
{print"Notanumber!!!!\n";}
else
{print'#'x18,"\n",'Youransweris',$inputx3,"\n",'#'x18,"\n";}

Findnumberofmatchesanddirectlyassignthematches.
$_='HTML<I>munging</I>timeishere<I>again</I>!What<EM>fun</EM>!';
print"\$_is$_\n";
$found=0;
$found++while/<i>.*?<\/i>/ig;
@words=/<i>(.*?)<\/i>/ig;
print"Found::$foundmatches,wordsare@words\n";

ParentheseswithORandefficientOR
YoucanuseORinyourregexalongwithparentheses.
/o(rd|ne|ld)/gi
Remembertheuseofparentheses,itstoresthematchsinthevariables
called$1,$2...$n.Ifyoudon'twanttostorethematcheswhenyouuse
ORthenuse
/o(?:rd|ne|ld)/g.
print"Givemeaname:";
chop($_=<STDIN>);
print"Goodname\n"if/Pe(?:tra|ter|nny)/;
print"Thematchis:$1:\n";#Thesecondprintstatementdemonstratesthatnothingis
captured

Matchingspecificamountsof...
Thebraces{}specifyhowmanyoftheprecedingcharactertomatchi.e.z{2}matches
exactlytwo'z's.

/z{3}/

3zonly

/z{3,}/

Atleast3z

/z{1,3}/
/z{4,8}/

1to3z
4to8z

print"Howmanylettersdoyouwanttomatch?";

chomp($num=<STDIN>);
print$_="Thelowestformofwitisindeedsarcasm,Idon'tthink.\n";
print"Matched\\w{$num,}:$1\n"if/(\w{$num,})/;
print"Matched\\w{$num,?}:$1\n"if/(\w{$num,}?)/;

Pre,Post,andMatch
Inaregex,wecangetaPrematch($`),Postmatch($'),andMatch($&)
$_='UglyBadGood';
/bad/i; #look,noparens!
print"Postmatch:$'\n";
print"Prematch:$`\n";
print"Match:$&\n";

RHSExpressions/eand/ee
Youcanhaveanexpressionontherighthandsideofareplacement
statementi.e.s/something/expression/eig.

$data="<FONTSIZE=2><FONTSIZE=4><FONTSIZE=6>";
$data1=$data;
print"$data\n";
$data=~s/(size=)(\d)/\1\2*2/ig;print"$data\n";

$data1=~s/(size=)(\d)/$1.($2*2)/eig;print"$data1\n";

$data='Thefunctionis<5funcA>';

$funcA='*2+4';
print"$data\n";
$data=~s/<(\d)(\w+)>/($1+2).${$2}/; #firsttime
print"$data\n";
$data='Thefunctionis<5funcA>';
$data=~s/<(\d)(\w+)>/($1+2).${$2}/e;
#secondtime
print"$data\n";
$data='Thefunctionis<5funcA>';
$data=~s/<(\d)(\w+)>/($1+2).${$2}/ee; #thirdtime
print"$data\n";

=~/^ENDofREGEX$/ige

Modules

Amoduleisapieceofcodewhichliveinaseparatescriptfileoutside
yourcode.

Forexample,youmightwritearoutinetosendemail.Youcouldthen
usethiscodeinseveralotherscriptwhereyouwanttosendemail.

Modulegivesusthereusabilityofexistingcode.

ThebasicPerlpackageincludesalargenumberofmodules.Thereare
hundredsmoreavailableonCPAN(www.cpan.org).

'useMODULE::SUB'isallwhatyouhavetodotouseanexisting
module.

Usercancreatehisownmodules(*.pm).

'uselibPATH'definesthepathofuserdefinedmodules.

'requirefile_name.pl'iskeywordwhichincludeorimportthefile
contentintoyourcode.Afterthe'require'line,youcanusethe

subroutinesinyourcodewhichareavailableinthefile.

packageMyModule;

usestrict;
useExporter;
usevarsqw($VERSION@ISA@EXPORT@EXPORT_OK%EXPORT_TAGS);
$VERSION=1.00;
@ISA=qw(Exporter);
@EXPORT=();
@EXPORT_OK=qw(func1func2);
%EXPORT_TAGS=(DEFAULT=>[qw(&func1)]
Both=>[qw(&func1&func2)]);
subfunc1{returnreverse@_}
subfunc2{returnmap{uc}@_}
1)Firstwegetanamespacebydeclaringapackagename.Thishelpsensureourmodule'sfunctionsandvariables
remainseparatefromanyscriptthatusesit.
2)Usestrictisaverygoodideaformodulestorestricttheuseofglobalvariables.
3)WeneedtousetheExportermoduletoexportourfunctionsfromtheMyModule::namespaceintothemain::
namespacetomakethemavailabletoscriptsthat'use'MyModule.
4)'usevar'Thispragma,onceusedtodeclareaglobalvariable,supersededby'our'declarations,availableinPerl
v5.6.0orlater.Thiswillpredeclareallthevariableswhosenamesareinthelist,allowingyoutousethemunder
"usestrict",anddisablinganytypowarnings.@ISAdefinestheMyModule'isa'Exporter

5)@EXPORTcontainsalistoffunctionsthatweexportbydefault,inthiscasenothing.Thelessyouexportby
defaultisbettertoavoidsaccidentallyclashingwithfunctionsdefinedinthescriptusingthemodule.Ifascript
wantsafunctionletitask.

6)@EXPORT_OKcontainsalistoffunctionsthatweexportondemandsoweexport&func1
&func2onlyifspecificallyrequestedto.
7)%EXPORT_TAGS.Forconveniencewedefinetwosetsofexporttags.The':DEFAULT'tag
exportsonly&func1;the':Both'tagexportsboth&func1&func2.Thishashstoreslabelspointing
toarrayreferences.Inthiscasethearraysareanonymous.
8)Weneedthe1;attheendbecausewhenamoduleloads,Perlcheckstoseethatthemodulereturns
atruevaluetoensureitloadedOK.Youcouldputanytruevalueattheendbut1isthe
convention.
#!/usr/bin/perlw
usestrict;
my@list=qw(I~Am~A~Perl~Hacker!);

#case1
#useMyModule;
#printfunc1(@list),"\n";
#printfunc2(@list),"\n";
#case2
#useMyModuleqw(&func1);
#printfunc1(@list),"\n";
#printMyModule::func2(@list),"\n";

#case3

#useMyModuleqw(:DEFAULT);
#printfunc1(@list),"\n";
#printfunc2(@list),"\n";

#case4
#useMyModuleqw(:Both);
#printfunc1(@list),"\n";
#printfunc2(@list),"\n";

Case1:Becauseourmoduleexportsnothingbydefaultwegeterrorsas&funct1and&funct2
havenotbeenexportedthusdonotexistinthemain::namespaceofthescript.
Case2:ThisworksOK.Weaskourmoduletoexportthe&func1sowecanuseit.Although
&func2wasnotexportedwereferenceitwithitsfullpackagenamesothisworksOK.
Case3:The':DEFAULT'tag*should*export&func1soyoumightexpecttheerrorhereto
concernamissing&func2.InfactPerlcomplainsabout&func1.Hmm,whatisgoingonhere.
TheDEFAULTtagnameisspecialandisautomaticallysetinourmodules%EXPORT_TAGS
hashlikethisDEFAULT=>\@EXPORT.
Case4:Wespecifiedtheexportofbothourfunctionswiththe':Both'thusthisworks.

Note:uselib'/my/dir'orBEGIN{push@INC,'/my/dir'}orBEGIN{unshift@INC,'/my/dir'}

TodenotethepathofyourperlmoduleifitisnotPWD'.'

DBIArchitecture(DBIModule)
TheDBIarchitectureissplitintotwomaingroupsofsoftware:the
DBIitself,andthedrivers.

usestrict;
useDBI;

my$conn;
my$dbh;
my$username="baan";
my$dbname="EUBAAN2P";
my$pwd="ssaerpdbx2511";
$conn='DBI:Oracle:'.$dbname;
$dbh=DBI>connect($conn,
$username,
$pwd,
{RaiseError=>1,AutoCommit=>0,ora_session_mode=>2}
)ordie"UnabletoconnecttoDatabase:$dbname,usinguser::$username\n
ERROR::$DBI::errstr\n";
if($dbh)
{my$sql=qq(selectsysdatefromdual);
my$date="noDate";
my$sth=$dbh>prepare($sql);
$sth>execute();
$sth>bind_columns(undef,\$date);
while($sth>fetch())
{print"\tdatafromoracle$dbname::dateis::$date\n";}
$sth>finish;
$dbh>disconnect();
print"SuccessfullyConnectedandDisconnectedfromDB::$dbname,usinguser::$username$usr";

Automaticerrorchecking
TheautomaticerrorcheckingcapabilitiesoftheDBIoperatesontwo
levels.ThePrintErrorhandleattributetellsDBItocallthePerlwarn()
functionandtheRaiseErrorhandleattributetellsDBItocallthePerl
die()functionuponerror,typicallycausingthescripttoimmediately
abort.{PrintError=>1,RaiseError=>1}.
BecausethestandardPerlfunctionsofwarn()anddie()areused,you
canchangetheeffectsofPrintErrorandRaiseErrorwiththe$SIG{_
_WARN__}and$SIG{__DIE__}signalhandlers.Similarly,adie()
fromRaiseErrorcanbecaughtviaeval{...}.

ErrorDiagnostics
$dh>err()returnstheerrornumberthatisassociatedwiththecurrent
errorflaggedagainstthehandle$dh.
$dh>errstr()returnsastringcontainingadescriptionoftheerror,as
providedbytheunderlyingdatabase.
$dh>state()returnsastringintheformatofthestandardSQLSTATE
fivecharactererrorstring.

Perl(i)threading

WhatIsAThreadAnyway?
Athreadisaflowofcontrolthroughaprogramwithasingle
executionpoint.Threadsareoneofthepiecesofaprocess.Every
processhasatleastonethread.With5.8,though,youcancreateextra
threads.

ThreadSafeModules
perldataisnotsharedamongthreadsbydefault.Modulesthatarenot
taggedasthreadsafeshouldbetested.Youshouldalwaysassumea
moduleisunsafeunlessthedocumentsaysotherwise.Evensomeof
thestandardmodulesaren'tthreadsafe.

BasicThreadSupport
YourprogramscanusetheConfigmoduletocheckwhetherthreads
areenabled.
$Config{useithreads}ordie"RecompilePerlwiththreadstorunthisprogram."

 CreatingThreads
usethreadsimportsallthepiecesyouneedtocreatebasicthreads.
usethreads;

$thr=threads>new(\&sub1);
subsub1{print"Inthethread\n";}

Thenew()methodtakesareferencetoasubroutineandcreatesanewthread,whichstarts
executinginthereferencedsubroutine.Controlthenpassesbothtothesubroutineandthecaller.
Youcanpassparameterstothesubroutineasbelow.
$thr=threads>new(\&sub1,"Param1","Param2",$Param3);
$thr=threads>new(\&sub1,@ParamList);
$thr=threads>new(\&sub1,qw(Param1Param2Param3));
create()isasynonymfornew()

WaitingForAThreadToExit
Threadcanreturnvalues.Towaitforathreadtoexitandextractany
valuesitmightreturn,youcanusethejoin().
usethreads;

$thr=threads>new(\&sub1);
@ReturnData=$thr>join;
print"Threadreturned@ReturnData";
subsub1{return"Fiftysix","foo",2;}

 IgnoringAThread
join()doesthreethings:itwaitsforathreadtoexit,cleansupafterit,
andreturnsfromthread.Ifyou'renotinterestedinthethread'sreturn
values&don'treallycarewhenthethreadfinishedthenusedetach().
usethreads;
$thr=threads>new(\&sub1);#Spawnthethread
$thr>detach;#Nowweofficiallydon'tcareanymore

SharedAndUnsharedData
Bydefault,nodataisshared.Whenanewperlthreadiscreated,all
thedataassociatedwiththecurrentthreadiscopiedtothenewthread,
andissubsequentlyprivatetothatnewthread.Tosharedataamong
threadsusing:sharedattribute.
usethreads;

usethreads::shared;
my$foo:shared=1;
my$bar=1;
threads>new(sub{$foo++;$bar++})>join;
print"$foo\n";#prints2since$fooisshared
print"$bar\n";#prints1since$barisnotshare

 Sharednonscalarvariables
Inthecaseofasharedarray,allthearray'selementsareshared,andfora
sharedhash,allthekeysandvaluesareshared.Thisplacesrestrictionson
whatmaybeassignedtosharedarrayandhashelements:onlysimple
valuesorreferencestosharedvariablesareallowedthisissothata
privatevariablecan'taccidentallybecomeshared.Abadassignmentwill
causethethreadtodie.
usethreads;
usethreads::shared;
my$var=1;
my$svar:shared=2;
my%hash:shared;
...createsomethreads...
$hash{a}=1;#allthreadsseeexists($hash{a})and$hash{a}==1
$hash{a}=$var#okaycopybyvalue:sameeffectasprevious
$hash{a}=$svar#okaycopybyvalue:sameeffectasprevious
$hash{a}=\$svar#okayareferencetoasharedvariable
$hash{a}=\$var#Thiswilldie
delete$hash{a}#okayallthreadswillsee!exists($hash{a})

Notethatasharedvariableguaranteesthatiftwoormorethreadstrytomodifyitatthesametime,
theinternalstateofthevariablewillnotbecomecorrupted.However,therearenoguarantees
beyondthis,asexplainedinthenextsection

 ThreadPitfalls:Races
Raceconditionsarecausedbyunsynchronizedaccesstoshareddata.
Withoutexplicitsynchronization,there'snowaytobesurethat
nothinghashappenedtotheshareddatabetweenthetimeyouaccessit
andthetimeyouupdateit.
usethreads;
usethreads::shared;
my$a:shared=1;
$thr1=threads>new(\&sub1);
$thr2=threads>new(\&sub2);
$thr1>join;
$thr2>join;
print"$a\n";
subsub1{my$foo=$a;$a=$foo+1;}
subsub2{my$bar=$a;$a=$bar+1;}

Whatdoyouthink$awillbe?Theanswer,unfortunately,is``itdepends.''Bothsub1()and
sub2()accesstheglobalvariable$a,oncetoreadandoncetowrite.Dependingonfactors
rangingfromyourthreadimplementation'sschedulingalgorithm

 Synchronizationandcontrol
Perlprovidesanumberofmechanismstocoordinatetheinteractionsbetweenthemselvesandtheir
data,toavoidraceconditionsandthelike.
Controllingaccess:lock()
Thelock()functiontakesasharedvariableandputsalockonit.Nootherthreadmaylockthe
variableuntilthevariableisunlockedbythethreadholdingthelock.Unlockinghappens
automaticallywhenthelockingthreadexitstheoutermostblockthatcontainslock()function.

usethreads;
usethreads::shared;
my$total:shared=0;
subcalc{
my$par=shift;
{
lock($total);
$total+=$par;
print"tInCALCotal=$total\n";
}
}
my$thr1=threads>new(\&calc,1);
my$thr2=threads>new(\&calc,10);
my$thr3=threads>new(\&calc,11);
$thr1>join;
$thr2>join;
$thr3>join;

print"total=$total\n";

1)lock()blocksthethreaduntilthevariablebeinglockedisavailable.Whenlock()returns,yourthread

canbesurethatnootherthreadcanlockthatvariableuntiltheoutermostblockcontainingthelockexits.

2)It'simportanttonotethatlocksdon'tpreventaccesstothevariableinquestion,onlylockattempts.the
advisoryfilelockingthatflock()givesyou.

3)Youmaylockarraysandhashesaswellasscalars.Lockinganarray,though,willnotblocksubsequent
locksonarrayelements,justlockattemptsonthearrayitself.

4)Locksarerecursive,whichmeansit'sokayforathreadtolockavariablemorethanonce.Thelockwill
lastuntiltheoutermostlock()onthevariablegoesoutofscope.

subdoit{
{
{
lock($x);#waitforlock
lock($x);#NOOPwealreadyhavethelock
{
lock($x);#NOOP
{
lock($x);#NOOP
lockit_some_more();
}
}
}#***implicitunlockhere***
}
}

 AThreadpitfall:DeadLocks
Locksareahandytooltosynchronizeaccesstodata,andusingthem
properlyisthekeytosafeshareddata.Unfortunately,locksaren't
withouttheirdangers,especiallywhenmultiplelocksareinvolved.
Considerthefollowingcode:
usethreads;

my$a:shared=4;
my$b:shared="foo";
my$thr1=threads>new(sub{
lock($a);
sleep20;
lock($b);
});
my$thr2=threads>new(sub{
lock($b);
sleep20;
lock($a);
});
1)Thisprogramwillprobablyhanguntilyoukillit.Theonlywayitwon'thangisifoneofthe
twothreadsacquiresbothlocksfirst.Aguaranteedtohangversionismorecomplicated,but
theprincipleisthesame.
2)Thisconditioniscalledadeadlock,anditoccurswhenevertwoormorethreadsaretrying
togetlocksonresourcesthattheothersown.

 Semaphores:SynchronizingDataAccess

Semaphoresareakindofgenericlockingmechanism.Intheirmostbasicform,theybehave
verymuchlikelockablescalars,exceptthattheycan'tholddata,andthattheymustbeexplicitly
unlocked.Intheiradvancedform,theyactlikeakindofcounter,andcanallowmultiplethreads
tohavethe'lock'atanyonetime.

usethreads;

useThread::Semaphore;
my$semaphore=newThread::Semaphore;
my$GlobalVariable:shared=0;
$thr1=newthreads\&sample_sub,1;
$thr2=newthreads\&sample_sub,2;
$thr3=newthreads\&sample_sub,3;
subsample_sub{
my$SubNumber=shift@_;
my$TryCount=10;
my$LocalCopy;
sleep1;

while($TryCount){
$semaphore>down;

$LocalCopy=$GlobalVariable;

print"$TryCounttriesleft4sub$SubNumber(\$GlobalVariableis$GlobalVariable)\n";
sleep2;$LocalCopy++;$GlobalVariable=$LocalCopy;$semaphore>up;
}}

$thr1>join;$thr2>join;$thr3>join;

 AdvancedSemaphores
Bydefault,semaphoresbehavelikelocks,lettingonlyonethreaddown()themat
atime.However,thereareotherusesforsemaphores.
Eachsemaphorehasacounterattachedtoit.Bydefault,semaphoresarecreated
withthecountersettoone,down()decrementsthecounterbyone,andup()
incrementsbyone.However,wecanoverrideanyorallofthesedefaultssimply
bypassingindifferentvalues.
usethreads;
useThread::Semaphore;
my$semaphore=Thread::Semaphore>new(5);
$thr1=threads>new(\&sub1);
$thr2=threads>new(\&sub1);
subsub1{
$semaphore>down(5);#Decrementsthecounterbyfive
#Dostuffhere
$semaphore>up(5);#Incrementthecounterbyfive
}
$thr1>detach;
$thr2>detach;

Ifdown()attemptstodecrementthecounterbelowzero,itblocksuntilthecounterislargeenough.Note
thatwhileasemaphorecanbecreatedwithastartingcountofzero,anyup()ordown()alwayschangesthe
counterbyatleastone,andso$semaphore>down(0)isthesameas$semaphore>down(1).Manyresources
thatyouwanttomanageaccessforcanbesafelyusedbymorethanonethreadatonce.

 Givingupcontrol
Therearetimeswhenyoumayfinditusefultohaveathread
explicitlygiveuptheCPUtoanotherthread.
Perl'sthreadingpackageprovidestheyield()functionthatdoesthis.
yield()isprettystraightforward,andworkslikethis
usethreads;

subloop{
my$thread=shift;
my$foo=50;
while($foo){print"inthread$thread\n"}
$threads>yield;
$foo=50;
while($foo){print"inthread$thread\n"}
}
my$thread1=threads>new(\&loop,'first');
my$thread2=threads>new(\&loop,'second');
my$thread3=threads>new(\&loop,'third')

 Someusefulthreadfunctions
threads>self
Thiswillreturnthethreadobjectforthecurrentthread.$threads
>tid
Thiswillreturntheidofthethread.ThreadIDsareintegers,with
themainthreadinaprogrambeing0.CurrentlyPerlassignsauniquetid
toeverythread.
threads>object(tid)
Thiswillreturnthethreadobjectforthethreadassociatedwiththe
specifiedtid.
threads>yield()
ThisisasuggestiontotheOStoletthisthreadyieldCPUtimeto
otherthreads.Youmaydousethreadsqw(yield)thenusejustabareyield
inyourcode.
threads>list()
Thiswillreturnalistofallnonjoined,nondetachedthreads

Pleaseseeproducerandconsumerscripttohaveacompleteexamplefor
threading.

 ImportantLinks
MailTutorial:
http://www.sthomas.net/robertsperltutorial.htm#159Anintroduction
Database(DBI):
http://oreilly.com/catalog/perldbi/chapter/ch04.html
Threading:
http://www.mathematik.uniulm.de/help/perl5/doc/perlthrtut.html
SpecialVariable:
http://www.kichwa.com/quik_ref/spec_variables.html

THANKYOU