What is Perl?

Perl stands for (Practical Extraction and Report Language) and is also a popular CGI 
programming language. Perl makes our life easy in writing complex report processing 
programs, the main strength of the programing language is it's text processing 
facilities and easy manipulation of text files, it is also popularly used for server 
side scripting via CGI method.

How to use Perl for writing a program and executing it?

Following are the numbered steps, that are needed to be followed for successful 
execution of a Perl script :

1) Install Perl in your UNIX/ LINUX system ( get it from http://www.perl.org/get.html ),
if not already installed.

2) Open any text editor in your system and write the codes for the script.

3) Save the script by specifying a file name  with a ".pl" or ".cgi" extension 
( optional ). e.g: test.pl

4) In the above step the script file created can be stored in any location of your 
system but try to save the file in the "cgi-bin" folder ( which is automatically 
created at the time of Perl installation ) because then the script can also be run 
as a CGI script if requirement arises.

5) Finally the script can be executed as follows:
Go to the command prompt of your system and change directory to the location 
where the script is stored.
Type "perl file name.pl" and then hit 
enter. e.g: perl test.pl
or if running a CGI script, then open any web browser and type 
"http://server_address/cgi-bin/" and then hit enter. 
e.g: http://localhost/cgi-bin/test.pl      

Displaying "Hello World" on the screen

#!/usr/bin/perl

print "content-type:text/html\n\n"; #specifies the response header for the Perl script

print "Hello World"; #Displays Hello World on the screen

Output:
-------
Hello World

Scalar variables

Scalar variables are simple variables containing only one element. An element
can be either an entire string, a number, or a reference. Strings may contain any
symbol, letter, or number. Numbers may contain exponents, integers, or decimal
values.

#!/usr/bin/perl

print “content-type: text/html \n\n";

$mystring = "Hello, World";
$myescapechar = "Welcome to Joe\'s";
$myinteger = "5";
$myinteger2 = "-5";
$mypi = "3.14159";

print $mystring;

print $myescapechar;

print $myinteger;

print $myinteger2;

print $mypi;

Output:
-------
Hello, World!
Welcome to Joe's
5
-5
3.1459

Concatenation of strings

Concatenation of strings here means, merging  two or more variables holding 
string type data into one variable side by side.

#!/usr/bin/perl

print "content-type:text/html\n\n";

$str1="Hello";

$str2="World";

$str=$str1." ".$str2;

print $str;

Output:
-------
Hello World

Operators & Assignment

#!/usr/bin/perl

print "content-type: text/html \n\n";

$x = 81;                          
$add = $x + 9;    # calculating addition value
$sub = $x - 9; # calculating minus value
$mul = $x * 10; # calculating multiplication value
$div = $x / 9; # calculating division value
$exp = $x ** 5; # calculating exponential value
$mod = $x % 85; # calculating modulas/ remainder value

print "$x plus 9 is $add";

print "$x minus 9 is $sub";

print "$x times 10 is $mul";

print "$x divided by 9 is $div";

print "$x to the 5th is $exp";

print "$x divided by 85 has a remainder of $mod";

Output :
--------
81 plus 9 is 90
81 minus 9 is 72
81 times 10 is 810
81 divided by 9 is 9
81 to the 5th is 3486784401
81 divided by 79 has a remainder of 2

Array variables in Perl

Arrays are list type variables, they contain any number of elements desired. 

#!/usr/bin/perl

print “content-type: text/html \n\n";

@days = ("Monday", "Tuesday", "Wednesday");
@months = ("April", "May", "June");

print "@days\n";
print "\n"; # displaying new line on the screen
print "@months\n";

Output:
-------
Monday Tuesday Wednesday
April May June

Some more examples of Perl arrays

Individual element in an array can be referred with their subscript position in
the array. The first element in an array is always at position "0". An array 
structure is always circular.

#!/usr/bin/perl

print "content-type: text/html \n\n";  

@array = ("Quarter","Dime","Nickel");

print "@array\n";

print "$array[0]\n"; # Prints the first element in the array

print "$array[1]\n"; # Prints the second element in the array

print "$array[2]\n"; # Prints the third element in the array

print "$array[-1]\n"; # Prints the last element in the array

print "$array[-2]\n"; # Prints second to last element in the array

Output:
-------
Quarter Dime Nickel
Quarter
Dime
Nickel
Nickel
Dime

Hash/ Associative arrays in Perl

Hash/ Associative arrays in Perl are also responsible for storing multiple 
elements together in one variable, as a key value pair.

#!/usr/bin/perl

print "content-type: text/html \n\n"; 

%country_capital_hash=(
'india' => 'New Delhi',
'china' => 'beiging'
);

print "Capital of India is $country_capital_hash{'india'}\n";

Output:
-------
Capital of India is New Delhi

scalar() function in Perl

scalar() is an inbuilt function of Perl responsible for returning the number of
elements present in the array passed to the function

#!/usr/bin/perl

print "content-type: text/html \n\n";

@nums = (1 .. 20); # assigning 1 to 20 in the array sequentially as separate elements
@alpha = ("a" .. "z"); # assigning a to z in the array sequentially as separate elements
$numofnums = @nums;

print "@nums\n";

print "@alpha\n";

print "There are $numofnums numerical elements";

print "There are ".scalar(@alpha)." letters in the alphabet!";

Output:
-------
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
a b c d e f g h i j k l m n o p q r s t u v w x y z
There are 20 numerical elements
There are 26 letters in the alphabet!

join() function in Perl

join() function in Perl is responsible for joining all the elements in an array
into a single string.

#!/usr/bin/perl

print "content-type: text/html \n\n";

@array = ("David","Larry","Roger","Ken","Michael","Tom");
$astring = join(",",@array);
print $astring."\n";

@array2 = qw(Pizza Steak Chicken Burgers);
$string = join("\n",@array2);
print $string;

Output:
-------
David,Larry,Roger,Ken,Michael,Tom
Pizza
Steak
Chicken
Burgers

chomp(), chop(), substr(), length(), uc(), ucfirst(), lcfirst() functions in Perl

These are some inbuilt functions in Perl which are commonly used in the course 
of programing

#!/usr/bin/perl
print "content-type: text/html \n\n";

$str="hello world\n";

chomp($str);  # removes the new line character from the end of a string
print $str."Intrasoft\n";

chop($str); # removes the last character from the end of a string
print $str."\n";

$temp_str=substr($str,4,3); # returns the characters starting from the 5th position of the string to 3 characters from the 5th position of the string
print $temp_str."\n";

$temp_str=substr($str,4); # returns the characters starting from the 5th position of the string till the end of the string
print $temp_str."\n";

$str_len=length($str); # return the length of the string in number of charaters
print $str_len."\n";

$temp_str=uc($str); # converts and returns the string in upper case
print $temp_str."\n";

$temp_str=ucfirst($str); # converts and returns the string with it's 1st character in upper case
print $temp_str."\n";

$temp_str=lc($str); # converts and returns the string in lower case
print $temp_str."\n";

$temp_str=lcfirst($str); # converts and returns the string with it's 1st character in lower case
print $temp_str."\n";

Output:
-------
hello worldIntrasoft
hello worl
o w
o worl
10
HELLO WORL
Hello worl
hello worl
hello worl

splice() function in Perl

splice() function in Perl is responsible for replacing/ removing elements from 
an array by specifying the element subscript positions

#!/usr/bin/perl

print "content-type:text/html\n\n";

@browser = ("NS", "IE", "Opera");

splice(@browser, 1, 2); # removes elements from position 1 and 2 of the array
print "@browser\n";

@browser = ("NS", "IE", "Opera");
splice(@browser, 1, 2, "NeoPlanet", "Mosaic"); # replaces elements present in position 1 and 2 of the array with the respective values specified thereof
print "@browser\n";

Output:
-------
NS
NS NeoPlanet Mosaic

Sorting of an array in Perl

#!/usr/bin/perl

print "content-type: text/html \n\n";

