#!/usr/bin/perl # From: Sandeep Desai # Last update: June 1, 2004 # Subject: Perl Tutorial and Reference # Copyright: Sandeep Desai (c) 2004 # email: s_desai@hotmail.com # # This document is a perl program which can by used as a reference and tutorial for perl # # Perl is a general purpose scripting language. Perl (Practical Extraction and Reporting Language) was created by Larry Wall. See www.perl.org or www.cpan.org for more information. # The most recent version of Perl is 5.8. The most important feature of Perl is regular expressions. # # Perl's basic philosophy is to allow you to write a program with the fewest number of lines and not have to worry too much about error handling, data conversion, declaring variables and so on. Perl tries #to guess the correct way to process your code based on the usage. e.g if an array is assigned to a variable, perl will return the array size. # # Perl takes all numbers as floats and does not have an integer data type. # # Perl has extensible modules available for writing Web CGI programs, Database access and so on # # Book References: # Learning Perl 3rd Edition O Reilly # Perl Objects, References & Modules # # Websites: # www.perl.org # www.perl.com # perl.about.com Good Tutorials # www.perlmonks.org # www.pm.org Perl Mongers # # Normally perl programs have a .pl extension or no extension, to make this file show up properly in a browser, # I have set it to a .txt extension # on unix, to run this script ake sure the first line in this file points to your perl installation # # chmod +x perltut.pl.txt # perltut.pl.txt # or # perl perltut.pl.txt # perl -w perltut.pl.txt # # replace foo wiht bar in foo.txt file # perl -p -e 's/foo/bar/g' foo.txt # # # search in /foo/bar for include files (do or require fooinc.pl) # perl -I/foo/bar foo.pl #use strict; # recommended will show programmer errors print "************ basics ************\n"; $a = 1.23; # variables are prefixed with a $ and are global by default they have undef value by default $b = 123_456; # number can be written with underscores, for readability $c = $a ** $b; # exponentiation # $a * b, $a + $b, $a / $b, $a % $b (% is modulus operator) $d = "world\n"; # string with a newline at end, perl does not have any special end of string delimiter $e = 'world\n'; # string with 5 characters \ is not treated as an escape # linefeed \n carriage return \r tab \t bell \a backspace \b escape \e hex \x7f $s1 = "hello" . $d; # concatenate strings $s2 = "foo" x 3; # "foofoofoo" $s3 = 5 x 2; # "55" as x is a string operator $a = "12fred" * " 3"; # 36 if run as perl -w will show warning $a += 3; # $a = $a + 3 # Bitwise operator conver to binary and do operation bit by bit 3 & 1; # and 0011 & 0001 = 0010 = 2 3 | 1; # or 0011 & 0001 = 0011 = 3 3 ^ 1; # xor 0011 & 0001 = 0010 3 >> 1; # right shift 0011 >> 1 = 0001 = 1 3 << 1; # left shift by 1 0011 << 1 = 0110 = 6 ~14; # negate ~ 1110 = 0001 = 1 (simplified 4 -bit result actual result varies by # size of integer wether 32-bit or 64-bit "\xAA" | "\xFF"; # bitwise string "xFF" print $a, $b; $s1 = "foo $a"; # will interpolate $a to make it "foo world\n"; $s1 = "foo $(a)why?\n"; # will interpolate $a to make it "foo world\n"; print $s1; if ($a == $b) { print "match"; } # number compare != < > <= >= if ($a eq $b) { print "match"; } # string compare ne, lt, gt, le, ge # '0', UNDEF, () empty list are false all variables are assigned UNDEF by default # @ARGV has list of arguments passed to the program print (2+3)*4, "\n"; # only prints 5 why ??????? $a = (2+3)*4; print $a, "\n"; $a = "abc"; $b = 4; $c = 4.55679; $d = ++$a; # increment and then assign $d = $a++; # assign and then increment printf "%% %s %d %g\n", $a, $b, $c; # format string printf "%6d\n", $b; # %6s pad space at end %-6s pad space at start %12.3f float $foo = sprintf "%% %s %d %.4f\n", $a, $b, $c; # format string # string functions, faster than regular expressions # find strings $foo = index("foo bar bar", "bar"); # return index of "bar" in this case 4, if not found return -1 $foo = index("foo bar bar", "bar", 5); # start search from index 5, find index of bar in this case 8 $foo = rindex("foo bar bar", "bar"); # start search from right, find index of bar in this case 8 $foo = substr("foo bar", 4); # extract string, return "bar" $foo = substr("foo bar", 4, 2); # extract string, return "ba" $foo = substr("foo bar", -3, 2); # extract string, return "ba" last character is index -1 $foo = "foo bar"; substr($foo, 4, 3) = "foo"; print "$foo\n"; # will print "foo foo" $strlen = length $foo; # length of string $z = 0; eval { 3 / $z; }; # eval traps serious program errors like divide by zero, Note we need semicolon after the close paranthesis #exit; # exits program print "************ array ************\n"; @foo = ("abc", "def"); # Array name start with @ $foo[0] = "cba"; $#foo; # length of @foo -1 $foo[-1]; # length of @foo @foo = (1..4); # list of numbers from 1 to 4 #@foo = qw/ abc def /qw; # shortcut way to create a list of words #@foo = qw< abc def >qw; # any delimiter can used after qw ($a, $b) = ("abc", "def"); # ($a, $b) = ($b, $a); # swap, this works because right hand side list is constructed first $a = pop @foo; # return last element, the next pop will return the second last element push @foo, "z"; # add "z" to @foo array $f1 = shift @a; # like pop but from start of array unshift @foo, "a"; # insert at start of array @foo = reverse @foo; # reverse elements, works on string variable also @foo = sort @foo; # string sort, if it has number 1, 9, 10 will be 1, 10, 9 print @foo, "\n"; # prints element without spaces print "@foo\n"; # prints with spaces internally perl does join $", @foo foreach (@foo) { # store each element in default variable print; # print default $_ variable print "\n"; } $foo = "zzz"; # separate namespace for scalar variables, array, subroutines # so array foo is separate from variable foo printf ("%6s " x @foo), @foo; print "\n"; @foo = "abc"; # becomes @foo = ("abc"); perl do automatic type conversion\ @foo = ("ab", "bb", "cc"); #($av $cv) = @foo[0,2]; ??????? @odd = grep { $_ % 2 } 1..10; # grep returns return elements that print "grep odd numbers @odd\n"; @fg = grep { /^b/ } @foo; # find string starting with b print "grep start with b @fg\n"; @foo = 1..5; @fg = map { $_**2 } @foo; # transform elements in an array @fg = map $_**2, @foo; # can drop braces print "map replace bb with dd @fg \n"; print "************ hashes ************\n"; %foohash = ("foo2", "def"); # % hash key, value pair, keys should be unique $foohash{"foo1"} = "bar"; # add entry to hash $foohash{"foo1"} = "bar2"; # overwrite value for foo1 $foohash{foo1} = "bar2"; # can drop quotes for bare words (simple words) %foohash = reverse %foohash; # values become keys and keys become values, note values should be unique @fooarray = %foo; # unwinding hash converting to array @fookeys = keys %foo; # get all the keys @foovalues = values %foo; $count = keys %foo; while (($key, $value) = each %foohash) { print $key, "=>", $value, "\n"; } foreach $key (sort keys %foohash) { $value = $foohash{$key}; print $value, "\n"; } if (exists $foohash{"bar2"}) { print "found hash item\n"; } delete $foohash{"bar2"}; # remove hash entry %foohash = ( "foo1" => "def", "foo2" => "zzz"); # another way to define hash %foohash = ( foo1 => def, foo2 => zzz); # another way to define hash for simple strings # Hash slices @foo = ($foo{foo1}, ${foo2}); @foo = @foo{qw/foo1 foo2/}; @keys = qw/a b c/; @values = 1..3; @foohash{@keys} = @values; print "************ regular expressions ***********\n"; $_ = "abcd foo foo"; if ($_ =~ m/(foo)+/) { print "$`<$&>$'\n"; print $1, $2, "\n"; } # m is optional =~ (binding operator) does pattern match # $& is matched string $' is before match and $' is after match $1 is first matched $2 is second match # . one character except \n # Quantifiers * + ? # * match zero or more except \n .* becomes zero or more characters # + match one or more e.g a+bc matches abc but not ac # ? zero or one character e.g a-?c matches abc and ac if (/a(bc)+d/) { print "match for ()\n"; } # () is used for grouping if (/ab|dc/) { print "match for | \n"; } # () | is or if (/[a-z0,1]*/) { print "match for []\n"; } # specify range of characters to match #[^a-zA-Z] ^ is negate can be used only in range means do not match any alphabet if (/\w/) { print "match for \\w \n"; } # shortcuts \d [0-9] \D [^0-9] \w [a-zA-Z0-9 ] \s [\t\r\b\f ] \D \W \S are negates # [\d\D] like . but matches \n also # \b word anchor matches at start and end of word if (/\bfoo\b/) { print "match for \\b\n"; } # a{2,5} match a 2 to 5 times a{2,} match a 2 or more times if (/^abc/) { print "match for ^ \n"; } # ^ is start of string and $ is end of string also # /\bsearch\B/ matches search and searches but not researching # if (/(.)\1/) { print "match \(\)\n";} () are stored in memory \1 is the first reference e.g match oo in foo ????? # # precendence # () # Quantifiers * + ? {} # ^ $ \b \B # | $_="foo bar"; if (m{foo}) {} # can use other delimiters like qw /foo/i; # case insensitive /foo/s; # match newline at end man perlop for more details $match = "foo"; /$(match)/; # interpolate variables if (/(f?o)/) { print $1; }; # $1 has the first matched string acessible from an if only if (/(f?o)/) { print "$'<$&>$'\n"; }; # $' string before match $& matched string $' after match s/foo/bar/; # substitute foo with bar # s/(\w)+ (\w+)/$2 $1/; swap words s/\.foo/.bar/; # replacement string is not regular expression so does not need backslash for . if (s/bar//) { print "succesfull substitution\n"; } # remove foo $_="bar bar"; s/bar/foo/g; # replace all instances s[foo][bar]; # like qw can use other delimiters s#foo#bar#; #case shifting s/bar/\U$1/; # should upper case ???? does not work # \L lower case \u upper case first character \l lowercase first character \E stop uppercasing print "\U$foo\E\n"; # case shifting can be done for any string s/bar/\u\L$1/; print $_, "\n"; # Lazy qualifier print "Lazy qualifier\n"; $_ = "foo bar1 /foo foo bar2 /foo"; s!foo(.*)/foo!!g; # matches from the first foo to /foo $_ = "foo bar1 /foo foo bar2 /foo"; s!foo(.*?)/foo!!g; # will remove all the foo and matching /foo ???????? print $_, "\n"; $foo = "foo bar"; substr($foo, 4, 3) =~ s/bar/foo/g; print "$foo\n"; # will print "foo foo" $_ = "This is a foo"; @foo = split /\s+/, $_; # split string to array using pattern @foo = split; # same as above $item = split [1]; #($is $a) = split [1,3]; ?????? $_ = join ":", @foo; # join elements in foo print $_, "\n"; print "************ control structures ************\n"; if (1) {} # if true unless (0) {} # equivalent to if (!1) $_ = 2; while ($_ > 0) { $_--; } $_ = 2; until ($_ < 0) { $_--; } # similiar to while (!..) print "hello" if ($_ > 0); # shortcut for writing if $_-- while ($_ > 0); { my $a; $a = 1; } # write code in braces useful for scoping local variables if ($a == 0) {} elsif ($a == 1) {} elsif ($a == 2) {} foreach my $i (@foo) { } # for ($i = 0; $i < 2; $i++) {} for ($i = 0; $i < 2;) { $i++; } # can even be for (;;) {} infinite loop for (1..3) { print; } print "\n"; for (1..3) { if ($_ == 2) { last; } } # last is exit loop (like break in Java or C) for (1..3) { if ($_ == 2) { next; } print $_; } print "\n"; # next is continue back to loop (prints 1 and 3) for (1..3) { if ($_ == 2) { $_++; redo; } } # redo is like next but does not increment $_ # TOP: for (1..3) { for ($i =1; $i < 2; ++$i) { if ($i == 1) last TOP } } ?????? $a = 0; $b = 3; if ($a != 0 && ($b/2) > 2) {} # logical AND since $a is 0 rest of the expression is not evaluated if ($b > 2 || $a > 2) {} # logical OR similarly $a > 2 not evaluated $a = UNDEF ; $z = @a || "default"; print $z, "\n"; # does not return the boolean true but the last expression evaluated print $a > 0 ? "true\n" : "false\n"; # ternary operator expression ? true : false like if (expression) { return "true"; } else { return "false"; } ($a > $b) && ($a = $b); # does not do assignment as $a is 0 $a > $b and $a = $b; # same as && but has lower precedence print "************ subroutines ************\n"; sub foo { # subroutines # local($a, $b); save in stack and restore global variables after subroutine returns, old style if ($_[0] eq "zzz") { return $foo; # return is optional } else { "aaa"; } } sub foomax { # subroutines with parameters my($curmax); # local variables # @_ has parameter list $_[0] has first parameter foreach (@_) { if ($_ > $curmax) { $curmax = $_; } } $curmax; } # last expression in subroutine is automatically returnd print &foo("qqq"), "\n"; print foomax(1..5), "\n"; # & if subroutine has same name as built in e.g if foomax called reverse print "************** Custom Sort ****************\n"; # Perl provides user defined sorting, where the user provides a function which returns # the result of comparing two elements in the array, Perl automatically defins two variables $a and $b sub custom_sort() { if ($a < $b) { -1 } elsif ($a > $b) { 1 } else { 0 } } sub custom_sort2() { $a <=> $b; } # <=> does numeric compare and cmp does string compare like above @foo = (1..5); @foo2 = sort custom_sort @foo; @foo = ("foo", "bar"); @foo2 = sort { $a cmp $b } @foo; print "************ File I/O ****************\n"; # A File handle is a reference to an I/O connection # STDIN, STDOUT, STDERR, DATA, ARGV, ARGVOUT # STDIN is input, the keyboad # STDOUT and STDERR are the console # open FOOFILE, "foo"; # open file for reading, note that open does a close before doing an open open FOOFILE, "foo"; # open file for writing open FOOFILE, ">>foo"; # open file for appending close FOOFILE; # close and flush buffers, unless (open FOOFILE, "foo1") { print "$! - $^E in $0 perl program\n"; } # $0 is perl script name $! returns error message of why file open failed on Window $^E may have more details # unless (open FOOFILE, "foo1") { die "can't open file foo1, $!\n"; } # die means exit output sent to STDERR # open FOOFILE, "foo1" or die "can't open $!\n"; warn "Some warning"; # like die, but program does not exit output sent to STDERR open FOOFILE, ">>foo"; print FOOFILE "foo\nbar\n"; # print STDERR, "foo" can also do printf FOOFILE "%6d", 10 select FOOFILE; # send all future print and printf to FOOFILE $! = 1; # flush after every print (don't buffer) print "bar\nfoo\n"; select STDOUT; # set it back to default which is STDOUT close FOOFILE; # close and flush buffers, open FOOFILE, "foo"; while () { chomp; if (/foo/) { print "found foo\n"; } } close _; # close and flush buffers, @foo = ; # read all the lines into foo # _ is last file worked on, more efficient when doing stat twice #Use FileHandle; #open FOO1FILE, ">foo1"; #print FOO1FILE "test\n"; #FOO1FILE->autoflush(1); # flush buffers #close FOO1FILE; print "************ File replace ***********\n"; @ARGV = ("foo"); # ??????????????? does not work while (<>) { s/foo/foo1/g; s/bar/bar1/g; print; } # Fixed length record files open FBINFILE, ">foobin"; $buf = pack("a10 c", "abc", 1); # pack a string of fixed 10 length and a character total lenght is 11 $buflen = length $buf; # length of each record print FBINFILE $buf; close FBINFILE; open FBINFILE, "foobin"; $n = 0; # record we want to seek seek(FBINFILE, $n * $buflen, 0); # last parameter is offset in the record $fr = read(FBINFILE, $buf, $buflength); close FBINFILE; #open STDERR, ">>fooerr"; #redirect STDERR to foo #open STDOUT, ">>fooout"; #redirect STDOUT to foo print "foo file exists\n" if (-e "foo"); # -e file exists printf -s "bytes foo\n", "\n"; # -M age in days -A access age in days -C Inode-modification age in days # -r readonly -w writable -x excutable -o owned -R -W -x real user # -z zero bytes -s size # -f plain file -d directory -l symbolic link -s socket -p pipe (a fifo) -b block special file -c character special file # -u setuid set -g setgid set -k sticky bit set -t TTY (terminal) # -T text -B binary (perl reads first 1000 bytes and guesses) unless (-t STDIN) {} # user has redirected input @foo = ($device_number, $inode_number, $file_permissions, $number_of_hard_links, $uid, $gid, $rdev, $size, $accesstime, $time, $ctime, $blksize, $blocks) = stat("foo"); print "foo file stat-> @foo\n"; # do an lstat for symbolic links instead of stat $ts = ($sec, $min, $hour, $day, $mon, $year, $wday, $yday, $isdst) = localtime $accesstime; print $ts, "\n"; # format a number in seconds from 1970 to user readable date/time $gs = gmtime $accesstime; # GMT Time #Globbing is a Unix shell feature e.g cat *.pl becomes cat a.pl b.pl @foo = glob "*.html *.txt"; # equivalent to a ls *.html *.txt or dir *.html *.txt and converted to array result is sorted print "@foo\n"; # result is sorted @foo = <*.html>; # old way of doing a glob if @foo = if angle brackets had file handle then read else glob @foo = readline ; # File commands, for more details see Unix documentation for ln, chmod etc # all the file functions here support glob rename "foo", "foo2"; # rename file #link "foo2", "bar" or warn "can't link $!"; # do a hard link on Unix, do nothing on windows #symlink "foo2", "bar" or warn "can't symlink $!"; # symbolic link files on Unix, do nothing on windows $_ = readlink "foo2"; # where is this file linked unlink "foo2"; # delete file foo unlink glob "*.tmp" return number of files deleted chmod oct("755"), "foo2"; # does not support chmod +x foo like Unix, oct is octal #$uid = getpwnam("foouser"); # get numeric userid for a user #$gid = getgrname("foogroup"); # get numeric groupid for a group chown $uid, $gid, "foo2"; # change file ownership $now = $time; utime $now, $now-60, "foo"; # change file timestamps # another way to read directories opendir ROOTDIR, "/"; foreach $file (readdir ROOTDIR) { print "$file "; } print "\n"; closedir ROOTDIR; chdir "foo" or warn "can't find foo directory $!\n"; # ~ does not work as it is a Unix Shell feature mkdir "foodir", 0755 or warn "cant mkdir $!"; # make directory, 755 is directory permissions rmdir "foodir"; # remove empty directory #while (chomp($line = )) # read input from keyboard till # user presses Ctrl-D on Unix and Ctrl-Z Enter on DOS/Windows #{ print $line; } #while (chomp($line = <>)) # read input from files specified in # @ARGV - stands for standard input e.g perl foo.pl foo1.txt foo2.txt - #{ print $line; } #while (<>) #{ chomp; print $_; } print "**************** System calls ******************\n"; # A lot of the stuff here is Unix specific @win_cmd = ("cmd", "/c", "dir", "/w"); @linux_cmd = ("ls", "-l"); print $ENV{"USERNAME"}, "\n"; # %ENV has all the environment variables inherited from the parent process @cmd = @win_cmd; system "@cmd"; # run program by first try running by looking in PATH environment variable else run using /bin/sh (Bourne Shell0 # output is automatically redirected to STDOUT, errors are not returned in $! # return value of program in $! system "@cmd $HOME"; # run using /bin/sh as it refers to an environment variable system @cmd; # don't run using #exec @cmd; # exit from Perl and run this program, should be last line in your perl script $now = `ls -l`; # run program and send output to variable @now = `ls -l`; # run program and send output to array, each line is one element # do ls -l 2&>1 to send programs STDERR to STDOUT # do a foo < /dev/null if your program takes input # Inter process comunication # ?????? #open DIROUT, "ls -l|"; # launch the program and send its output back through a pipe, read by Perl using a file handle #@dir = ; # can read like a regular file #close DIROUT # open FOO, "|foo"; takes input # kill 2, 1234; # kill process 1234 by sending signal 2 sub signal_cleanup { print "cauhgt signal\n"; } $SIG{'INT'} = signal_cleanup; # call this subroutine when user sends SIGINT (Ctrl-C) print "**************** Database Hashes/Persistence **************\n"; # ?????????? does not work dbmopen(%HASHDB, "foohashdb", 0755); $buf = pack("c s l c*", 1, 123, 1.23, "abc"); # pack into string c is char, s is short, l is long, c* is string of any length, c7 string of 7 or less a10 string of fixed 10 length pad with \0 $HASHDB{key1} = 123; $HASHDB{key2} = $buf; dbmclose(%HASHDB); my ($fc, $fs, $fl, $fs) = unpack("c s l c*", $buf); print "************* Using Modules *****************\n"; # perl has a lot of built in modules # $foo = File::Basename::dirname("/foodir/barfile"); # access dirname subroutine in File::BaseName module use File::Basename; # recommended to put all the use modules at the top my $foo = dirname("/foodir/barfile"); print "$foo\n"; # will be barfile use File::Basename qw/ dirname /; # only import basename subroutine, useful for avoiding subroutine name conflicts #my $foo = File::Spec->catfile("foodir", "barfile"); # combine directory and file print "*************** Include perl files *************\n"; open FOOPL, ">foo.pl" or die ; print FOOPL "sub afoo { print \"from foo.pl\\n\"; } 1;\n"; close FOOPL; # search for included files in PATH and PERL5LIB shell environment variables and in @INC perl array # can also do perl -I/foo foo.pl #do "foo.pl"; die $@ if $@; # can cause the file to be included twice, resulting in syntax errors require "foo.pl"; # a 1 is required at then end of foo.pl, will not include file twice &afoo; # ???? does not work without an & print "**************** Packages *******************\n"; { package Foo; # useful for avoiding namespace conflicts, default package name is main, convention to capitalise first letter # advisiable to put package name in {} sub bar() {} } Foo::bar(); print "**************** References *****************\n";