.. Associative Associative Arrays / Hashes Associative arrays, are also called "hashes". They are arrays that are indexed not on ordered integers, but on arbitrary string values. generally, elements of an associative array are refered to as "key" and "value" pairs. The "key" is used to find the element of the array that has the "value". Basic operators are: % (percent sign) This refers to the entire array { } (braces) This denotes the key $ (Dollar) When this is used with { }, this is the value of the array element indexed on the key. $school{"leader"} = "Tim Grant"; $school{"scout"} = "Jack Hassel"; $school{"president"} = "Mike Shawn"; @schoolposts = keys(%school) @schoolnames = values(%school) Some Associative Array functions Keys(%ARRAY) # Return a list of all the keys in %ARRAY. The list is "unordered" - it depends on the hash function used internally. Values(%ARRAY) # Return a list of all the values in %ARRAY Each(%ARRAY) # Each time this is called on an %ARRAY, it will return a 2 element list consisting of the next key/value pair in the array. Delete($ARRAY{KEY}) # remove the pair associated with KEY from ARRAY. back to top ..

.. CompareListsValues sub compare_lists { # compare two list values my(@a) = splice(@_,0,shift); my(@b) = splice(@_,0,shift); return 0 unless @a == @b; # same len? while (@a) { return 0 if pop(@a) ne pop(@b); } return 1; } if (&aeq($len,@foo[1..$len],0+@bar,@bar)) { ... } back to top ..

.. Condition Conditionals To do comparisons on different values, perl provides two sets of conditionals One for Numbers and one for strings. Equality eq == Inequality ne != Greater than gt > Greater than or equal to ge >= Less than lt Less than or equal to le Comparison returns -1,0,1s cmp back to top ..

.. Control Control Structures in Perl foreach Perl uses the foreach structure to go through each line of an array or other list-like structure foreach $item (@music) { print "$item\n"; } for First it initializes the value of $i. Then it executes the statements in the block while the condition is true. for ($i = 0; $i { print "$i\n"; } while It stays in the block till the condition is satisfied #!/usr/local/bin/perl print "Password? "; # Ask for input $a = ; # Get input chop $a; # Remove the newline at end while ($a ne "xanadu") # While input is wrong... { print "Sorry. Wrong password. try Again? "; $a = ; # Get input again chop $a; # Chop off newline again } To test the opposite use until Another way of doing the same Another useful technique is putting the while or until check at the end of the statement block rather than at the beginning. This will require the presence of the do operator to mark the beginning of the block and the test at the end. #!/usr/local/bin/perl do { "Enter Password : "; # Ask for input $a = ; # Get input chop $a; # Chop off newline } while ($a ne "xanadu") # Redo while wrong input if else if ($x) { print "variable x is not empty\n"; } else { print "variable x is empty\n"; } It is also possible to include more alternatives in a conditional statement: if (!$x) # The ! is the not operator { print "variable x is empty\n"; } elsif (length($x) == 1) { print "variable x has one character\n"; } elsif (length($x) == 2) { print "variable x has two characters\n"; } else { print "variable x has lots of characters\n"; } back to top ..

.. Crypt # how to use crypt if ( crypt ($user_passwd, $stored_pw) eq $stored_pw) { return 1; } back to top ..

.. DateAndTime An usefull function to format the date and time use Time::localtime; $| = 1; sub now { $tm = localtime; ($smin, $shour, $sday, $smon, $syear) = ($tm->min, $tm->hour, $tm->mday, $tm->mon, $tm->year); $f = sprintf ("%02d/%02d/%04d %02d:%02d\n", $smon+1, $sday, $syear+1900, $shour+4, $smin); return $f; } $g = &now; print $g; back to top ..

.. Datedayweek Day and week of the year How to find the day and week of the year ? The day of the year is in the array returned by localtime() (see localtime): $day_of_year = (localtime(time()))[7]; use Time::localtime; $day_of_year = localtime(time())->yday; You can find the week of the year by dividing this by 7: $week_of_year = int($day_of_year / 7); back to top ..

.. DiskSpaceLinux # disk_space(device) # Returns the amount of total and free space for some filesystem, or an # empty array if not appropriate. sub disk_space { `df -k $_[0]` =~ /Mounted on\n\S+\s+(\S+)\s+\S+\s+(\S+)/ || return (); return ($1, $2); } back to top ..

.. EmailValidation # Matching a valid e-mail address[ A-z 0-9 and -,.,_,@ ] - no blank spaces # Allow IP addresses to included into the e-mail address # check_email_address ( $e-mail ) sub check_email_address { $email = $_[0]; # If the e-mail address contains: if ( $email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/ ) { return 0; } else { # Return a true value, e-mail verification passed. return 1; } } back to top ..

.. Filedelete Delete a file How to delete a file This deletes a single file $myfile ="sample.txt"; unlink $myfile; OR rename($myfile, $yourfile) || die "can't rename: $!\n"; This deletes a whole set of files @filelist = ("myfile1.txt","myfile2.txt","myfile3.txt"); unlink @filelist; Another approach could be system("rm $file"); system("mv $file1 $file2"); back to top ..

.. Filedir Read/List Contents of a Directory How to list contents of a directory The follwing reads the contents of directory "/home/jack/prog/" #!/usr/bin/perl -w $mydir = "/home/jack/prog/"; opendir(DIR, "$mydir"); @allfiles = readdir(DIR); closedir(DIR); Now print the directory contents stored in the array foreach $file (@allfiles) { print "$file\n"; } back to top ..

.. FileExist # check if the file exist. sub FileExist { my $file_path = $_; if (!-e "$file_path") { return 0; } else { return 1; } } back to top ..

.. Filegettimestamp Get file timestamp How to GET the file's timestamp #!/usr/local/bin/perl To retrieve the time in seconds since the epoch, you would call the stat function, And then use localtime(), gmtime(), or POSIX::strftime() to convert this into human-readable form. $time_secs = (stat($myfile))[9]; printf " %s was updated at %s\n", $myfile, scalar localtime($time_secs); Or use the File::stat module (part of the standard distribution in version 5.004 and later): use File::stat; use Time::localtime; $date_string = ctime(stat($myfile)->mtime); print "$myfile was updated at $date_string\n"; back to top ..

.. Filelock Lock and Unlock a file How to LOCK and UNLOCK files Before that ...why do we need to lock a file that we are writing ? Note that working with CGI programs, there might be others executing the same program and each trying to get a hold on the file for reading/updating. It could lead to disasterous ends. To lock a file, use the flock() command. The flock() command takes two parameters - the type of locking you wish to do, and the FILEHANDLE you wish to lock. flock(FILEHANDLE, 2) or die "Cannot LOCK the file : $!"; and to Unlock use flock(FILEHANDLE, 8) or die "Cannot UNLOCK file: $!"; back to top ..

.. Filemulti Write to multiple files How to write to more than one file at a time A simple way would be #!/usr/local/bin/perl for $fh (MYFILE1, MYFILE2, MYFILE3) { print $fh "whatever\n" } Using the tee function for conecting one filehandle to several output filehandles. open (FH, "| tee MYFILE1 MYFILE2 MYFILE3"); Or another approach would be : # make STDOUT go to three files, plus original STDOUT open (STDOUT, "| tee MYFILE1 MYFILE2 MYFILE3") or die "Seeing Error : $!\n"; print "whatever\n" or die "Error in Writing: $!\n"; close(STDOUT) or die "Error in Closing: $!\n"; back to top ..

.. Fileread Read from a file How to read contents of a file ? A simple way is open (MYFILE, "myfile.txt") || die "Couldn't open the file!"; while (<MYFILE>) { print $_; } close(MYFILE); Another Way : open (MYFILE, "myfile.txt") || die "Couldn't open the file!"; @filecontent = ; # read in the contents of the file foreach $myline (@filecontent) { print " $myline \n"; } back to top ..

.. Filerename Rename a file How to rename a file #!/usr/local/bin/perl Usually use Perl's rename() function. rename($old, $new) Note : But as it might not work everywhere, like, renaming files across file systems. system("mv", $old, $new); back to top ..

.. Fileselect Select only .html files How to read only .html files in a directory Reading only the .html files from a directory #!/usr/bin/perl -w $mydir = "/home/jack/prog"; opendir(DIR, "$mydir"); @files = grep(/\.html$/,readdir(DIR)); closedir(DIR); Now print the files that have been selected and stored in the array foreach $file (@files) { print "$file\n"; } back to top ..

.. Filesettimestamp Set file timestamp How to SET the file's timestamp #!/usr/local/bin/perl Using the utime() function documented in utime. The following program copies the read and write times from its first argument to all the rest of them. if (@ARGV die "Usage: cptimes timestamp_file other_files ...\n"; } $timestamp = shift; ($atime, $mtime) = (stat($timestamp))[8,9]; utime $atime, $mtime, @ARGV; Note that utime() currently doesn't work correctly with Win95/NT ports. A bug has been reported. Check it carefully before using it on those platforms. back to top ..

.. Getenv Print all the environment variables How to print all the environment variables This prints all the evironment variables #!/usr/local/bin/perl foreach (sort keys %ENV) { print "$_ = $ENV{$_}\n"; } The following prints all the evironment variables and their values #!/usr/local/bin/perl print "\n"; foreach $key (sort keys(%ENV)) { print "$key = $ENV{$key}"; } back to top ..

.. Genfirstelement Get first element of the Array How to check the first arrray element for a true condition? You can use this if you care about the index for ($i=0; $i if ($array[$i] eq "jack") { $req_element = $i; last; } } # $req_element has the desired element print " $req_element \n"; back to top ..

.. Getos Operating System (OS) of the User Which Operating System is Perl running on ? Use the $^O variable OR $OSNAME if you use English It contains the operating system that your perl binary was built for. back to top ..

.. Replacetabs Replace TABS with Commas How to replace TABS as commas in Perl? The following is a command line utility in perl to replace the TABS in a file to commas perl -pi.bak -e 's/\t/,/g' myfile.txt Invoke perl from the Unix (or DOS) command-line to edit the file myfile.txt This command edits the target file , and makes a backup file named myfile.txt.bak (just for contingency, in case of error). And the updated myfile.txt contains the changes. back to top ..

.. Setsetenv Set Environent Variables How to set the environment variables in Perl? As %ENV is a hash, you can set environment variables like any other value of any Perl hash variable. Following is the code to make sure that the following four directories are in your path:: $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/home/jack/prog'; In order to access an executable from another perl program we might require to have the directory in the path Just to confirm run the following script: #!/usr/bin/perl $ENV{'PATH'} = '/bin:/usr/bin:/home/jack/prog'; print $ENV{'PATH'}; back to top ..

.. Geturl Read contents of a URL How to read contents from a URL ? This is as simple program that reads the content in the url www.mysite.com. This makes use of the LWP::Simple use LWP::Simple; $url = get 'http://www.mysite.com/'; print $url; back to top ..

.. Getuserinfo =INFO+ User Information =END =SOURCE+ How to get the user information in HTTP ? The user informations can be retrieved from the browser environment variables print " Browser was " . $ENV{'HTTP_USER_AGENT'} . "; print " They came from " . $ENV{'HTTP_REFERER'} . "; print " The remote address was " . $ENV{'REMOTE_ADDR'} . "; print " The remote host was " . $ENV{'REMOTE_HOST'} . "; =END back to top ..

.. Getusername Get User Name from Login Info How to print the username from login info ? This can be done by getting the value from the environment variable #!/usr/bin/perl $userName = $ENV{'LOGNAME'}; print "Hello, $userName\n"; back to top ..

.. GoogleSearch use SOAP::Lite; # The key obtained from Google registration my $key='PpQFHLCz4GYYmZRR0OGfYw+Gkv7'; my $query='asp script generalhosting.com'; # Download from Google.com -> GoogleSearch.wsdl my $googleSearch = SOAP::Lite -> service("file:GoogleSearch.wsdl"); my $result = $googleSearch -> doGoogleSearch($key, $query, 0, 10, "false", "", "false", "", "latin1", "latin1"); print "Content-type: text/html\n\n"; print "About $result->{'estimatedTotalResultsCount'} results.\n"; if(defined($result->{resultElements})) { foreach my $entry (@{$result->{'resultElements'}}) { print "<p>$entry->{title}<br>$entry->{URL}<br><br>"; } } back to top ..

.. Hashdelete Deleting from a Hash delete($HASH{$KEY}); back to top ..

.. Hashmerg Merging Hashes %merged = (%A, %B); or %merged = (); while ( ($k, $v) = each(%A) ) { $merged{$k} = $v; } while ( ($k, $v) = each (%B) ) { $merged{$k} = $v; } back to top ..

.. Hashsort Sorting a Hash @keys = sort { criterion() } (keys %hash); or foreach $key (sort { criterion() } (keys(%myHash))) { print "$myHash{$key}\n" } or foreach $key (sort (keys(%myHash))) { print "$myHash{$key}\n" } back to top ..

.. Hashtest Testing for the Presence of a Key in a hash if (exist($HASH{$KEY})) { #it exists } else { # it does not exists } back to top ..

.. Hashtraversing Traversing a Hash while (($key, $value) = each(%HASH)) { # do something with $key and $value } foreach $key (keys %HASH) { $value = $HASH{$key}; # do something with $key and $value } back to top ..

.. INCaddlocalpaths How to add local paths to @INC array: $start_path = 'module-dir $lib_path = "$start_path/lib"; @local_paths = ($start_path, $lib_path); push (@INC, @local_paths); require SomeLocalModule_From_Local_Lib_Dir; back to top ..

.. Io IO How to Check if input is ready on the keyboard ? How to read from a PIPE How to take command line arguments How to read input from the keyboard ? How to check if input is ready on the keyboard ? A simple way to do it would be to use the Term::ReadKey module from CPAN Passing it an argument of -1 to indicate not to block: use Term::ReadKey; ReadMode('cbreak'); if (defined ($char = ReadKey(-1)) ) { # input was waiting and it was $char } else { # no input was waiting } ReadMode('normal'); # restore normal tty settings How to read from a PIPE? The value of date is passed to the PIPE open(DATE, "date|"); $theDate = ; close(DATE); How to take command line arguments ? $totArgs = $#ARGV + 1; print "I received the following $totArgs command-line arguments.\n"; foreach $myarg (0 .. $#ARGV) { print "$ARGV[$myarg]\n"; } $totAtgs : contains the total number of arguments passed $ARGV[$myarg] : would contain the value of the argument How to read input from keyboard ? This is a simple program to read input from the keyboard #!/usr/local/bin/perl $line = ; print STDOUT $line; A little modificaton to the above to make it more useful Prompt the user for input by using a print statement followed immediately by a read #!/usr/local/bin/perl print "What is your name ?"; $line = <>; # To read a line from the keyboard. chop $line; # To Get rid of the Return character. print "You are $line .\n"; exit; back to top ..

.. Ioarg Read from Command Line How to take command line arguments ? $totArgs = $#ARGV + 1; print "I received the following $totArgs command-line arguments.\n"; foreach $myarg (0 .. $#ARGV) { print "$ARGV[$myarg]\n"; } $totAtgs : contains the total number of arguments passed $ARGV[$myarg] : would contain the value of the argument Another approach for the same would be # define a small subroutine called print_helpexit # when theres no arguments or -h is an argument print_helpexit() if ( @ARGV && $ARGV[0] eq '-h' ); if ( -f $ARGV[0] ) { die "File $ARGV[0] exists already! Won't overwrite!\n"; } Here is a program that prints all arguments passed to it. #!/usr/bin/perl use strict; my $arg; foreach (@ARGV) { $arg++; print "Argument $arg: $_\n"; } back to top ..

.. Iokeyboard Read from Keyboard How to read input from keyboard ? This is a simple program to read input from the keyboard #!/usr/local/bin/perl $line = ; print STDOUT $line; This will read one line of input from the "standard input" And write that line to the "standard output" which would be the screen Note that both "STDIN" and "STDOUT" are optional in this context. A little modificaton to the above to make it more useful Prompt the user for input by using a print statement followed immediately by a read #!/usr/local/bin/perl print "What is your name ?"; $line = ; # To read a line from the keyboard. chop $line; # To Get rid of the Return character. print "You are $line .\n"; exit; The above code will write the prompt string to the screen Then wait for the user to give the input and press the Return key/Enter Button back to top ..

.. Iokeyboardready Check for input at keyboard How to check if input is ready on the keyboard ? A simple way to do it would be to use the Term::ReadKey module from CPAN Passing it an argument of -1 to indicate not to block: use Term::ReadKey; ReadMode('cbreak'); if (defined ($char = ReadKey(-1)) ) { # input was waiting and it was $char } else { # no input was waiting } ReadMode('normal'); # restore normal tty settings back to top ..

.. Iopipe Read from IO Pipe How to read from a PIPE? The value of date is passed to the PIPE open(DATE, "date|"); $theDate = ; close(DATE); back to top ..

.. List Lists in Perl Intro to List A list is an ordered collection of scalars. Space for lists are dynamically allocated and removed from the program's memory. Each element can be addressed by its integer position in the list. Lists are 0-indexed; the first element is called "0". Typical operators include ( ) (parenthesis) Is the list constructor. , (comma) The comma is used to separate elements of the list. [ ] (brackets) The brackets are used to take slices of the list. Here are some list functions sort(LIST) # return a new list, the sorted from LIST reverse(LIST) # return a new list, the reverse of LIST join(EXPR,LIST) # return a string formed by concatenating each element of LIST joined by EXPR split(PATTERN,EXPR) # return a list formed from each substring of EXPR bordered by PATTERN. back to top ..

.. LoginVerify sub Verify_login { if (!($user_ID && $user_passwd)) { return 2; } if (!-e "$db_path/$user_ID/pass") { return 3; } # This guy exists, lets check the password. open (PASSWORD,"<$db_path/$user_ID/pass"); my $stored_pw = <PASSWORD>; close PASSWORD; if (crypt($user_passwd,$stored_pw) ne $stored_pw) { return 4; } return 1; } back to top ..

.. lookupdomain # Lookup domain name. Return the current IP of the domain # look_up ( $domain ); sub look_up { local $domain = $_[0]; use Net::hostent; use Socket; unless ( $h = gethost($domain) ) { return "0"; next; } if ( @{ $h->addr_list } > 0 ) { return inet_ntoa( $h->addr ); } else { return "0" } } back to top ..

.. Mailsend Send E Mail How to send Mail in Perl ? Sending e-mail from a Perl/CGI program on a Unix computer system is quite easy. This is done by invoking the Unix sendmail program $toAdd = "you@yourdomain.com"; $fromAdd = "me@mydomain.com"; $subject = "Hey There !"; open(MAIL, "|/usr/lib/sendmail -t"); print MAIL "To: $toAdd\n"; print MAIL "From: $myAdd\n"; print MAIL "Subject: $subject\n"; print MAIL "This is the message body.\n"; print MAIL "Put your message here in the body.\n"; close (MAIL); back to top ..

.. MergingHashes %merged = (); while (( $k, $v ) = each (%A) ) { $merged{$k} = $v; } while (( $k, $v ) = each (%B) ) { $merged{$k} = $v; } back to top ..

.. MySQLCreateTableIf #!/usr/bin/perl use DBI; use Getopt::Long; $VER = "1.5"; $opt_db = "test"; $opt_table = "mails"; $opt_max_mail_size = 65536; $opt_db_engine = "mysql"; $opt_host = "localhost"; $opt_user = $opt_password = ""; $opt_help = $opt_version = 0; $dbh = DBI->connect("DBI:$opt_db_engine:$opt_db:$opt_host",$opt_user, $opt_password,{ PrintError => 0}) || die $DBI::errstr; create_table_if_needed($dbh); sub create_table_if_needed { my ($dbh)=@_; my ($sth,$create); $sth = $dbh->prepare("select count(*) from $opt_table") or die $dbh->errstr; if (!$sth->execute) { $create = "CREATE TABLE $opt_table (msg_nro mediumint unsigned not null "; $create .= "auto_increment, date DATETIME NOT NULL, time_zone CHAR(6) "; $create .= "NOT NULL, mail_from char(120) not null, reply char(120), "; $create .= "mail_to TEXT, cc TEXT, sbj char(200), txt MEDIUMTEXT NOT "; $create .= "NULL, file char(32) noT NULL, hash INT NOT NULL, key "; $create .= "(msg_nro), primary key (mail_from, date, time_zone, hash))"; $sth = $dbh->prepare($create) or die $dbh->errstr; $sth->execute() or die $dbh->errstr; } } back to top ..

.. Numbitint Convert bit to int How to convert bits to int ? To turn a string of 1s and 0s like 10110110 into a scalar containing its binary value, use the pack() function $decimal = pack('B8', '10110110'); Here's an example of going the other way: $binary_string = join('', unpack('B*', "\x29")); back to top ..

.. Numcomma Format number by adding commas How to format a number by adding commas ? #!/usr/local/bin/perl # Write a small sub routine to do the same sub comma_me { local $_ = shift; 1 while s/^(-?\d+)(\d{3})/$1,$2/; return $_; } $mynum = 45674232454.5487; print "After formatting : ", comma_me($mynum), "\n"; After formatting : 45,674,232,454.5487 back to top ..

.. Numlong Format Long Decimals How to get rid of long decimal numbers? Say you need to get rid of long decimals (eg, 3.1415926535) and get just 3.142 printf("%.3f", 3.1415926535); # prints 3.142 back to top ..

.. Numrandom Random Numbers How to generate a random number? Use the rand() function # declare at the top of the program: srand; # not required for 5.004 and later on $rand_no = rand @array; $element = $array[$rand_no]; back to top ..

.. PakageTemplate package ManageOrders; require 5.000; require Exporter; use strict; our $VERSION = '1.02'; our @ISA = qw(Exporter); our @EXPORT = qw(save_order next_sub); =head1 NAME ManageOrders, Manage Orders Files. =head1 SYNOPSIS use ManageOrders; save_order($sc_send_order_to_log, $sc_order_path, $sc_order_log_path, $text_of_cart, $amount); =head1 DESCRIPTION Here go the desciption. =cut use Time::localtime; sub save_order { #The Input Varialbles: my($sc_send_order_to_log, $sc_order_path, $sc_order_log_path, $text_of_cart, $amount) = @_; #Local variables my($tm, $item, $f, $one_line_data, $ssec, $smin, $shour, $sday, $smon, $syear); #The Sub code } sub next_sub { } 1; back to top ..

.. printhtml print <<EOP; <FORM METHOD="POST" ACTION="some.cgi" NAME="Form1"> <table border=0 width='100%'> <tr><td align='center'><h1>Some Text</h1></td></tr> $sometext <tr> <td align='center'>Here</td> </tr> <INPUT TYPE="submit" NAME="GOTO" VALUE="Login"> </table> <INPUT TYPE='hidden' NAME='submitted' VALUE='1'> <INPUT TYPE='hidden' NAME='paramiter' VALUE='$parameter'> <INPUT TYPE='hidden' NAME='submitted' VALUE='1'> </FORM> EOP back to top ..

.. Regularexpressions Regular Expressions in Perl Some Basics before you begin There are three main uses for regular expressions in Perl Matching Substitution Translation. Perl's Regular Expression Operators m/PATTERN/ # This operator returns true if PATTERN is found in $_. s/PATTERN/REPLACEMENT/ # This operator replaces the sub- string matched by PATTERN with REPLACEMENT. tr/CHARACTERS/REPLACEMENTS/ # This operator replaces characters specified by CHARACTERS with the characters in REPLACEMENTS. Did you know, it could be done more neatly ? Every regular expression operator allows the use of alternative pattern delimiters. A delimiter marks the beginning and end of a given pattern. Like for example in the following , m//; The standard delimiters are the slashes (//). But not necessarily. You could use any. This is particularly useful when the string you are matching too has a '/' and it could make it look difficult to decipher. m/\/home\/jack\/myfile.txt/ This becomes hard to read coz' of all the slashes. ANother way would be to use. m!/home/jack/myfile.txt! OR m{/home/jack/myfile.txt} Points to remember While using the Regular Expressions # Always comment what are doing # How you are approaching the issue. remeber there are usually multiple ways of doing something. # proper Commneting always helps you and others Some quick references [] match a class of single characters [^ ] not in list {} allow precise specification of repeated fields. [0123456789] match any single digit [0-9] match any single digit [0-9]+ match any sequence of one or more digits [a-z]+ matches any lowercase word [A-Z]+ matches any uppercase word [ab n]* matches the null string "", "b", any number of blanks , " nab a banana" [^0-9] matches any non-digit charactor [0-9] {5} matches any sequence of 5 digits [0-9] {5,9} matches any sequence of 6 to 10 digits. The patterns can occur anywhere in an input unless anchored. ^ (outside of []) matches at the beginning $ matches at the end /at/ matches at attention flat /^at/ matches at attention but not flat /at$/ matches at flat but not attention /^at$/ matches at and that is all /^at$/i matches at At aT /^[ \t]*$ matches a "Blank line", or any combination of blanks and tabs \ is the escape charactor, it allows metachar to be used as literals Some special escape sequences \t tabs \n newline \r carriage return \f form feed \d is the same as [0-9] \s white space [\t\n\r\f] The Binding Operators (=~ and !~) The match, substitute and translation operations work on the $_ variable by default. But if the string in context is in another variable, then the binding operators come in very handy They let you bind the regular expression operators to a variable other than $_. There are two forms of the binding operator: the regular =~ and its complement !~. The Usage of the =~ operator: $mystring = "Have a good day"; $match = $mystring =~ m/good/; $substitution = $mystring =~ s/good/great/; $translate = $mystring =~ tr/d/D/; print("\$match = $match\n"); print("\$substitution = $substitution\n"); print("\$translate = $translate\n"); print("\$mystring = $mystring\n"); This program displays the following: $match = 1 $substitution = 1 $translate = 2 $mystring = Have a great Day In the above example we get the return values too. Now using all the three, if we do not need the return values then use the following $mystring = "have a good day"; print("have a good day\n") if $mystring =~ m/good/; $mystring =~ s/good/great/; $mystring =~ tr/d/D/; print("\$mystring = $mystring\n"); The output now would be as following String has root. $mystring = have a great Day HTML-codified characters (the % codes) into their ASCII equivalents s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; The above could further be modified to by using the curley braces character quantifier {2} and the case insensitivity switch i. s/%([a-f0-9]{2})/pack("C", hex($1))/egi; The {2} performs the same function as the + and *, but instead of specifying "one or more" or "any number," it specifies "exactly two." You can also specify ranges. For example: "one or two" is represented as {1,2} and "five to ten" as {5,10}. Another beauty of perl : The key to the good stuff of Perl's regular expressions is the parenthesis used for subexpressions, the ([a-f0-9]{2}) in above example. What matches the subexpression is held in a automatic temporary variable, $1, here. If there were more than one subexpression, they would be held in $2, $3, and so on. (By the way, the entire matched expression is held in $0.) back to top ..

.. Removelineend s/\r|\n//g; back to top ..

.. Replace #!/usr/bin/perl # # perl script to recursively replace multiple strings in multiple files. # # written by Rainer Hillebrand # (rainer.hillebrand@muenster.de, http://www.muenster.de/~hillebra/) # # It is being placed in the public domain. It may be # used for commercial use only by prior arrangement with # the author. It may not in any circumstances be resold to # another party. You are free to make non-commercial use of # the ideas and algorithms that this code represents as long # as you do not merely re-phrase it or port it to another # language. If you use any of the code from this program in # another program, that resulting program must be placed # under the GNU Copyleft or similar agreement and source code # from that program must be made available to all who want it. # # # Version 0.82, 14/03/2003 # minor bug # # Version 0.81, 12/03/2003 # lines in the pattern file without the pattern separator #%# are ignored # # Version 0.8, 07/03/2003 # some minor changes for efficiency, # overwrites the files only if changes have been made # # Version 0.7, 27/02/2003 # some documentation added # # Version 0.6 # customize if only the first occurrence and white spaces shall be replaced # # Version 0.5 # removes also leading spaces # # Version 0.4, 12/02/2000 # replaces only ASCII files # # Version 0.3, 30/07/1999 # # Version 0.2, 15/03/1999 # # Version 0.1, 15/01/1999 # first rough version # # usage: perl replace.pl <directory> <pattern_file> # example: perl replace.pl /work/rh/html /temp/pattern.txt # # <directory> is the source of the directory tree # <pattern_file> is the file containing the patterns to be be replaced. # The pattern #%# separates the old string and the new string. # An example in one file: # # oldpattern#%#newpattern # second_oldpattern#%#second_newpattern # # Shall all occurences of the pattern be replaced? If yes, then set the following # variable to 1. $replaceall = 1; # Shall all leading whitespaces be replaced? If yes, then set the following # variable to 1. $replacespace = 1; #----------There is nothing to change for you below this line------ $directory = $ARGV[0]; $patternfile = $ARGV[1]; if (($directory || $patternfile) eq '') { die("usage: perl replace.pl <directory> <pattern_file>\n") } &readpatternfile; &scan_files($directory); &replacepattern; #-------------------------------------------------------------------------- sub readpatternfile { @patterns = (); if (-f $patternfile) { open(PATTERN,"<$patternfile") || return; while ($line = <PATTERN>) { chomp $line; if ($line =~ /\Q#%#\E/) { push (@patterns, $line); } } close (PATTERN); } } #-------------------------------------------------------------------------- sub scan_files { my ($scandir) = shift; my (@scandirs,@files,$newdir,$list); opendir(DIR,$scandir) || warn "can't opendir $scandir: $!\n"; @scandirs = grep {!(/^\./) && -d "$scandir/$_"} readdir(DIR); rewinddir(DIR); @files = grep {!(/^\./) && -T "$scandir/$_"} readdir(DIR); # ignores hidden UNIX-like files like .htaccess closedir (DIR); for $list(0..$#scandirs) { $newdir = "$scandir/$scandirs[$list]"; &scan_files ($newdir); # scans recursively } for $list(0..$#files) { if (-z $files[$list] or $files[$list] =~ /(\.\$\$\$|\.bak)$/) { next # if has zero size, or is a backup file } push (@filesfound, "$scandir/$files[$list]"); } return 1; } #-------------------------------------------------------------------------- sub replacepattern{ foreach $source (@filesfound){ @newfile = (); open (FILE, "<$source") || die "Can't open $source: $!."; @file = <FILE>; close (FILE); $found = 0; $i=0; foreach $line (@file){ $i++; $line =~ s|^[ \t]+|| if $replacespace; if (not $found or $replaceall) { foreach $string (@patterns){ ($old, $new) = split('#%#', $string, 2); if ($line =~ s|\Q$old\E|$new|g){ print $source, ":\n"; print "Found in line number $i \: ", $line; $found = 1; } } } push (@newfile, $line); } if ($found or $replacespace) { open (FILE, ">$source") || die "Can't open $source: $!."; print FILE @newfile; close FILE; } } } back to top ..

.. RxIPAddress Regular Expression for recognizing IP address: if ($_=~ /\.([0-9]){1,3}\.([0-9]){1,3}\.([0-9]){1,3}/){ do something } back to top ..

.. SampleWebSendMailUnix This shows how to send an e-mail on UNIX server #!/usr/local/bin/perl $| = 1; print "Content-type: text/html\n\n"; print "<html>\n"; print "<head>\n"; print "<title>Sample send</title>\n"; print "</head>\n"; print "<body>"; $EMAIL_TO = "info\@your-domain.net"; open(AL,"> tmp") || die "can not open temp file"; print AL "My test text"; close(AL); $ret = system("mail $EMAIL_TO < tmp"); unlink("tmp"); print "Mail sent to $EMAIL_TO"; print "</body>"; print "</html>"; back to top ..

.. SampleWebSendMailWindows This function is usefull on Windows based hosting sites. Windows Perl send-mail program is not always fully compatible with the UNIX perl send-mail program version. The following shows how to send an e-mail on Windows based hosting servers that are using Perl modul "Sendmail" use Mail::Sendmail; $| = 1; print "Content-type: text/html\n\n"; print "<html>\n"; print "<head>\n"; print "<title>Send mail</title>\n"; print "</head>\n"; %mail=(To=>'info@your-domain.net', From=>'info@your-domain.net', Message=>"Test mail"); if(sendmail%mail){print "Mail sent OK.\n"} else {print"Error sending mail:$Mail::Sendmail::error\n"} print "</body>\n"; print "</html>\n"; back to top ..

.. SaveFormResultInFile This program saves the form result after submiting a page. Normaly used for creating database into a text file. You need to have html page with the form. The form should have Action pointing to that file. The file where you going to save the result must have Write permission. $| = 1; sub ReadRequest { if (@_) { local (*in) = @_; } local ($i, $loc, $key, $val); # Read in text if ($ENV{'REQUEST_METHOD'} eq "GET") { $in = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) { $in .= getc; } } @in = split(/&/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Convert %XX from hex numbers to alphanumeric $in[$i] =~ s/%(..)/pack("c",hex($1))/ge; # Split into key and value. $loc = index($in[$i],"="); $key = substr($in[$i],0,$loc); $val = substr($in[$i],$loc+1); $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return 1; } &ReadRequest; print "Content-type: text/html\n\n"; print "<html>\n"; print "<head>\n"; print "<title>Save in file</title>\n"; print "</head>\n"; open(AL,">> /orders/orders.txt") || die 'can not open ../orders/orders.txt file'; foreach $val (@in) { print AL "$val \n"; } close(AL); print "<b><center><FONT COLOR=brown size=5>Thank you\.</FONT></b>\n"; print "</body>\n"; print "</html>\n"; back to top ..

.. SaveInFile If you don't need to send the form result by mail then just save it to the file. $| = 1; sub ReadRequest { if (@_) { local (*in) = @_; } local ($i, $loc, $key, $val); # Read in text if ($ENV{'REQUEST_METHOD'} eq "GET") { $in = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) { $in .= getc; } } @in = split(/&/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Convert %XX from hex numbers to alphanumeric $in[$i] =~ s/%(..)/pack("c",hex($1))/ge; # Split into key and value. $loc = index($in[$i],"="); $key = substr($in[$i],0,$loc); $val = substr($in[$i],$loc+1); $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return 1; } &ReadRequest; print "Content-type: text/html\n\n"; print "<html>\n"; print "<head>\n"; print "<title>Save in file</title>\n"; print "</head>\n"; open(AL,">> /orders/orders.txt") || die 'can not open ../orders/orders.txt file'; foreach $val (@in) { print AL "$val \n"; } close(AL); print "<b><center><FONT COLOR=brown size=5>Thank you\.</FONT></b>\n"; print "</body>\n"; print "</html>\n"; back to top ..

.. Scalar Scalar Variables Scalars are accessed by prefixing an identifier with '$'. scalar: A single value, either numeric or a character string. identifier: A "variable name." It is composed of upper or lower case letters, numbers, and the underscore '_'. Identifiers are case sensitive (like all of perl). Scalars are assigned to using '=' $scalar = expression; And what is remarkable is that strings and numbers are completely interchangable. For example, the statement $test_value = 4; $test_value = 'testing'; In general variable names consists of numbers, letters and underscores But they should not start with a number and the variable $_ is special. Perl is case sensitive, so $a and $A are different. Perl uses all the usual C arithmetic operators: $a = 1 + 2; # Add 1 and 2 and store in $a $a = 3 - 4; # Subtract 4 from 3 and store in $a $a = 5 * 6; # Multiply 5 and 6 $a = 7 / 8; # Divide 7 by 8 to give 0.875 $a = 9 ** 10; # Nine to the power of 10 $a = 5 % 2; # Remainder of 5 divided by 2 ++$a; # Increment $a and then return it $a++; # Return $a and then increment it --$a; # Decrement $a and then return it $a--; # Return $a and then decrement it For strings Perl has the following: $a = $b . $c; # Concatenate $b and $c $a = $b x $c; # $b repeated $c times To assign values Perl $a = $b; # Assign $b to $a $a += $b; # Add $b to $a $a -= $b; # Subtract $b from $a $a .= $b; # Append $b onto $a back to top ..

.. ScriptPath sub script_url { local ($ret, $perlwarn); $perlwarn = $^W; $^W = 0; $ret = 'http://' . $ENV{'SERVER_NAME'} . $ENV{'SCRIPT_NAME'}; $^W = $perlwarn; $script_url = $ret; return $script_url; } back to top ..

.. Sendmailattachment Sometimes we need to send an e-mail with an attachment. The following function is a Windows based Send-mail with attachment. use MIME::QuotedPrint; use MIME::Base64; use Mail::Sendmail 0.75; # doesn't work with v. 0.74! %mail = ( SMTP => 'smtp.somesmtp.com', from => 'info@your-domain.net', to => 'info@your-domain.net', subject => 'Test attachment', ); $boundary = "====" . time() . "===="; $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\""; $message = encode_qp( "Voilà le fichier demandé" ); $file = $^X; # This is the perl executable open (F, $file) or die "Cannot read $file: $!"; binmode F; undef $/; $mail{body} = encode_base64(<F>); close F; $boundary = '--'.$boundary; $mail{body} = <<END_OF_BODY; $boundary Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable $message $boundary Content-Type: application/octet-stream; name="$^X" Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename="$^X" $mail{body} $boundary-- END_OF_BODY sendmail(%mail) || print "Error: $Mail::Sendmail::error\n"; back to top ..

.. SessionGenerateID sub Generate_Session_ID { # This is the session ID that identifies this person srand; $SID = int(rand(1000000000)); open (SID,">$db_path/$program_ID/sessID") || die "Could not open $db_path/$program_ID/sessID. $!"; print SID $SID," ", time," ",shift; # this shift is the seconds the user is off from the server close SID || die "Could not close $db_path/$program_ID/sessID. $!"; } back to top ..

.. SessionReadID sub Return_SID { # This is the session ID that identifies this person open (SESSION,"<$db_path/$program_ID/sessID"); $_ = <SESSION>; close SESSION; my ($stored_SID,$SID_time,$time_offset) = split / /; $SID = $stored_SID; return; # keep the same