@arr=qw (a c e f d h g i b j);

@arr2=sort(@arr); # default sorting in ascending order
print "Ascending: @arr2\n";

@arr2=reverse sort(@arr); # sorting in descending order
print "Descending: @arr2\n";

Output:
-------
Ascending: a b c d e f g h i j
Descending: j i h g f e d c b a

if and unless conditional statements in Perl

The following example finds the greatest number amongst three given numbers, 
finds the greater number between two given numbers and also checks for the 
equality of two string values

#!/usr/bin/perl

print "content-type: text/html \n\n"; 

$a=1;
$b=2;
$c=3;

if($a > $b && $a > c) # executes if the expression is true
{
 print "$a is greatest\n";
}
elsif($b > $a && $b > $c) # executes if the expression is true
{
 print "$b is greatest\n";
}
elsif($a == $b && $a == $c) # executes if the expression is true
{
 print "all are equal\n";
}
else
{
 print "$c is greatest\n";
}

unless ($b <= $a) # executes if the expression is false
{
 print "$b is greater than $a\n";
}

$string_1="your name";
$string_2="yours name";

if($string_1 eq $string_2) # executes if the expression is true
{
 print "both the strings are same\n"; 
}
else
{
 print "both the strings are not same\n"; 
}

Output:
-------
3 is greatest
2 is greater than 1
both the strings are not same

Numeric Comparison Operators:
-----------------------------
== equal to
!= not equal to
> greater than
< lesser than
>= greater or equal to
<= lesser or equal to

String/ Character Comparison Operators:
-----------------------------
eq => equal to
ne => not equal to
gt => greater than
lt => lesser than

Reading command line arguments with @ARGV array in Perl

@ARGV is a special array in Perl, it holds the arguments passed to the program 
as each element of the array. Therefore $ARGV[0] contains the first argument and 
$ARGV[1] contains the second argument etc.
Following is an example of accepting the name and age of the end user as command 
line arguments and displaying the same as a well formed sentence:

#!/usr/bin/perl
#---------------------#
#  PROGRAM:  test_argv.pl  #
#---------------------#

print "My name is $ARGV[0] and I am $ARGV[1] years old\n";

Running the program from command line:
--------------------------------------
perl test_argv.pl James 33

Output:
-------
My name is James and I am 33 years old

STDIN and STDOUT filehandles in Perl

STDIN is responsible for accepting data from the standard input(e.g: keyboard)
and STDOUT is responsible for transmitting data to standard output(e.g: screen).

#!/usr/bin/perl

print "Enter your name and hit enter:";
chomp($name=<stdin>); # accepting data for name from the end user and storing it in a variable without the new line

print "Enter your age and hit enter:";
chomp($age=<stdin>); # accepting data for age from the end user and storing it in a variable without the new line

print STDOUT "your name is $name and you are $age years old\n"; # STDOUT is optional, as the standard output is screen/ monitor by default

Dynamically populating an array in PERL

Dynamically populating array elements in an array respective to it's index position. 

#!/usr/bin/perl

my @arr;

for (my $i = 0; $i < 55; $i++) {
 $arr[$i] = 'I am element number '.$i;
}

print "Value at Index 0 of Array = ".$arr[0]."\n";
print "Value at Index 1 of Array = ".$arr[1]."\n";
print "Value at Index 2 of Array = ".$arr[2]."\n";
print "Value at Index 3 of Array = ".$arr[3]."\n";
print "Value at Index 4 of Array = ".$arr[4]."\n";

Output:
-------
Value at Index 0 of Array = I am element number 0
Value at Index 1 of Array = I am element number 1
Value at Index 2 of Array = I am element number 2
Value at Index 3 of Array = I am element number 3
Value at Index 4 of Array = I am element number 4

File handling in Perl

The following example shows how to write few lines in a file named "test.txt" 
in the working directory through a Perl script.
After writing to the file, "test.txt" should contain the following:
-------------------
|Name:James Dcosta|
|Age:32           |
|Gender:Male      |
-------------------

#!/usr/bin/perl

print "content-type: text/html \n\n"; 

open(FL,">./test.txt"); # Opening the file in write mode. FL here represents the file handle required and can be any non keyword text

flock(FL,2); # Locking the file for writing

print FL "Name:James Dcosta\n"; # Writing the first line in the file followed by a line break at the end

print FL "Age:32\n"; # Writing the second line in the file followed by a line break

print FL "Gender:Male\n"; # Writing the third line in the file followed by a line break

flock(FL,8); # Releasing the lock from the file

close(FL); # closing the file after writing

After executing the script in the example above and few lines have been written 
in "text.txt" file, the following example shows how to read all the lines from 
the file: 

#!/usr/bin/perl

print "content-type: text/html \n\n"; 

open(FL,"<./test.txt"); # Opening the file in read mode. FL here represents the file handle required and can be any non keyword text

flock(FL,2); # Locking the file for reading

while (!eof(FL)) { # iterating the loop till the end of the file is reached
 chomp($rec=); # fetches the line the file handle is pointing at currently
 print "$rec\n";
}

flock(FL,8); # Releasing the lock from the file

close(FL); # closing the file after writing

Output:
-------------------
|Name:James Dcosta|
|Age:32           |
|Gender:Male      |
-------------------

File opening modes/ entities:
-----------------------------
< read mode
> create and write mode
>> create and append mode
+< read and update mode
+> read and write mode
+>> read and append mode

Advanced sorting of normal arrays, hash/ associative arrays in Perl

The following example shows all possible types of sorting in a normal array and also 
in a hash/ associative array through Perl. 

All The possible types of sorting are as follows :

1) Normal arrays = 2 types (ASCII wise sorting, numerical wise/ alphabetical wise 
sorting) X 2 ways (ascending/ normal order, descending order)

Total we have 4 alternatives for sorting a normal array. 

2) Hash/ Associative arrays:

 i) Sorting on the basis of keys = 2 types (ASCII wise sorting, numerical wise/ alphabetical wise sorting) X 2 ways (ascending/ normal order, descending order)
 
 Total we have 4 alternatives for sorting a hash/ associative arrays based on keys.

 ii) Sorting on the basis of values = 1 type (numerical wise/ alphabetical wise sorting) X 2 ways (ascending/ normal order, descending order)
 
 Total we have 2 alternatives for sorting a hash/ associative arrays based on values.

#!/usr/bin/perl

print "content-type: text/html \n\n";

###### sorting of an array with numeric values ########

@nums=(1,5,4,6,3,7,2,8,10,9);

print "Unsorted numbers from array: @nums\n";

@sorted_nums=sort(@nums); # ASCII wise sorting of normal array and storing the sorted result in another array

print "ASCII wise sorted numbers from array: @sorted_nums\n";

@sorted_nums=sort { $a <=> $b } @nums; # Numeric wise sorting of normal array and storing the sorted result in another array

print "Numeric wise sorted numbers from array: @sorted_nums\n";

@sorted_nums=sort { $b <=> $a } @nums; # Numeric wise sorting of normal array in reverse order and storing the sorted result in another array

print "Numeric wise sorted numbers in reverse order from array: @sorted_nums\n";


###### sorting of an array with character values ########

@chars=("B","a","d","C","E","f");

print "Unsorted characters from array: @chars\n";

@sorted_chars=sort(@chars); # ASCII wise sorting of normal array and storing the sorted result in another array

print "ASCII wise sorted characters from array: @sorted_chars\n";

@sorted_chars=sort { lc($a) cmp lc($b) } @chars; # Alphabet wise sorting of normal array and storing the sorted result in another array

print "Alphabetical wise sorted characters from array: @sorted_chars\n";

@sorted_chars=sort { lc($b) cmp lc($a) } @chars; # Alphabet wise sorting of normal array in reverse order and storing the sorted result in another array

print "Alphabetical wise sorted characters in reverse order from array: @sorted_chars\n";


###### sorting of hash/ associative arrays based on keys ########

