Perl
Part 1
Recap of Datastructures
Complex Data structures Anon CDS -Hashes
Part 2
Regular Expressions
Subroutines & Files
Part 3
Modules
CPAN/DBI/CGI/N-w
-------------------------------------------------------
Perl identify the DS by the prefix symbol
Scalar - $ - a value
List - ()
Array - @
Hashes - %
define a lexical scalar - my $a;
default value scalar - undef
how to check for undef - if(defined($a)){ }
get input from keyboard - $a=<STDIN> # \n stops
@arr=<STDIN> # EOF stops
output to console - print STDOUT "Hello";
print "Hello";
Errors - print STDERR "message";
Uppercase of scalar - $name=uc($name);
Lowercase of scalar - $name=lc($name);
reverse of scalar - $name=reverse($name);
Length of scalar - $len=length($name);
Part of a string - $res=substr($str,index,len);
others fns - index($str,$char);
rindex($str,$char);
Operators:-
===========
comp num > >= < <= == != <=>
str gt ge lt le eq ne cmp
Branching statements:-
======================
if-else
if-elsif
unless-else ( ie Negated-if )
Note: flower braces are compulsory in PERL
unless(defined($a)) # if(!defined($a))
{
$a is uninit do this
}
Guess:-
-------
$a='bangalore';
$b='mangalore';
if($a == $b)
{
print "Equal\n";
}
else
{
print "UnEqual\n";
}
Loops:-
=======
while-loop
until-loop
do while loop
do until loop
for loop
foreach loop
break in perl is 'last'
continue in perl is 'next'
exit in perl is 'die'
ex1:
Input: $str='hello world of perl';
convert the first 3 chars to upper case
convert the last 3 chars to upper case
Output: $str='HELlo world of pERL';
sol:
print "Enter the string";
chomp($str=<STDIN>);
$first=uc(substr($str,0,3));
$betwn=substr($str,3,length($str)-6);
$last =uc(substr($str,-3));
$res=$first.$betwn.$last;
print "$res";
ex2:
Input: $str='sampled data was added';
First occurance of 'a' should be replaced as '1'
LAst occuurance of 'a' should be replaced as '2'
Output: $str='s1mpled data was 2dded';
$str='sampled data was added';
$a=index($str,'a');
$b=rindex($str,'a');
substr($str,$a,1,'1');
substr($str,$b,1,'2');
print "$str";
ex3:
Input: $str='having beautiful morning';
Output should printing each char veritically
for($i=0;$i<length($str);$i++)
{
print substr($str,$i,1),"\n";
}
OR
$i=0
while($res=substr($str,$i++,1))
{
print "$res\n";
}
until(!($res=substr($str,$i++,1)))
{
print "$res\n";
}
--------------------------------------------------------
foreach $i (10,20,30,40,50)
{
print "$i";
}
foreach(1..10)
{
print "$_";
}
$a=10;
$b=20;
$c=30;
$d=40;
foreach ($a,$b,$c,$d)
{
$_++;
}
print "$a $b $c $d";
Ex:
@arr=(10,20,30,40);
foreach (@arr)
{
$_++;
}
Ex:
@arr=('arun','chetan','hari','manu');
foreach (@arr)
{
print uc; # print uc($_);
}
--------------------------------------------------------
how to get help on any INBUILT FN:-
-----------------------------------
perldoc -f substr
How to get the help on ANY INBUILT VAR:-
----------------------------------------
perldoc -v "$$"
How to get help on perl library/ PERL MODULE:-
----------------------------------------------
perldoc Modulename
Quick Ref:-
------------
List of all inbuilt fns - perldoc perlfunc
List of all perl vars - perldoc perlvar
List of major features - perldoc perlcheat
List of tutorials - perldoc perl
----------------------------------------------------------
Variable Interpolation:-
========================
$a='bangalore';
$b='mangalore';
print "I have visited $a and $b\n";
print 'I have visited $a and $b';
----------------------------------------------------------
List:-
======
$a=10;
$b=20;
$c=30;
OR
1) ($a,$b,$c) = (10,20,30); # Assignment
2) ($a,$b)=(10,20); # Swap
($a,$b)=($b,$a);
3) ($a,$b)=(10,20,30,40,50,60,70)[-2,-1]; # list index
4) List constructor (1..10);
5) list of constant strings
('today','now','later','done');
OR
qw(today now later done);
# Single Quoted words
----------------------------------------------------------
Arrays:- ordered List
========
Define a EMPTY array : my @arr;
Define arr with elems : my @arr=(10,20,30,40,50);
first element : $arr[0];
last element : $arr[-1];
First 3 elements : @arr[0..2]; # ARRAY SLICE
whole array : @arr
LEGNTH OF ARRAY : $len = $#arr+1;
$len = @arr;
Delete first elem : shift(@arr);
Delete last elem : pop(@arr);
Delete in b.w : splice(@arr,4,1);
Delete ALL : undef(@arr);
Add at the START : unshift(@arr,LIST);
Add at the END : push(@arr,LIST);
Insert in b.w : splice(@arr,4,0,@new);
Traverse : for($i=0;$i<@arr;$i++){
print "$arr[$i]"; }
foreach (@arr){
print "$_";
}
Merge 2 arrays : @newarry = (@first , @second);
Compare 2 arrays : if(@arr1 ~~ @arr2)
Search for patt : grep(/pattern/,@arr);
map functions : map($_++,@arr);
split delim scalarvar: $str='hai hello world';
@arr=split(/ /,$str);
Array to scalar : @arr=(5,4,3,2,1);
$str=join('-',@arr);
Imp Libs : use List::Util qw(sum max min);
use Algorith::Diff;
sort strings : @arr=sort(@arr);
sort numbers : @arr=sort{$a <=> $b} @arr;
ex1:
Input : $str='hello world';
Output: $str='h-e-l-l-o- -w-o-r-l-d';
print join('-',split(//,$st));
ex2:
@arr=(20,50,10,40,30,60);
print the best two nos?
print '',(sort{$a<=>$b} @arr)[-2,-1];
ex3:
@arr=(10,20,30,40,50,60,70,80,90);
Reverse First 4 elements ?
Incr last 4 elements by 1 ?
print modified array
@arr=(10,20,30,40,50,60,70,80,90);
@arr[0..2]=reverse(@arr[0..2]);
map($_++,@arr[@arr-3..$#arr]);
print "@arr";
ex4:
$dob='12-1-2000'
>> Happy Birthday
>> Belated wishes
>> Adv wishes
($dd,$mm,$yy)=split(/-/,$dob);
$mon = (localtime(time))[4]+1;
if($mon == $mm)....
ex5: Input: $num=5623
Output: five six two three
@encode=qw(zero one two three four five six seven eight);
@arr=split(//,$num);
print "@encode[@arr]";
----------------------------------------------------------
Hashes:- Unordered List
=======================
Define a empty hash : my %hash;
Define with vals : my %hash=('a'=>1,'b'=>2,'c'=>3);
my %hash=qw(a 1 b 2 c 3);
get value of "a" : $hash{a};
get vals of a,b : @hash{a,b};
complete hash : %hash
Modify val of a key : $hash{a}=20;
Add a new key-val : $hash{d}=40;
Delete a key-val : delete($hash{a});
Search for a key : exists($hash{a});
get all keys : keys(%hash);
get all vals : values(%hash);
Traversal : foreach $i (keys(%hash)){
print "$i $hash{$i}\n";
}
while(($a,$b)=each(%hash)){
print "$a $b\n";
}
sort based on keys : @arr=sort keys(%hash);
sort based on vals : @arr=sort{$hash{$a} <=> $hash{$b}}
keys(%hash);
ex1:
%curr=('euro'=>80,'pounds'=>110,'dollar'=>63);
User inputs the currname:euro
if that curr is there
user inputs his amount : 10
Output 10 Euros = INR 800
if that curr is NOT-THERE
print all the currnames in veritcal order
print "Enter curr name:";
chomp($ans=lc(<STDIN>));
if(exists($curr{$ans}))
{
print "Enter the denom";
chomp($amt=<STDIN>);
$inr=$amt * $curr{$ans};
print "in INR = $inr";
}else{
print join("\n",keys(%curr));
}
ex2:
$str='sampled data was added in the program';
Which is the most repeated char ?
How many is it repeated ?
foreach (split(//,$str))
{
$hash{$_}++;
}
@arr=sort{$hash{$a}<=>$hash{$b}} keys(%hash);
ex3:
$str='hello';
h - 10
e - 5
l - 8
l - 8
o - 18
%hash;
@hash{'a'..'z'}=(1..26);
foreach (split(//,$str))
{
print "$_ $hash{$_}\n";
}
==========================================================
References:-
============
1)
$ref=\$num;
$$ref
2)
$ref=\@arr;
@$ref; # de-refer the complete ARRAY
$ref->[0]; # de-refer single element of the ARRAY
3)
$ref=\%hash;
%$ref; # De-refer the complete HASH
$ref->{a} # De-refer single element of the HASH
ex:
@arr1=(10,20,30,40,50);
$ref1=\@arr1;
@arr2=(1,2,3,4,5);
$ref2=\@arr2;
Output:
@arr1=(10,20,30,40,50);
@arr2=(1,2,3,4,5);
@new=(11,22,33,44,55);
u cannot use @arr1 & @arr2 names directly
for($i=0;$i<@$ref1;$i++)
{
push(@new,$ref1->[$i] + $ref2->[$i]);
# $new[$i] = $ref1->[$i] + $ref2->[$i];
}
==========================================================
Complex Data Structures:-
=========================
AoA
AoH
HoA
HoH
students & his 6sub marks
@s1=(10,20,30);
@s2=(10,20,30);
@s3=(10,20,30);
@s4=(10,20,30);
%hash=('arun' => \@s1,
'basu' => \@s2,
'chet' => \@s3,
'dine' => \@s4);
find the total marks of each student
and append that total marks to same array
Who is the Best of ALL
while(($a,$b)=each(%hash)
{
push(@$b,sum(@$b));
}
chet,basu,arun,john
@arr=sort{ $hash{$a}->[-1] <=> $b } keys(%hash);
%e1=('name'=>arun,'dept'=>sales,perf=>8.5);
%e2=('name'=>basu,'dept'=>purch,perf=>4.5);
%e3=('name'=>chet,'dept'=>accts,perf=>6.5);
%e4=('name'=>dine,'dept'=>sales,perf=>2.5);
%hash=(1005=>\%e1,
1003=>\%e2,
1001=>\%e3,
1004=>\%e4);
based on perf we decide the bonus
perf <= 5% - 10%
perf > 5% - 20%
foreach $i (keys(%hash))
{
print "$i $hash{$i}\n";
if($hash{$i}->{perf} <=5)
{
$hash{$i}->{bonus}=10;
}
else
{
$hash{$i}->{bonus}=20;
}
}
----------------------------------------------------------
ex:1
Zone Q1 Q2 Q3 Q4
North 10 20 30 40
South 10 20 30 40
East 10 20 30 40
West 10 120 30 40
I need each zone which value is best ?
best=>?
I need which Zones Which Qtr was best of ALL ?
@n=(10,20,30,40);
@s=(10,20,30,40);
@e=(10,20,30,40);
@w=(10,20,30,40);
%n=('qtrs'=>\@n);
%s=('qtrs'=>\@s);
%e=('qtrs'=>\@e);
%w=('qtrs'=>\@w);
%hash=('north'=>\%n,
'south'=>\%s,
'west'=>\%w,
'east'=>\%e);
Students:-
----------
Studname I1 I2 I3 IM
arun 10 20 12 ?
arun 10 20 22
arun 10 20 15
arun 10 20 21
ex:
use List::Util qw(max);
use Data::Dumper;
@n=(10,20,30,40); @s=(10,20,30,40);
@e=(10,20,30,40); @w=(10,20,30,40);
%n=('qtrs'=>\@n); %s=('qtrs'=>\@s);
%e=('qtrs'=>\@e); %w=('qtrs'=>\@w);
%hash=('north'=>\%n,'south'=>\%s,
'west'=>\%w, 'east'=>\%e);
while(($a,$b)=each(%hash))
{
$b->{best} = max(@{$b->{qtrs}});
}
print Dumper(\%hash);
Arrow Rule
===========
Arrow is optional b/w two indexes
$hash{$i}->{qtrs}
OR
$hash{$i}{qxtrs}
Complex Data Structures :-
==========================
>> Named CDS
>> Anon CDS
>> Hybrish CDS
1)
$a=10;
$b=20;
$c=[30,40,50,60];
$d=70;
$e=[80,90,100];
$ref=[$a,$b,$c,$d,$e];
how to print 10 ? $ref->[0]
How to print 30 ? $ref->[2][0]
How to print 80,90,100 ? @{$ref->[-1]}
2)
$ref=[[10,20],[30,40],[50,60]];
How to print 10 ? $ref->[0][0]
How to print last row ? @{$ref->[-1]}
How to last row last ele ? $ref->[-1][-1]
3)
$ref={'a'=>[10,20],'b'=>[30,40]};
How to print 10 : $ref->{a}[0]
How to print 30,40 : @{$ref->{b}}
How print keys of hash : keys(%$ref);
4)
$ref={north=>{10,20,30,[1,2]},
south=>{40=>50,60=>[3,4]}
};
How to print 20 ? $ref->{north}{10}
How to print 1 ? $ref->{north}{30}[0]
Hwo to print 1,2 ? @{ $ref->{north}{30} }
5) $ref=[
{a,b,c},
[1,2,3],
{d=>10,e=>20,f=>30}
];
How to print 10 ? $ref->[-1]{d}
How to print "b" ? $ref->[0]{a}
How to print "1" ? $ref->[1][0]
How to print 1,2,3 ? @{ $ref->[1] };
6)
$ref={arun=>{marks=>[1,2,3],best=>10},
chet=>{marks=>[4,5,6],best=>20}
};
How to print "1" : $ref->{arun}{marks}[0]
How to print 20 : $ref->{chet}{best}
How all keys chet ? : keys(%{$ref->{chet}});
use Data::Dumper;
@arr=('north-100',
'south-200',
'east-300',
'west-400);
$ref={}; # very important
foreach $i (@arr)
{
($v1,$v2)=split('-',$i);
$ref->{$v1} = $v2; # very important
}
print Dumper($ref);
==========================================================
@arr=('1001 arun sales 4343',
'1002 basu purch 6511',
'1003 chet accts 5135',
'1004 dine sales 4343');
$ref={}; # very important
foreach(@arr)
{
($f1,$f2,$f3,$f4)=split; # Very important
$ref->{$f1}{name} = $f2; # very Important
$ref->{$f1}{dept} = $f3; # very Important
$ref->{$f1}{sal} = $f4; # very Important
}
print Dumper($ref);
Wild card matching = DOS SHELL
==============================
>>dir a*.*
>>del a???.*
>>copy arun[0-9].* backup
String Matching = Compiler
============================
$a='hello';
$b='he';
if($a eq $b){
print "yes";
}
else{
print "no";
}
Pattern Matching - Regex Matching:- REGEX-Engine
===================================
$a='hello';
$b='he';
if($a =~ /he/){
print "yes";
}
else{
print "no";
}
BRE - . [] ^ $ *
ERE - ? + {} | () (?:)
.
/a..b/
h.i
there should be "a" followed by any 20-chars
followed by "b"
a.{20}b
lowercase = [a-z]
uppercase = [A-Z]
digits = [0-9] OR \d
Alpha-num = [a-zA-Z0-9_] OR \w
Space/tab/ = [ \t\n] OR \s
Not a Digit = [^0-9] OR \D
Not a Alpha-num = [^a-zA-Z0-9_] OR \W
Not a Sp/tb/newline = [^ \t\n] OR \S
Line starting with 5 digit number
followed by 10 vowels
followed by 5 lower chars
Line ending with fullstop
/^\d{5}[aeiou]{10}[a-z]{5}\.$/
$str='varun';
if($str=~/arun/i) # T
if($str=~/^arun/) # F
if($str=~/arun$/) # T
if($str=~/^arun$/) # F
if($str=~/^\darun$/) # F
if($str=~/^.arun$/) # T
if($str=~/^\w/) # T
Line starts with "a"
followed by chars may be there / may not be there
Line ends with "a"
^a.*a$
Line has only two words
b/w two words any no spaces can be there
^\w+\s+\w+$
String should start with VOWEL : if(^[aeiou])
String should start with CONSO : unless(^[aeiou])
String starts with other then "a" : ^[^a]
String ends with odd digit : [13579]$
String ending with FULL STOP : \.$
man
manu
regex: ^man[u]?$
varun
arun
tarun
regex: ^[vt]?arun$
match
matching
regex: ^match(ing)?$
match
patch
catch
hatching
regex: ^([mpc]atch|hatching)$
presales
pre-sales
pre sales
regex: ^pre[- ]?sales$
pre-sales
pre- sales
pre - sales
pre -sales
regex: ^pre ?- ?sales$
presales
pre sales
pre sales
pre sales
(they can use any no of spaces)
regex:- ^pre *sales$
cashsales
creditsales
regex:- ^c(ash|redit)sales$
hari
haari
regex: ^haa?ri$
^ha{1,2}ri$
hari
haari
haaari
haaaaaaari
(they can have any no of "a"s)
regex: ^ha+ri$
^ha{1,}ri$
^haa*ri$
String can have only
single digit nos / more digit nos
$str='123hello';
if($str=~/^\d+$/) # FALSE (very important)
{
print "True";
}
else
{
print "False";
}
dd-mm-yyyy
dd-mm-yy
^\d{1,2}-\d{1,2}-(\d\d){1,2}$
Line starting with
pinging
ringing
ranging
hanging
^(pi|ri|ra|ha)nging$
Line ending with is/in/if/it
i[snft]$
Select Blank Lines:
^\s*$ # best
^$ # only in unix/linux/mac
Line should have only 4 words
$str='hai world of end';
if($str=~/^(\w+\s+){3}\w+$/)
{
}
Line can end with fullstop or semicolon or colon or $
[.;:$]$
c = a+b;
cost = selling - disc;
result=a/b;
answer = one * two;
regex: ^\w+\s*=\s*\w+\s*[+-/*]\s*\w+;$
application:-
==============
do
{
print "Enter a number : ";
chomp($num=<STDIN>);
}until($num=~/^\d+$/);
print "End $num\n";
Write a regex in PERL:-
========================
if($str=~m/^a.*a$/)
if($str=~/^a.*a$/)
if($str=~qr/^a.*a$/)
Check whether u line starts and ends with SAMEWORD ?
----------------------------------------------------
Pattern Memorization:-
======================
$str='hello world of perl';
$str=~/^(\w+)\s+(\w+)\s+(\w+)\s+(\w+)$/;
\1 \2 \3 \4
$1 $2 $3 $4
print "$1"; # hello
print "$4"; # world
ex:
# Any strings first & last chars
$str='hello world of perl';
Sol:- $str=~/^(\w).*(\w)$/;
print "$1\n$2\n";
ex:
#Any strings first word & last word
$str='hello was the output of the program';
Sol:- $str=~/^(\w+)\s.*\s(\w+)$/;
print "$1\n$2\n";
Having any one word
-------------------
blr or chn or hyd
$str='i recently visited hyd';
$str='i recently visited chn';
$str='i recently visited blr';
$str='i recently visited delhi';
sol:
if($str=~/(blr|chn|hyd)$/)
Having all these words:-
-------------------------
blr and chn and hyd
$str='i recently visited hyd chn blr';
$str='i recently visited blr chn hyd';
$str='i recently visited chn blr hyd';
sol:
if($str=~/hyd/ && $str=~/chn/ && $str=~/blr/)
{
print "yes";
}
else
{
print "no";
}
Substitute operator:-
---------------------
s/REGEX/STRING/modifier;
modifier -i- ignore case
-g- recursive
-r- org string is unchanged & returns mod str
-e- eval replacement block
ex:
$str='sampled data';
# vowels should be replaced by 'V'
$str=~s/[aeiou]/V/gi;
ex:
$str='this was input is if IT was in';
# search for is/if/it/in & replace it by "CL"
# Exact word replacement
$str=~s/\b(is|in|if|it)\b/CL/gi;
print "$str";
ex:
Input:
$str='wonderful days ahead';
#First word should be converted to UPPERCASE
#using regex
Output:
$str='WONDERFUL days ahead';
sol:
$str=~s/^(\w+)/uc($1)/e;
ex:
Input:
$str='hello 67 then also 2';
Output:
$str='hello 68 then also 2';
# Increment the first occuring no by 1
$str=~s/(\d+)/$1+1/e;
req-1
#swap the first and last word
Input:- $str='hello world of perl';
Output:- $str='perl world of hello';
req-2
# Toggle the Case
$str='Hello WORld of Perl';
$str='hELLO worLD OF pERL';
req-3
#find the frequency of each char
$str='helloworldofperl';
%hash;
$str=~s/(\w)/$hash{$1}++/rge;
Sol1: $str=~s/^(\w+)(.*?)(\w+)$/$3$2$1/;
Sol2: $str=~s/([a-z])|([A-Z])/uc($1).lc($2)/ge;
Sol3: $str=~s/(.)/$hash{$1}++/ge;
Guess:-
=======
$str='hello';
$str=~s/./*/;
$str='hello';
$str=~s/./*/g;
$str='hello peeerl';
$str=~s/e+/e/g; # Trim
$str='here is some text';
$str=~s/\b\w+\b/That/;
$str='New Perl Programmer';
$str=~s/(\w)\w*/$1/g;
print "$str";
$str=~s/[aeiou]//gi;
$str=~s/[^aeiou]//gi;
Regex Special variables:-
-------------------------
prematch : $`
postmatch : $'
match : $&
$str='this was in 12 of the data when 13 end';
$str=~/\d+/;
print "$`"; # 'this was in '
print "$'"; # ' of the data when 13 end';
print "$&"; # 12
Note:
In 5.10 onwards it is discouraged to use this vars
Note:
>>$str=~/^(\w+)(?#firstword).*?(?#lastword)(\w+)$/;
>>later multi line string ie modifier 'm'
>>Assertions
if($str=~/blr/ && $str=~/chn/ && $str=~/hyd/)
==========================================================
test.txt:- parse.pl
----------- --------
#!/bin/bash open(FH,"test.txt");
echo "hello hai" while(<FH>)
{
# output statements print "$_";
unless(/^\s*$/ && /^\s*#/)
echo "$#" }
# command line args close(FH);
# programs ends
Note:
if($str=~m/regex/)
OR
if($str=~m#regex#)
=========================================================
Subroutines:-
=============
>> Similar to "C" functions
>> Limited version of "C" functions
>> There is No ARGUMENT Check in PERL
>> We pass the arguments via special variable named "@_"
>> By default every sub returns exit-status of last line
use strict;
use warnings;
sub Add
{
if(@_==2){
my ($arg1,$arg2)=@_; # lexical variables
my $ans=$arg1 + $arg2; # $arg1,$arg2 $ans
}
else {
return "Invalid args\n";
}
}
# -------------------------------------- #
my $p=10;
my $q=20;
my $res;
$res = Add($p,$q);
print "ANS = $res\n";
Files:-
=======
>> Native Calls
>> Library Calls
open the file in READ MODE:-
----------------------------
open(my $fh, "<","c:/program/data/one.txt") or die("");
OR
open(my $fh, "<","c:\\program\\data\\one.txt") or die();
@arr=<$fh>; # File Slurphing
close($fh);
open the file in Write MODE:-
----------------------------
open(my $fh, ">","c:/program/data/one.txt") or die("");
OR
open(my $fh, ">","c:\\program\\data\\one.txt") or die();
print $fh "Hello";
close($fh);
==========================================================
Packages & Modules in PERL:-
============================
>>Any perl program cannot RUN Without a package
>>Every package will maintain its own SYMTABLE
>>SYMTABLE constists of GLOBAL VARs & SUBS
Alpha.pm newprog.pl ======== ==========
package Alpha; use autouse Alpha=>qw(foo);
my $a=10; Alpha::foo();
our $b=20; &Alpha::foo;
sub foo print "B = $Alpha::b\n";
{ print "Hello\n";
}
1;
==========================================================
use F1::Alpha;
$object = new F1::Alpha; # C++-Style
$object = F1::Alpha->new; # Perl-Style
$object->Methodname(); # Style methods of the class
==========================================================
unix Server IP: 199.63.93.219
username : Honeywell
password : Password1
Perl Site:- dbi.perl.org
1) Check for avail of DBI.pm
perldoc DBI
2) Check for the Driver Avail
perldoc DBD::oracle
perldoc DBD::DB2
perldoc DBD::mysql
OR
use DBI;
@driver_names = DBI->available_drivers;
%drivers = DBI->installed_drivers;
print "@driver_names\n";
print join(" ",keys(%drivers));
3) Standard steps to ANY DB-program
>> Create a Connection string
perldoc DBD::mysql
use DBI;
$database='test';
$hostname='localhost';
$port=1521;
$dsn="DBI:msql:database=;$host=;port=";
$dbh = DBI->connect($dsn);
write this:
$dbh = DBI->connect('DBI:mysql:test');
use DBI;
$dbh = DBI->connect('dbi:ODBC:sample','perl','Perl');
4) Prepare statement & Execute the statement
$sth = $dbh->prepare("select * from emps");
$sth->execute();
5) we traverse the RESULT-set
while(@arr=$sth->fetchrow_array())
{
print "@arr\n";
}
6) Disconnect
$dbh->disconnect();
ex:
use DBI;
$dbh = DBI->connect('dbi:ODBC:sample');
$sth=$dbh->prepare("insert into emps values(?,?,?)");
open(FH,"data.csv") or die("$!");
while(<FH>)
{
chomp;
($a,$b,$c)=split(/,/);
$sth->execute($a,$b,$c); # Binding the values
}
close(FH);
$sth=$dbh->prepare("select * from emps");
$sth->execute();
while(@arr=$sth->fetchrow_array())
{
print "@arr\n";
}
$dbh->disconnect();
Transaction Management:-
========================
$dbh->{AutoCommit}=0; # set autocommit OFF
$dbh->begin_work(); # set the save point
$dbh->prepare("s1");
$dbh->execute(); or $dbh->rollback();
$dbh->prepare("s2");
$dbh->execute(); or $dbh->rollback();
$dbh->commit();
==========================================================
CGI-Perl:-
==========
>> http://199.63.93.219/cgi-bin/cgi.pl
>> CGI.PM
FastCGI.pm
>> mod_perl/mod_perl2/catalyst/mojolious
>> Perl SCripts are SERVER SIDE SCRIPTING LANG
>> all the CGI-Script should have #! statement compulsory
#!/usr/bin/perl
>> all the CGI-Scripts should have Execute permissions
$ chmod 777 script.pl
>> CGI-SCRipt folder : in the server is
/var/www/cgi-bin
su root
password : Password1
XL Parsing:-
============
to read the XL file of format
spreadsheet::parseexcel - 2003 formats
spreadsheet::xlsx - 2007+ formats
to read XL files of format 2007 +
use Excel::Writer::XLSX;
to open a XL-file & Run a MAcro
XML Parsing:-
=============
1) XML::Simple (simple parser)
2) XML::SAX (stream parser)
3) XML::DOM ( tree parser)
Other modules for XML-parsing
ex:
How to check whether XML is wellformed?
---------------------------------------
XML::Parser
ex:
use XML::Parser;
my $xmlfile = shift @ARGV;
my $parser = XML::Parser->new( ErrorContext => 2 );
eval { $parser->parsefile( $xmlfile ); };
if( $@ ){
print STDERR "\nERROR in $xmlfile:\n$@\n";
}
else{
print "$xmlfile is well-formed\n";
}
XML::Simple:-
=============
use XML::Simple;
use Data::Dumper;
$ref = XMLin("data.xml",forcearray=>1);
print Dumper($ref);
========================================================
sub routines:-
==============
Lexical Scoping:- variables defined within subroutine
Package Scoping:- outside the subroutines
Dynamic Scoping:- vars defined within sub routine
with keyword "local"
sub fun
{
$_[0]++;
$_[1]++;
print "Sub = $_[0] $_[1]\n";
}
my $p=10;
my $q=20;
print "Before = $p $q\n";
fun($p,$q);
print "After = $p $q\n";
>>The above program is CALL by REF
>>If we need to Convert this into CALL by VALUE
sub fun
{
my($arg1,$arg2)=@_;
OR
my($arg1,$arg2)=(shift,shift);
print "$arg1 $arg2\n";
}
ex:
Passing more than array as ARGUMEN
use strict;
use warnings;
sub fun
{
my ($t1,$t2)=@_;
print "The Team Leads\n";
print "$t1->[0]\n";
print "$t2->[0]\n";
}
my @team1=qw(hari john manu sam);
my @team2=qw(basu chet dine elan);
# When we pass two/more array as argument we have
# to pass by REFERENCE
fun(\@team1,\@team2);
Passing hash as a argument to the subroutines:-
===============================================
sub fun
{
my %hash=@_;
print "Enter the emp to search ";
chomp($name=<STDIN>);
if(exists($hash{$name})){
print "$name works for $hash{$name} dept\n";
}else{
print "$name doest work here\n";
}
}
my %emps=qw(arun sales basu accts chet purch dine hrd);
fun(%emps);
soL
sub fun{
my ($ref1,$ref2)=@_;
print "Enter the emp to search ";
chomp($name=<STDIN>);
if(exists($ref1->{$name})){
print "$name works for $ref1->{$name} dept\n";
}else{
print "$name doest work here\n";
}
}
my %emps=qw(arun sales basu accts chet purch dine hrd);
my %team=qw(hari 10 manu 20 chet 30 arun 40);
#passing more than one HASH as argument to the
# subroutine we have to pass by ref
fun(\%emps,\%team);
----------------------------------------------------------
sub fun
{
my @arr;
foreach (1..10){ push(@arr,$_); }
return wantarray()?@arr:join(' ',@arr);
}
my $res = fun();
print "$res\n";
my @res = fun();
print "@res\n";
----------------------------------------------------------
proto typing:-
==============
sub add($$)
{
if(@_==2)
{
my ($a1,$a2)=@_;
my $ans=$a1+$a2;
return $ans;
}else{
return "Error\n";
}
}
$res=add(@arr1,@arr2);
sub fun(\@\@)
{
}
----------------------------------------------------------
sub fun
{
my %temp=@_;
$p = $temp{pri};
$t = $temp{time};
$r = $temp{rate};
my $si=($p*$t*$r)/100;
print "SI = $si\n";
}
fun('rate'=>8.5,'time'=>32,'pri'=>3232);
----------------------------------------------------------
Files:-
=======
How to open Files:-
===================
open(FH,"data.txt") or die("$!"); # read mode
open(FH,"<data.txt") or die("$!"); # read mode
open(FH,">data.txt") or die("$!"); # write mode
open(FH,">>data.txt") or die("$!"); # append mode
open(FH,"+>data.txt") or die("$!"); # write/read mode
open(FH,"+<data.txt") or die("$!"); # read/write mode
How to read from the file:-
---------------------------
open(FH,"data.txt");
while(<FH>)
{ @arr=<FH>;
print "$_"; print "@arr";
}
close(FH);
How to write the into the File:-
--------------------------------
if( -w "data.txt")
{
open(FH,">data.txt");
print FH "HELLO WORLD";
close(FH);
}
seek(FH,+/-BYTEs,WHENHENCE);
tell(FH);
binmode(FH); # reduces open time of HUGE file
open(FH,"cat one.txt|"); #reduces open time of HUGE file
Note:
There is no EOF indicator in PERL
Dir-related
============
opendir
readdir
closedir
chdir
rmdir
mkdir
chdir
IO::File
IO::Dir
To compare two files:- Algorithm::Diff
To create tar file :- Archive::Tar
To Zip a file :- IO::Compress::Zip
Archive::Zip
To delete a file :-
To Copy files :- File::Copy
To Basename & filename:- File::Basename
==========================================================
Word - Win32::Word::Writer
XML- DOM/SAX
measurement - status
JSON
procedureal modules:-
=====================
How to include a module?
1)use Modulename; # Compile Time Loading
# only for PM-Files
2)require Modulename; # Run Time Loading
# we can include any extn files
what is @INC ?
perls special variable which stores
path of perl libraries
perl -V
see later: perldoc -q @INC
How export functions ?
package Alpha; use Alpha qw(f1 f2);
require Exporter;
@ISA=qw(Exporter); f1(); @EXPORT_OK=qw(f1 f2); f2();
Alpha::f3();
sub f1 { } Alpha::f4();
sub f2 { }
sub f3 { }
sub f4 { }
1;
see later:
perldoc Exporter
How to install a module ?
>>cpan
>>cpanplus
>>cpand
pre-req
gcc/g++/make
user shld have admin privi
see later: preldoc cpan
How to list all the installed modules ?
instmodsh
see later:
perldoc -q installed
How to Create a new module using util ?
h2xs -n ANYNAME
Object Oriented Modules:-
==========================
Emp.pm
======
package Emp; in MY PL-File:-
===============
sub new{
my $class=shift; use Emp;
my $ref={code=>undef,
name=>undef, $e1 = Emp->new;
sal=>undef};
bless($ref,$class); $e1->In();
}
$e1->Out();
sub In{
$self=shift;
$self->{code}=<STDIN>;
$self->{name}=<STDIN>;
$self->{sal}=<STDIN>;
}
sub Out{
$self=shift;
print "$self->{code}";
}
1;
========================================================
Exception Handling in PERL:-
============================
print "Enter a num ";
chomp($a=<STDIN>);
print "Enter another num : ";
chomp($b=<STDIN>);
eval
{
$ans=$a/$b;
};
if($@) # above stat has raised an Exception
{
print "$@";
}
else
{
print "No Errors";
}
Process:-
=========
How run a Interactive process in PERL
>> system("process/command");
it transfers the control of STDIN,STDOUT,STDERR
to the new process
Blocks the resources
background processes using system
system("process/command &"); # unix
OR
system("start process/command ") # windows users
How to Non-interactive process:-
================================
@arr=qx(process);
OR
@arr=`process`;
Threads:-
=========
use Thread;
use shared::threads;
our $a=10; # every thread makes a copy of it
our $b=20;
share($b); # now $b is common to all the threads
sub task1 { lock($b) $b++ }
sub task2 { $a++ }
sub task3 { }
sub task4 { $a++; lock($b) $b++; }
my $t1 = Thread->new(\&task1);
my $t2 = Thread->new(\&task2);
my $t3 = Thread->new(\&task3);
my $t4 = Thread->new(\&task4);
$t1->join();
$t2->join();
$t3->join();
$t4->join();
Note:
perldoc perlipc
Comments
Post a Comment