%num_hash=(
 1 => "one",
 2 => "two",
 3 => "three",
 4 => "four",
 5 => "five",
 6 => "six",
 7 => "seven",
 8 => "eight",
 9 => "nine",
 10 => "ten",
);

print "\n-------------------------------------------\n";

foreach $key (sort keys%num_hash) # ASCII wise sorting of keys in hash/ associative array and displaying the sorted result on screen
{
 print "ASCII wise sorted numeric keys from hash: key=$key value=$num_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (reverse sort keys%num_hash) # ASCII wise sorting of keys in hash/ associative array in reverse order and displaying the sorted result on screen
{
 print "ASCII wise sorted numeric keys in reverse order from hash: key=$key value=$num_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (sort { $a <=> $b } keys%num_hash) # Numeric wise sorting of keys in hash/ associative array and displaying the sorted result on screen
{
 print "Numeric wise sorted numeric keys from hash: key=$key value=$num_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (sort { $b <=> $a } keys%num_hash) # Numeric wise sorting of keys in hash/ associative array in reverse order and displaying the sorted result on screen
{
 print "Numeric wise sorted numeric keys in reverse order from hash: key=$key value=$num_hash{$key}\n";
}


%char_hash=(
 "B" => "ball",
 "a" => "apple",
 "d" => "doll",
 "C" => "cat",
 "E" => "elephant",
 "f" => "fox",
);

print "\n-------------------------------------------\n";

foreach $key (sort keys%char_hash) # ASCII wise sorting of keys in hash/ associative array and displaying the sorted result on screen
{
 print "ASCII wise sorted character keys from hash: key=$key value=$char_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (reverse sort keys%char_hash) # ASCII wise sorting of keys in hash/ associative array in reverse order and displaying the sorted result on screen
{
 print "ASCII wise sorted character keys in reverse order from hash: key=$key value=$char_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (sort { lc($a) cmp lc($b) } keys%char_hash) # Alphabet wise sorting of keys in hash/ associative array and displaying the sorted result on screen
{
 print "Alplabetical wise sorted character keys from hash: key=$key value=$char_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (sort { lc($b) cmp lc($a) } keys%char_hash) # Alphabet wise sorting of keys in hash/ associative array in reverse order and displaying the sorted result on screen
{
 print "Alplabetical wise sorted character keys in reverse order from hash: key=$key value=$char_hash{$key}\n";
}


###### sorting of hash/ associative arrays based on values ########

%num_hash=(
 "one",1,
 "two",2,
 "three",3,
 "four",4,
 "five",5,
 "six",6,
 "seven",7,
 "eight",8,
 "nine",9,
 "ten",10,
);

print "\n-------------------------------------------\n";

foreach $key (sort { $num_hash{$a} <=> $num_hash{$b} } keys%num_hash) # Numeric wise sorting of values in hash/ associative array and displaying the sorted result on screen
{
 print "Numeric wise sorted numeric values from hash: key=$key value=$num_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (sort { $num_hash{$b} <=> $num_hash{$a} } keys%num_hash) # Numeric wise sorting of values in hash/ associative array in reverse order and displaying the sorted result on screen
{
 print "Numeric wise sorted numeric values in reverse order from hash: key=$key value=$num_hash{$key}\n";
}


%char_hash=(
 "a" => "Ball",
 "b" => "apple",
 "c" => "Cat",
 "d" => "doll",
 "e" => "Elephant",
 "f" => "fox",
);

print "\n-------------------------------------------\n";

foreach $key (sort { lc($char_hash{$a}) cmp lc($char_hash{$b}) } keys%char_hash) # Alphabet wise sorting of values in hash/ associative array and displaying the sorted result on screen
{
 print "Alplabetical wise sorted character values from hash: key=$key value=$char_hash{$key}\n";
}

print "\n-------------------------------------------\n";

foreach $key (sort { lc($char_hash{$b}) cmp lc($char_hash{$a}) } keys%char_hash) # Alphabet wise sorting of values in hash/ associative array in reverse order and displaying the sorted result on screen
{
 print "Alplabetical wise sorted character values in reverse order from hash: key=$key value=$char_hash{$key}\n";
}

Output:
-------
Unsorted numbers from array: 1 5 4 6 3 7 2 8 10 9
ASCII wise sorted numbers from array: 1 10 2 3 4 5 6 7 8 9
Numeric wise sorted numbers from array: 1 2 3 4 5 6 7 8 9 10
Numeric wise sorted numbers in reverse order from array: 10 9 8 7 6 5 4 3 2 1
Unsorted characters from array: B a d C E f
ASCII wise sorted characters from array: B C E a d f
Alphabetical wise sorted characters from array: a B C d E f
Alphabetical wise sorted characters in reverse order from array: f E d C B a

-------------------------------------------
ASCII wise sorted numeric keys from hash: key=1 value=one
ASCII wise sorted numeric keys from hash: key=10 value=ten
ASCII wise sorted numeric keys from hash: key=2 value=two
ASCII wise sorted numeric keys from hash: key=3 value=three
ASCII wise sorted numeric keys from hash: key=4 value=four
ASCII wise sorted numeric keys from hash: key=5 value=five
ASCII wise sorted numeric keys from hash: key=6 value=six
ASCII wise sorted numeric keys from hash: key=7 value=seven
ASCII wise sorted numeric keys from hash: key=8 value=eight
ASCII wise sorted numeric keys from hash: key=9 value=nine

-------------------------------------------
ASCII wise sorted numeric keys in reverse order from hash: key=9 value=nine
ASCII wise sorted numeric keys in reverse order from hash: key=8 value=eight
ASCII wise sorted numeric keys in reverse order from hash: key=7 value=seven
ASCII wise sorted numeric keys in reverse order from hash: key=6 value=six
ASCII wise sorted numeric keys in reverse order from hash: key=5 value=five
ASCII wise sorted numeric keys in reverse order from hash: key=4 value=four
ASCII wise sorted numeric keys in reverse order from hash: key=3 value=three
ASCII wise sorted numeric keys in reverse order from hash: key=2 value=two
ASCII wise sorted numeric keys in reverse order from hash: key=10 value=ten
ASCII wise sorted numeric keys in reverse order from hash: key=1 value=one

-------------------------------------------
Numeric wise sorted numeric keys from hash: key=1 value=one
Numeric wise sorted numeric keys from hash: key=2 value=two
Numeric wise sorted numeric keys from hash: key=3 value=three
Numeric wise sorted numeric keys from hash: key=4 value=four
Numeric wise sorted numeric keys from hash: key=5 value=five
Numeric wise sorted numeric keys from hash: key=6 value=six
Numeric wise sorted numeric keys from hash: key=7 value=seven
Numeric wise sorted numeric keys from hash: key=8 value=eight
Numeric wise sorted numeric keys from hash: key=9 value=nine
Numeric wise sorted numeric keys from hash: key=10 value=ten

-------------------------------------------
Numeric wise sorted numeric keys in reverse order from hash: key=10 value=ten
Numeric wise sorted numeric keys in reverse order from hash: key=9 value=nine
Numeric wise sorted numeric keys in reverse order from hash: key=8 value=eight
Numeric wise sorted numeric keys in reverse order from hash: key=7 value=seven
Numeric wise sorted numeric keys in reverse order from hash: key=6 value=six
Numeric wise sorted numeric keys in reverse order from hash: key=5 value=five
Numeric wise sorted numeric keys in reverse order from hash: key=4 value=four
Numeric wise sorted numeric keys in reverse order from hash: key=3 value=three
Numeric wise sorted numeric keys in reverse order from hash: key=2 value=two
Numeric wise sorted numeric keys in reverse order from hash: key=1 value=one

-------------------------------------------
ASCII wise sorted character keys from hash: key=B value=ball
ASCII wise sorted character keys from hash: key=C value=cat
ASCII wise sorted character keys from hash: key=E value=elephant
ASCII wise sorted character keys from hash: key=a value=apple
ASCII wise sorted character keys from hash: key=d value=doll
ASCII wise sorted character keys from hash: key=f value=fox

-------------------------------------------
ASCII wise sorted character keys in reverse order from hash: key=f value=fox
ASCII wise sorted character keys in reverse order from hash: key=d value=doll
ASCII wise sorted character keys in reverse order from hash: key=a value=apple
ASCII wise sorted character keys in reverse order from hash: key=E value=elephant
ASCII wise sorted character keys in reverse order from hash: key=C value=cat
ASCII wise sorted character keys in reverse order from hash: key=B value=ball

-------------------------------------------
Alplabetical wise sorted character keys from hash: key=a value=apple
Alplabetical wise sorted character keys from hash: key=B value=ball
Alplabetical wise sorted character keys from hash: key=C value=cat
Alplabetical wise sorted character keys from hash: key=d value=doll
Alplabetical wise sorted character keys from hash: key=E value=elephant
Alplabetical wise sorted character keys from hash: key=f value=fox

-------------------------------------------
Alplabetical wise sorted character keys in reverse order from hash: key=f value=fox
Alplabetical wise sorted character keys in reverse order from hash: key=E value=elephant
Alplabetical wise sorted character keys in reverse order from hash: key=d value=doll
Alplabetical wise sorted character keys in reverse order from hash: key=C value=cat
Alplabetical wise sorted character keys in reverse order from hash: key=B value=ball
Alplabetical wise sorted character keys in reverse order from hash: key=a value=apple

-------------------------------------------
Numeric wise sorted numeric values from hash: key=one value=1
Numeric wise sorted numeric values from hash: key=two value=2
Numeric wise sorted numeric values from hash: key=three value=3
Numeric wise sorted numeric values from hash: key=four value=4
Numeric wise sorted numeric values from hash: key=five value=5
Numeric wise sorted numeric values from hash: key=six value=6
Numeric wise sorted numeric values from hash: key=seven value=7
Numeric wise sorted numeric values from hash: key=eight value=8
Numeric wise sorted numeric values from hash: key=nine value=9
Numeric wise sorted numeric values from hash: key=ten value=10

-------------------------------------------
Numeric wise sorted numeric values in reverse order from hash: key=ten value=10
Numeric wise sorted numeric values in reverse order from hash: key=nine value=9
Numeric wise sorted numeric values in reverse order from hash: key=eight value=8
Numeric wise sorted numeric values in reverse order from hash: key=seven value=7
Numeric wise sorted numeric values in reverse order from hash: key=six value=6
Numeric wise sorted numeric values in reverse order from hash: key=five value=5
Numeric wise sorted numeric values in reverse order from hash: key=four value=4
Numeric wise sorted numeric values in reverse order from hash: key=three value=3
Numeric wise sorted numeric values in reverse order from hash: key=two value=2
Numeric wise sorted numeric values in reverse order from hash: key=one value=1

-------------------------------------------
Alplabetical wise sorted character values from hash: key=b value=apple
Alplabetical wise sorted character values from hash: key=a value=Ball
Alplabetical wise sorted character values from hash: key=c value=Cat
Alplabetical wise sorted character values from hash: key=d value=doll
Alplabetical wise sorted character values from hash: key=e value=Elephant
Alplabetical wise sorted character values from hash: key=f value=fox

-------------------------------------------
Alplabetical wise sorted character values in reverse order from hash: key=f value=fox
Alplabetical wise sorted character values in reverse order from hash: key=e value=Elephant
Alplabetical wise sorted character values in reverse order from hash: key=d value=doll
Alplabetical wise sorted character values in reverse order from hash: key=c value=Cat
Alplabetical wise sorted character values in reverse order from hash: key=a value=Ball
Alplabetical wise sorted character values in reverse order from hash: key=b value=apple

Using map and grep in Perl

Using map and grep in Perl

map and grep are very useful functions in Perl, they help to reduce longer lines of 
codes in a script.

map function evaluates a block of code on each element of a given list and returns 
the result of each such evaluation. 

grep function evaluates an expression on each element of a given list and returns 
those elements for which the expression evaluated to true. 

#!/usr/bin/perl

print "content-type: text/html \n\n";

@cities = ("Kolkata","Mumbai","Hydrebad","Kohima","Delhi");

%cities_hash = map {$_ => 1} @cities; # storing the list of cities from @cities array in a new hash, $_ here represents individual element in @cities array

foreach $city (keys%cities_hash) {
 print "$city\n";
}

@cities_with_k = grep {/^k/i} @cities; # filtering cities starting with k and storing them in a new array

print "Cities starting with K: @cities_with_k\n";

Output:
-------
Delhi
Kohima
Mumbai
Kolkata
Hydrebad
Cities starting with K: Kolkata Kohima

Loops in Perl

Perl has four main types of loop i.e: while, until, for, foreach.
Each of the loops have their own characteristcs, which are described in the 
following example: 

#!/usr/bin/perl

print "content-type: text/html \n\n"; 

$i=1;
while ($i<=3) # iterates till the expression is true 
{
 print "while $i\n";
 $i=$i+1;
}

$i=1;
do # the block executes at least once and then tests the expression for next iteration 
{ 
 print "do while $i\n";
 $i=$i+1; 
} while ($i<=0); # iterates till the expression is true 

$i=3;
until ($i<1) # iterates till the expression is false 
{
 print "until $i\n";
 $i=$i-1;
}

$i=3;
do # the block executes at least once and then tests the expression for next iteration 
{ 
 print "do until $i\n";
 $i=$i-1; 
} until ($i<=3); # iterates till the expression is false 

@array=(1,2,3,4,5); # an array of integers

for ($i=0; $i<$#array; $i++) # iterates till the expression is true 
{
 print "for $array[$i]\n";
}

foreach $values (@array) # iterates till the end of the supplied list is reached
{
 print "foreach $values\n";
}

Output:
-------
while 1
while 2
while 3
do while 1
until 3
until 2
until 1
do until 3
for 1
for 2
for 3
for 4
for 5
foreach 1
foreach 2
foreach 3
foreach 4
foreach 5

Working with session variables

The following "set_session.pl" program shows how to set values in session variables:

#!/usr/bin/perl

use CGI;

use CGI::Session; # module required for using session variables 

my $cgi = new CGI;

# object initialized for accesing session variables
my $session = CGI::Session->new();

# setting values in user defined session variables
$session->param('my_name', 'James');
$session->param('my_age', '36');

# defining a cookie with the name "session_id" and storing the current session id as it's value, to be used later for accessing the values stored in the current session variables
my $cookie = CGI::Cookie->new( -name => "session_id", -value => $session->id );

# setting the cookie
print $cgi->header( -cookie =>  $cookie  );

print "Values stored in the session.";

The following "get_session.pl" program will read the values stored in the session variable set in the earlier program:

#!/usr/bin/perl

use CGI;

use CGI::Session;

my $cgi = new CGI;

print $cgi->header();

# retrieving the session id stored in the "session_id" cookie for accessing the earlier set session variables
my $session_id = $cgi->cookie("session_id");

# object initialized for accesing session variables from the passed session id
my $session = CGI::Session->new($session_id);

# fetching the values stored in session variables
my $name = $session->param('my_name');
my $age = $session->param('my_age');

print "My name is $name and I am $age years old.";

Output:
-------
On calling the "set_session.pl" program from browser, it will set an user defined name and age in session variables named 'my_name' and 'my_age' respectively to be accessed by other programs in the current session, the session id of the current session is stored in a cookie named "session_id" and then on calling the "get_session.pl" program from browser, it will fetch the session id stored in the cookie named "session_id" for accessing the session variables associated with id.

Working with cookies in Perl

The following "set_cookie.pl" program shows how to set cookies in perl:

#!/usr/bin/perl

use CGI; 

my $cgi = new CGI;

# creating cookies by specifying name and value for the cookie items with lifespan of the cookies set to 1 hour  

my $cookie_1 = $cgi->cookie( -name => 'friend_name',  -value => 'James Dcosta', -expires => '+1h'); 

my $cookie_2 = $cgi->cookie( -name => 'friend_age', -value => '36', -expires => '+1h');

# setting the cookies via response header 
print $cgi->header( -cookie => [$cookie_1, $cookie_2] );

print "Cookie Set";

The following "read_cookie.pl" program will read the cookie values set in the earlier program:

#!/usr/bin/perl

use CGI; 

my $cgi = new CGI;

print $cgi->header();

# reading the cookie values via CGI object

my $friend_name = $cgi->cookie('friend_name');

my $friend_age = $cgi->cookie('friend_age');

print "Reading values from cookies 
";

print "Friend Name: ".$friend_name."
";

print "Friend Age: ".$friend_age."
";

Output:
-------
On calling the "set_cookie.pl" program from browser, it will set friend name and age in cookies named 'friend_name' and 'friend_age' respectively and then on calling the "read_cookie.pl" program from browser, it will read the cookies named 'friend_name' and 'friend_age' set earlier and display on the screen.

Database programming in Perl

Database programming in Perl shows how to connect to a mysql or oracle database or any 
other database and execute any sql statement in the connected database through a Perl 
program.

The following example shows connecting to a database and executing insert, update, 
select statement on a table of the connected database through the DBI module.

Following is the table structure with a record set, on which the following example 
is operating:

---------------------------------------------------------------
|Tablename: employee|                                         |
|-------------------------------------------------------------|
|emp_id(varchar(255))|employee_name(varchar(255))|age(integer)|
|--------------------|---------------------------|------------|
|001                 |James Dcosta               | 35         |
---------------------------------------------------------------

#!/usr/bin/perl

use DBI; # the module required for performing the database programming operations

$dbh=DBI->connect("dbi:mysql:db_name:server_name","db_username","db_password"); # establishing a data base connection by specifying the database driver (here dbi:mysql is used for connecting to a mysql database), database name, server ip or name of the server where the database is residing and then the database username and the database password respectively

$sth=$dbh->prepare("insert into employee(emp_id,employee_name,age) value(?,?,?)"); # preparing the insert statement with place holders (?), for emp_id, employee_name, age and storing it in a statement handle 

$sth->execute("002","Michael Jonson",40); # executing the statement by passing respective values for the place holders, here employee id, employee name and age 

print "Record Inserted\n";

$sth=$dbh->prepare("select emp_id,employee_name,age from employee where emp_id=?"); # preparing the select statement with place holders (?) for emp_id, employee_name, age and storing it in a statement handle 

$sth->execute("002"); # executing the statement by passing respective values for the place holders, here employee id 

while(@data=$sth->fetchrow_array()) # fetching one row at a time from the table and storing it in an array
{
 print "$data[0] -- $data[1] -- $data[2]\n"; # displaying the fetched records on the screen, the first element of the array holds the first column data and then the second element of the array holds the second column data from the row respectively, etc
}

$sth->finish(); # indicates that no more data will be fetched from this statement handle

$sth=$dbh->prepare("update employee set age=? where emp_id=?"); # preparing the update statement with place holders (?), for updating age for a given employee id

$sth->execute(45,"002"); # executing the statement by passing respective values for the place holders, here new value for age and employee id of the employee whose age is to be modified 

print "Record Modified\n";

# displaying all rows from the table

$sth=$dbh->prepare("select emp_id,employee_name,age from employee");

$sth->execute();

while(@data=$sth->fetchrow_array())
{
 print "$data[0] -- $data[1] -- $data[2]\n";
}

$sth->finish();

Output:
-------
002 -- Michael Jonson -- 40
001 -- James Dcosta -- 35
002 -- Michael Jonson -- 45

Regular expressions in Perl

Regular expressions are a syntax that helps in string type data manipulation, like pattern matching, string selections and string replacements.

Following is a simple example showing how to use regular expressions in Perl.

#!/usr/bin/perl

print "content-type: text/html \n\n";

$string = "Hello And Good Morning James";

if ($string =~ m/Good/) # m before the first slash is the "match" operator, returns true if "Good" is found in the string.
{
 print "Good found in $string\n";
}

if ($string =~ m/^Hello/) # ^ after the first slash signifies matching to be done from the starting of the string, returns true if "Hello" is found at the starting of the string. 
{
 print "Hello found at the starting of $string\n";
}

if ($string =~ m/James$/) # $ before the last slash signifies matching to be done from the ending of the string, returns true if "James" is found at the end of the string. 
{
 print "James found at the end of $string\n";
}

if ($string =~ m/good/i) # i after the last slash signifies matching to be done ignoring the case, returns true if "good" in any case (upper, lower, toggle, sentence) is found in the string.
{
 print "good found in $string\n";
}

$string =~ m/Hello And(.*)James/; # (.*) in the pattern returns the missing/ unknown characters from the string in a special variable

$fetched_string = $1; # $1 here represents the special variable holding the returned missing/ unknown characters from the previous regular expression.
print "$fetched_string\n";

$string =~ s/Morning/Evening/; # s before first slash is "substitute" operator, here if "Morning" is present in the string it will be replaced with "Evening". 
print "$string\n";

Output:
-------
Good found in Hello And Good Morning James
Hello found at the starting of Hello And Good Morning James
James found at the end of Hello And Good Morning James
good found in Hello And Good Morning James
 Good Morning
Hello And Good Evening James

CGI scripting in Perl

In simple term CGI scripting in Perl denotes posting/ passing of values via get/ post method ( e.g: from a html form ) to a server side Perl script, which in turn accepts those values for further processing.

#!/usr/bin/perl

use CGI; # required for CGI programming

print "content-type:text/html\n\n"; # defining output type header

my $q = new CGI; # creating a CGI object, required here for accepting the values passed to the script

my $submit_value = $q->param('submit'); # accepting value of the submit button passed to the script on form submission

if ($submit_value eq '') {
 &form(); # if submit button is not clicked, a call is made to this subroutine to display the html form 
}
else
{
 &show(); # if submit button is clicked, a call is made to this subroutine to process the values passed from the html form 
}

sub form 
{
 # following displays the html form in the web browser
 print qq{
  
   
    
   
   
    

    Enter Your Name :  


    Enter Your Age :  


    Enter Your Address :  


    
    
   
  
 };
}

sub show
{
 # following accepts values of the text boxes present in the html form and passed to the script on form submission
 my $my_name_value = $q->param('my_name');
 my $my_age_value = $q->param('my_age');
 my $my_addr_value = $q->param('my_addr');
 
 # following displays a html output, using the values passed to the script on form submission
 print qq{
  Hello!!! My name is $my_name_value 


  I am $my_age_value years old 


  I live in $my_addr_value 


  Back
 };
}

Output:
-------
Considering the above script filename to be 'test_cgi.pl' present inside the location '/var/www/cgi-bin/test/' of the web server, to checkout the file uploading functionality, please call the above script in the following format from a web browser:

http://server_address/cgi-bin/test/test_cgi.pl

Now input your name, age, address in the text boxes provided, then click on submit and see the magic!!! 

File uploading script using CGI in Perl

Following is a simple example of uploading a file in the web server using Perl.

#!/usr/bin/perl

use CGI; # required module for CGI scripting

print "content-type: text/html \n\n";

my $q = new CGI; # create a CGI object

my $upload = $q->param("upload"); # using CGI param method to accept value passed to the program as a parameter

if ($upload) {
 &upload_file();
}
else
{
 &form();
}

sub form 
{
 print qq{
  

  Upload Photo: 

  
  
 };
}

sub upload_file
{
 my $upload_dir = "/var/www/html/test";

 my $filename = $q->param("photo"); # fetching the uploaded file name passed as posted parameter
 $filename =~ s/.*[\/\\](.*)/$1/;
 my $upload_filehandle = $q->upload("photo"); # fetching the content of the uploaded file

 open FL, ">$upload_dir/$filename";
 while ( <$upload_filehandle> )
 {
  print FL;
 }
 close FL;

 print qq{
  Thankyou for uploading your photo!!!

  
 };
}

Output:
-------
Considering the above script filename to be 'file_upload.pl' present inside the location '/var/www/cgi-bin/test/' of the web server, to checkout the file uploading functionality, please call the above script in the following format from a web browser:

http://server_address/cgi-bin/test/file_upload.pl

Copying files to and from a remote server using FTP in Perl

Following is a simple script to copy files to and from a remote server in the network using FTP.

#!/usr/bin/perl

use Net::FTP; # required module for FTP

my $ftp = Net::FTP->new('remoteserver ipaddress') or die "Cannot connect : $@"; # Connect to remote server for FTP

$ftp->login('username','password') or die "Cannot login :", $ftp->message; # Login to remote server using FTP username and password

$ftp->cwd("/var/www/test") or die "Cannot change directory :", $ftp->message; # Change working directory in the remote server for file transfer

$ftp->get("data.csv") or die "Cannot get file :", $ftp->message; # Fetching a file from the working directory (mentioned in the previous line using cwd) of remote server, to the working directory of the script in the running server

$ftp->put("/var/www/html/test.html") or die "Cannot put file :", $ftp->message; # Copying a file from the specified path of the script in the running server, to the working directory (mentioned in the previous line using cwd) of remote server

$ftp->quit(); # Closing the ftp connection

Output:
-------
On execution of the script, a FTP connection to the remote server will be opened and 'data.csv' file from '/var/www/test' location of the remote server will be copied to the working directory of the script running server and then '/var/www/html/test.html' from the specified location of the script running server will be copied to the '/var/www/test' location of the remote server.

A simple Perl script to send an email with attachment

Following is a simple email sending script in Perl, it also shows how to send an attachment file along with the email.

#!/usr/bin/perl

use MIME::Lite; # required module for formatting and sending the email using sendmail  

my $msg = MIME::Lite->new(
 From    => 'youraddress@youraddress.com', # sender email address
 To      => 'toaddress@toaddress.com',  # recipient email address 
 Cc      => 'ccaddress@ccaddress.com',  # optional, mention Cc recipient email address if required
 Type    => 'text/plain',   # main body type of the email, here it is text
 Subject => 'Email sending script exapmple', # mail subject line
 Data    => 'My first email sending perl script with an image file attachment', # main email body text
);

# the following portion is optional, required only in case of sending file attachments with the email 
$msg->attach(
 Type     =>'image/gif',   # attachment file type, here it is an image file
 Path     =>'/var/www/html/test.jpg', # location of the file in the server i.e to be attached with the email
 Filename =>'my_attachment.jpg'  # optional, only required for renaming the file attached in the email 
);

if ($msg->send()) # email sent and the returned status checked
{
 print "Mail sent successfully";
}
else
{
 print "Unable to send mail";
}

Output:
-------
It will send an email along with the attachment to the mentioned recipients on execution of the script.

Retrieving source of web pages and doing a bit more using LWP::UserAgent

The following program shows how to do something more along with retrieval of any web page source, like handling of cookies stored by the web page, specifying a desired browser agent for calling the web page and posting values to a web page.

#!/usr/bin/perl

use LWP::UserAgent; # required module to retrieve the source of any web page

use HTTP::Cookies; # required module for handling cookies

my $ua = new LWP::UserAgent; # create an object of LWP::UserAgent module to access it's methods

$ua->agent('Mozilla/8.0'); # specifying a browser agent, if required

# storing cookies in the file mentioned
$ua->cookie_jar(
 HTTP::Cookies->new(
  file => 'mycookies.txt',
  autosave => 1
 )
);

# posting values to a web page and retrieving it's source
my $response = $ua->post("http://www.hisdates.com/index.html",{name => "James Dcosta",age => "36"});

# on successful retrieval of the web page source, display the same on the screen else display the error message 
if ($response->is_success) {
 print $response->content;
}
else
{
 print $response->status_line;
}

Output:
-------
On running the Perl script from command line, the html source for the webpage "http://www.hisdates.com/index.html" will be displayed on the screen. 

Retrieving source of web pages using LWP::Simple

A simple example to show how to fetch a web page source and display on the screen.

#!/usr/bin/perl

use LWP::Simple; # required module to retrieve the source of any web page

my $content = get("http://www.hisdates.com/index.html"); # retrieving the source of web page and storing in a variable

print $content; # display the web page source on the screen

Output:
-------
On running the Perl script from command line, the html source for the webpage "http://www.hisdates.com/index.html" will be displayed on the screen. 

Autoposting to twitter account using WWW::Mechanize module (No More Functional Just An Example For Working With WWW::Mechanize Module)

WWW::Mechanize module is used for automatic interaction with websites, this method is also termed as web scrapping, it helps a Perl program to interpret as an individual website visitor and perform many actions automatically on behalf of the individual user. 
In the following example we have used this module for automatic posting of twit/ message into a twitter account, scrapping twitter mobile website.

#!/usr/bin/perl

use WWW::Mechanize; # required module for webpage scrapping

my $twitter_username = 'provide here twitter account username'; # twitter account username
my $twitter_password = 'provide here twitter account password'; # twitter account password

my $message = 'Hello Folks!!!'; # twit to be posted in the twitter account

my $uaa = "Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13 ( .NET CLR 3.5.30729; .NET4.0C)"; # specifying the browser agent

my $mech = WWW::Mechanize->new( agent => $uaa ); # creating an object of mechanize module 

$mech->get('https://mobile.twitter.com/session/new'); # calling the required url and fetching the webpage

$authenticihty_token = $mech->field('authenticity_token'); # fetching the authenticity token value from a hidden field named 'authenticity_token' in the fetched webpage, which is required for logging into this website

$mech->post( 'https://mobile.twitter.com/session', { authenticity_token => $authenticihty_token, username => $twitter_username, password => $twitter_password } ); # posting the required values to another url for further processing ( here it is logging into the mobile twitter website )

$mech->post( 'https://mobile.twitter.com/', { authenticity_token => $authenticihty_token, commit => 'Tweet', 'tweet[text]' => "$message" } ); # posting the twit/ message in the twitter account 

if ( $mech->success() ) # returns true if earlier mechanize posting was successful
{
 print qq{Twitter posting successful\n};
}
else
{
 print qq{Twitter posting unsuccessful\n};
}

Output:
-------
On running the Perl script from command line, it will post the specified message into the twitter account mentioned in the script.

Perl script to fetch multiple messages from an Amazon SQS queue

A way out to retrieve multiple messages in a batch from an AWS queue.

#!/usr/bin/perl

use Amazon::SQS::Simple; # module required for accesing Amazon SQS

# Amazon AWS credentials
my $access_key = 'xxxxxxxxxxxxxxxx'; # Your AWS Access Key ID
my $secret_key = 'xxxxxxxxxxxxxxxx'; # Your AWS Secret Key

my $sqs = new Amazon::SQS::Simple($access_key, $secret_key); # Create a SQS object providing the AWS credentials

my $queue = $sqs->GetQueue("queue url"); # create an object for accessing an old queue  

while (1) # working in an infinite loop
{    
 my @msg = $queue->ReceiveMessage( MaxNumberOfMessages => 10 ); # get the messages into @msg array, here 10 messages are retrieved in a batch

 if ( !scalar(@msg) ) # will be true if no more messages are present in the queue 
    {
  print "Probably no data in queue\n";
 }
 
 foreach my $msg (@msg) # read one by one the messages from the @msg array  
    {
  my $message = $msg->MessageBody(); # fetch the message body

  print "$message\n"; # displaying the message body on the screen

  $queue->DeleteMessage( $msg->ReceiptHandle() ); # delete the retrieved message from the queue, if required 
 }
}

$queue->Delete(); # delete the AWS queue, if required 

Output:
-------
On running the Perl script from command line, it will output on the screen, all the messages reading from the AWS queue.

Working with Amazon SQS in Perl

The following perl program shows how to access the Amazon SQS (Simple Queue Service) for storing and retrieving messages using the Amazon::SQS::Simple module.

#!/usr/bin/perl

use Amazon::SQS::Simple; # module required for accesing Amazon SQS

# Amazon AWS credentials
my $access_key = 'xxxxxxxxxxxxxxxx'; # Your AWS Access Key ID
my $secret_key = 'xxxxxxxxxxxxxxxx'; # Your AWS Secret Key

my $sqs = new Amazon::SQS::Simple($access_key, $secret_key); # Create a SQS object providing the AWS (Amazon Web Services) credentials

my $queue = $sqs->CreateQueue("queue name"); # optional, create a queue if required or else follow the next step for accesing an old queue

# or

my $queue = $sqs->GetQueue("queue url"); # create an object for accessing an old queue  

$queue->SendMessage("Hello World!!!"); # store "Hello World!!!" message in the AWS queue

my $msg = $queue->ReceiveMessage(); # retrieving a stored message from the AWS queue

my $message = $msg->MessageBody(); # fetch the message body

print $message; # displaying the message body on the screen

$queue->DeleteMessage( $msg->ReceiptHandle() ); # delete the retrieved message from the queue, if required 

$queue->Delete(); # delete the AWS queue, if required 

Output:
-------
On running the Perl script from command line, it will output "Hello World!!!" on the screen reading from the AWS queue.

Working with Amazon S3 in Perl

The following perl program shows how to store and retrieve files to and from Amazon S3 buckets.

#!/usr/bin/perl
use Net::Amazon::S3; # Required module for accessing the AWS bucket

# Amazon AWS credentials
my $access_key = 'xxxxxxxxxxxxxxxx'; # Your AWS Access Key ID
my $secret_key = 'xxxxxxxxxxxxxxxx'; # Your AWS Secret Key

# Create a S3 object providing the AWS credentials
our $s3 = Net::Amazon::S3->new(
    {
        aws_access_key_id     => $access_key,
        aws_secret_access_key => $secret_key
    }
);

# create a new s3 bucket
my $bucket = $s3->add_bucket( { bucket => 'test_bucket' } ) or $s3->error;

# or use an existing s3 bucket
$bucket = $s3->bucket('test_bucket');

# storing a file in the bucket, the first parameter is the source filename and the second parameter is the target filename
$bucket->add_key_filename( 'watermark.jpg','watermark.jpg', { content_type => 'image/jpeg', },) or $s3->error;

# create a file directly in the bucket and store content in the file on the fly
$bucket->add_key( 'message.txt',"hello how are you", { content_type => 'text/javascript', 'x-amz-meta-colour' => 'orange', acl_short => 'private' } );

# list files in the bucket
$response = $bucket->list_all or $s3->error;

# iterates a loop for reading all files in the bucket one by one 
foreach my $key ( @{ $response->{keys} } ) {
 my $key_name = $key->{key};  # returns the filename
 my $key_size = $key->{size}; # returns the size of the file 
 print "Bucket contains key '$key_name' of size $key_size\n";
}

# downloads a file from the bucket
$response = $bucket->get_key_filename( 'watermark.jpg', 'GET', 'watermark_dwld.jpg' ) or $s3->error;

# deleting a file from the bucket
$bucket->delete_key('watermark.jpg');

Output:
-------
On running the Perl script from command line, it will create a bucket named 'test_bucket' in Amazon S3, store a file named 'watermark.jpg' in the bucket, create a file named 'message.txt' in the bucket with content 'hello how are you' written in the file on the fly, display names and sizes of all files stored in the bucket, download the file named 'watermark.jpg' stored in the bucket with the name 'watermark_dwld.jpg' in the working directory of the Perl script and finally delete the file name 'watermark.jpg' from the bucket. 

Reading Google contact list using OAuth 2.0

The following perl program shows how to fetch any user's contact list from google using Oauth 2.0 authentication method.

Firstly you need to create a project in google developers section and fetch the client id and client secret key of the same for using in this program, you also need to specify a redirect url in the google end, remember to give permission to "contacts_api" from api section at the google end and the same shall also be specified in the following program.

#!/usr/bin/perl
use CGI;
use JSON;
use LWP::UserAgent;
use Data::Dumper;

my $cgi = new CGI();
my $json = new JSON;

######## google api client id and client secret key
my $client_id = 'xxxxxxxxxxxxxxxxxxx';
my $client_secret = 'xxxxxxxxxxxxxxxx';

######## accepting the authentication code passed from google via redirect_uri
my $code=$cgi->param("code");

if ($code) {
 print "content-type:text/html\n\n";
 
 my $ua = LWP::UserAgent->new;

 my $accessTokenUrl="https://accounts.google.com/o/oauth2/token";
 
 ######## calling google url for fetching the access token
 my $r = $ua->post($accessTokenUrl,{client_id=>$client_id, client_secret=>$client_secret, code=>$code,redirect_uri=>'http://server_address/cgi-bin/google_api.pl',grant_type=>'authorization_code'}); 

 my @json_contacts;
 if ( $r->is_success ) {
  my $cont=$json->decode( $r->content );
  
  my $access_token=$cont->{'access_token'};
  
  if ( $access_token  ) {  
   
   ######## calling google url for fetching contacts in JSOn format
   my $r = $ua->get( "https://www.google.com/m8/feeds/contacts/default/full?alt=json&max-results=10000&oauth_token=$access_token");   
   my $data = $json->decode( $r->content );
    my @contacts;
    foreach  (@{$data->{'feed'}->{'entry'}}) {
     my $name = $_->{'title'}->{'$t'};
     my $email = $_->{'gd$email'}[0]->{'address'};
     next if(!$email);
     if (!$name)
     {
      $email=~ m!^(.*?)@.*!;
      $name=$1;
     }

     ######## storing the individual contact name and email address in an array
     push(@contacts,{ name => $name, email => $email});
    }
      
   print Dumper(@contacts); 
   exit;
   }

 } 
}
else
{
 ####### calling the following google url for requesting authentication from the user to read his/ her contact list 
 print "Location:https://accounts.google.com/o/oauth2/auth?client_id=$client_id&scope=https://www.google.com/m8/feeds/&response_type=code&redirect_uri=http://server_address/cgi-bin/google_api.pl\n\n";
 exit;
}

Output:
-------
On calling the program url "http://server_address/cgi-bin/google_api.pl" from any web browser, it will pop an authentication dialog box asking permission to access the google contact list of the user, on successful authentication, the full contact list will be dumped as output on the screen. 

Sending Email with Amazon Simple Email Service ( SES )

In the following example we are using the Net::AWS::SES::Signature4 module (Signing with signature version 4) to 
send emails using the Amazon SES system. 

Please remember to gather the Amazon AWS access key and secret key from your Amazon AWS account.

#!/usr/bin/perl

use Net::AWS::SES::Signature4;
use MIME::Lite;

our $access_key = 'Provide the Amazon AWS access key';
our $secret_key = 'Provide the Amazon AWS secret key';

##### creating a Net::AWS::SES::Signature4 object
my $ses = Net::AWS::SES::Signature4->new(access_key => $access_key, secret_key => $secret_key);

##### constructing the email structure using the MIME::Lite module
my $msg = MIME::Lite->new(
 From    => 'senderemail@gmail.com',
 To      => 'recipientemail@gmail.com',
 Subject => 'Testing Email Sending Using SES',
 Data    => 'Hello Guyz!',
 Encoding => 'base64',
 Type    => 'text/plain',
 Charset => 'UTF-8'
);

##### adding attributes to the email
$msg->attr('content-type.charset' => 'UTF-8');

##### adding headers to the email
$msg->add( 'Reply-To' => 'senderemail@gmail.com' ) ;

##### posting our constructed email to AWS SES to deliver the same
my $r = $ses->call('SendRawEmail', {
 'RawMessage.Data' => encode_base64( $msg->as_string )
});

##### verifying the email sent status from the response object of AWS SES
unless ( $r->is_success ) {
 printf('Error in SES mail sending: %s' , $r->error_message) ; 
} 
else
{
 printf('SES mail sending successful with message_id %s' , $r->message_id) ; 
}

Output:
-------
On running the Perl script from command line, it will send an email using the Amazon SES.

Auto Posting a tweet along with an image to a Twitter handle via Oauth

In the following example we are using the Net::Twitter module to auto post a tweet along with an image into a twitter account via Oauth. 
Please remember to gather the twitter account consumer key, consumer secret and access token details from twitter developer account.

#!/usr/bin/perl

use Net::Twitter;

my $twitter_username = 'Provide here twitter account username'; # twitter account username
my $twitter_password = 'Provide here twitter account password'; # twitter account password

my $nt = Net::Twitter->new(
  traits          => ['API::RESTv1_1', 'OAuth'],
  consumer_key    => 'Provide here the twitter developer consumer key',
  consumer_secret => 'Provide here the twitter developer consumer secret',
);

my $image_file = '/tmp/flower.png'; # image to be posted in the twitter account
my $message = 'Hello Folks!!!'; # twit to be posted in the twitter account

my $access_token = 'Provide here the twitter app access token';
my $access_token_secret = 'Provide here the twitter app access token secret';


if ($access_token && $access_token_secret) {
  $nt->access_token($access_token);
  $nt->access_token_secret($access_token_secret);
}

my @filename;
@filename = ($image_file) if($image_file);

my $result;

if (scalar(@filename)) {
 $result = $nt->update_with_media({status=>$message,media=>\@filename});
}
else
{
 $result = $nt->update({status=>$message});
}

    unless ( $result->{id} ) {
        #print Dumper($result);
        print qq{Twitter posting unsuccessful\n};
        exit;
    }

    print qq{Twitter posting successful\n};

};

if ($@) {
    print qq{Twitter posting unsuccessful $@\n};
    exit;
}

Output:
-------
On running the Perl script from command line, it will post the specified image and message into the twitter account mentioned in the script.

A Simple Mojolicious Application Using DBI Showcasing Insertion, Updation And Deletion Of Records

In the following example we are building a simple application using Mojolicious which is one of the relatively new, 
light-weight, modern web application frameworks of Perl. 

Here we shall be using the 'Mojolicious::Lite' CPAN module specifically.

Here the following Application or Program name is 'hello_mojo.pl'

#!/usr/bin/perl
use Mojolicious::Lite;

# connect to database
use DBI;
my $dbh = DBI->connect("dbi:SQLite:database.mydb","","") or die "Could not connect";

# creating table if same already not existing
$dbh->do('CREATE TABLE IF NOT EXISTS people (emp_id INTEGER PRIMARY KEY AUTOINCREMENT, name varchar(255),
 age int)');

# shortcut for use in template and inside routes
helper db => sub {$dbh};

# The following blocks are called routes where respective functionalities are defined to be executed 

# when '/' or base url is called by any method (GET/ POST) 
any '/' => sub {
	my $self = shift;
	my $message;

	# assigning a template variable
	$self->stash(message => '');

	# calling a template by it's first name to render output
	$self->render('index');
};

# when '/insert' url is called by any method (GET/ POST) 
any '/insert' => sub {
	my $self = shift;
	my $name = $self->param('nm');
	my $age  = $self->param('age');

	$self->db->do(qq{INSERT INTO people(name, age) VALUES(?,?)}, undef, $name, $age);
	$self->redirect_to('/');
};

# when '/edit' url is called by any method (GET/ POST) 
any '/edit' => sub {
	my $self = shift;
	my $emp_id = $self->param('emp_id');
	
	# assigning a template variable with respective value
	$self->stash(emp_id => $emp_id);
	$self->render('edit_form');

};

# when '/edit_record' url is called by any method (GET/ POST) 
any '/edit_record' => sub {
	my $self = shift;	
	my $emp_id = $self->param('emp_id');
	my $name = $self->param('nm');
	my $age  = $self->param('age');

	$self->db->do(q[UPDATE people SET name = ?, age = ? WHERE emp_id = ?], undef, $name, $age, $emp_id);
	$self->redirect_to('/');
};

# when '/delete' url is called by any method (GET/ POST) 
any '/delete' => sub {
	my $self = shift;
	my $emp_id = $self->param('emp_id');

	$self->db->do(q[DELETE FROM people WHERE emp_id = ?], undef, $emp_id);
	
	my $message;
	$self->stash(message => 'Record Deleted');	
	$self->render('index');
};

# staring the mojolicious application, should be the last expression in the application
app->start;


# Following segment defines the embedded template definitions, here we have used 2 templates 
one 'index.html.ep' and the other 'edit_form.html.ep'
__DATA__

@@ index.html.ep
% my $sth = db->prepare(qq{select emp_id, name, age from people order by emp_id});


	


	<%= $message %>
	

		

			
Enter Name :

			
Enter Age :

			

		
	
	


	
		% $sth->execute();	
		% my $i=0;
		% while(my ($emp_id, $name, $age) = $sth->fetchrow_array()) {	
			% $i++;
			
		% }
		% $sth->finish();
	

		

			
Sl No:
Name
Age
Action
		

				
<%= $i %>
				
<%= $name %>
				
<%= $age %>
				
Edit / 
Delete
			



@@ edit_form.html.ep
% my $sth = db->prepare(q{select name, age from people where emp_id = ?});
% $sth->execute($emp_id);
% my ($name, $age) = $sth->fetchrow_array();
% $sth->finish();


	


	

		

			
Edit Record
			
Enter Name :

			
Enter Age :

			

		
		
	

Steps To Run The Application:
-----------------------------
1) On the command prompt goto the directory where the application is created, type the following and hit enter.

morbo hello_mojo.pl

Output of the above command: Server available at http://127.0.0.1:3000

2) Now the application is running and the desired html output can be viewed in the web browser using 
http://127.0.0.1:3000 or http://localhost:3000 or whatever is the server address using port 3000.

Using switch case in Perl

In the following example we can see the usage of switch case in Perl. 

Here we shall be using the 'Switch' CPAN module specifically.

Here the following Program name is 'switch_case.pl'

#!/usr/bin/perl
use Switch;

# Defining an array of numbers
my @arr = (1, 2, 3, 4);

# Selecting any random element from the array
my $randomnumber = $arr[rand @arr];

# using the switch case functionality
switch($randomnumber) {
 case 1 { print "First Element Of Array: $randomnumber\n" } 
 case 2 { print "Second Element Of Array: $randomnumber\n" } 
 case 3 { print "Third Element Of Array: $randomnumber\n" } 
 else   { print "Fourth Element Of Array: $randomnumber\n" } 
}

Steps To Run The Program:
-------------------------
1) On the command prompt goto the directory where the program is created, type the following and hit enter.

perl switch_case.pl

Output of the above program is either of the following lines:

First Element Of Array: 1

or 

First Element Of Array: 2

or 

First Element Of Array: 3

or 

First Element Of Array: 4

Usage of alarm signal handler '$SIG{ALRM}' in Perl

In the following example we can see the usage of alarm signal handler '$SIG{ALRM}' in Perl. 

$SIG{ALRM} is used to execute definite lines of code on regular time intervals, in a program's normal course of execution. Here we shall display "Hello World" text after every 30 seconds.

Here the following Program name is 'test_alarm.pl'

#!/usr/bin/perl

## setup alarm signal handler to execute timely
our $alarm_interval = 30; # 30 secs

$SIG{ALRM} = sub {
	print "Hello World\n";
	alarm($alarm_interval);
};

alarm($alarm_interval);

### Infinite loop to test out running of alarm
while (1) {
}

Steps To Run The Program:
-------------------------
1) On the command prompt goto the directory where the program is created, type the following and hit enter.

perl test_alarm.pl

Output of the above program is either of the following lines:

Hello World
Hello World
Hello World