1.
#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
# This will print "Hello, World"
print "Hello, world\n";
print("Hello, world\n");
print "Hello, world to all\n";
2.
#!/usr/bin/perl
print "Content-type: text/html\n\n";
$a = 10;
print "Value of a = $a\n";
print 'Value of a = $a\n';
3.
#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
$a = 10;
$var = <<"EOF";
This is the syntax for here document and it will continue
until it encounters a EOF in the first line.
This is case of double quote so variable value will be
interpolated. For example value of a = $a
EOF
print "$var\n";
$var = <<'EOF';
This is case of single quote so variable value will not be
interpolated. For example value of a = $a
EOF
print "$var\n";
4.
#!/usr/bin/perl -w
$result = "This is \"number\"\n";
print "$result",' adding...';
print "\n\$result\n";
5.
#!/usr/bin/perl
use strict;
use warnings;
my $name = "A useful tool in natural language processing is concordance. This allows a specific string to be displayed in its immediate context whereever it appears in a text. For example, a concordance program identifying the target string the might produce some of the following output. Notice how the occurrences of the target string line up vertically. ";
my @person = split(/ /, $name);
#print "$person[0]\n"
foreach my $val (@person) {
print "$val\n"
}
exit 0;
6.
#!/usr/bin/perl -w
use strict;
# multi dimention array:
my @array1=(
# ["1","2", ["Amit"]],
["1","2"],
["3","4"],
["5","6"]
);
#print "$array1[0][2][0]\n";
print "$array1[0][0]\n";
# multi dimention array referance:
my $array1ref = [
["1","2"],
["3","4"],
["5","6"]
];
print "$array1ref->[0][0]\n";
7.
#!/usr/bin/perl
use strict;
use warnings;
open (fh2, "file1") || die "Error opening file1: $!";
#open (fh2, "/etc/passwd") || die "Error opening file1: $!";
my @array1;
while (<fh2>){
push @array1, [ split ]; # push function to push the data in array1 from $_
#push @array1, [ split/:/];
}
foreach (@array1){
print "@$_[0]\n";
print "@$_[1]\n";
#print "@$_\n";
}
8.
#!/usr/bin/perl
use strict;
use warnings;
open (fh2, "passwd") || die "Error opening file1: $!";
my @array1;
while (<fh2>){
push @array1, [ split/:/];
}
foreach (@array1){
print "@$_";
}
print "\nPrinting an extra line: $array1[0][0]\n";
9.
#!/usr/bin/perl
# Author: Amit Mund
# Date: 17.07.2014
# Purpose: Explain Lists, Slices, Ranges, etc.
use warnings;
use strict;
# qw : quote word
#Scalars(single values), Arrays(lists), Hashes(key/value pairs)
print (qw(Boston Charlotte newark miami)); # This is removing all the blank space.
print "\n";
print (qw(Boston Charlotte newark miami)[0,3]); # will print 0th and 3rd index value. [Bootonmiami]
print "\n";
print (qw(Boston Charlotte newark miami)[0..2]); # will print the index values from 0 to 3
print "\n\n";
##
my @uscities = qw(Boston Charlotte newark miami Austin Dallas Houston);
print "@uscities[1..$#uscities]\n";
my @eastcoastcities = @uscities[0..3,5];
print ("East Cost Cities: ","@eastcoastcities\n");
print ("Other Cities:", "@uscities[4..$#uscities]\n\n");
10.
#!/usr/bin/perl -wl
use strict;
# you can use the same name in a different type of variables
#scalars = single values ($)
#Arrays = lists of scalars (@)
# Hashes = key/values pairs
# NOTE: $fname != @fname and we can have both at the same time.
my $carmanufactures = "This is scalar values";
my @carmanufactures = ("Honda","Toyota","Nissan", "Lexus","BMW"); # begining with 0
print "$carmanufactures";
print "$carmanufactures[0]";
print "$carmanufactures[1]";
print "$carmanufactures[2]";
print "$carmanufactures[3]";
# perl keep the working data into memory.
print "This arrays contents: 0 to $#carmanufactures, mean total $#carmanufactures+1";
# Note: leangth of arrays using $#arrayname
print "Here is the full arrays: @carmanufactures[0,1,2,3,4]";
# following also works
print "Here is the full arrays: @carmanufactures[0..4]";
# I believe the best way is following in these 3.
print "Here is the full arrays: @carmanufactures[0..$#carmanufactures]";
11.
#!/usr/bin/perl
use warnings;
use strict;
# NOTE: For interger use ==, <, >, <=, >=
if (1 < 2 && (5 < 4 || 5 > 4)) {
print "I am at if block.\n";
}
## string test:
# NOTE: for string eq, ne
# if, elsif, else, unless [elsif, to use within a sub-if block.]
my $fname = "amit";
my $name = "amit";
if ( $name ne $fname) {
print "$fname is same as $name\n";
}
else {
print "I am at else block.\n";
}
# unless is for negetation:
my $value1 = "1";
my $value2 = "2";
unless ($value1 == $value2) {
print "$value1 is not equal to $value2\n";
}
# one line if test:
print "one liner if\n" if $value1 != $value2;
#END
12. fileio1.pl
#!/usr/bin/perl
use warnings;
use strict;
# open function for file handel.
# die function to cache any error.
# $! is the perl variable to keep the error.
my $min = 1;
my $max = 20;
my $fname = "Amit mund";
my $dob = "23/04/1982";
# defining OUTFILE as a fh.
open (OUTFILE, ">data1") || die "problems: $!"; # $! perl inbuilt variable for error return.
for ($min..$max) {
print OUTFILE "$fname and DOB = ";
print OUTFILE "$dob\n"
}
#END
13. fileio2.pl
#!/usr/bin/perl
use warnings;
use strict;
#my $OUT = "OUTFILE";
#my $filename = "/proc/cpuinfo";
my $filename = "data1";
open (INFILE, "$filename") || die "problems: $!";
#while (<INFILE>){
# print "$_";
#}
my @data1contains = <INFILE>; # assoicate a file to an array.
foreach (@data1contains){
print "$_";
}
#END
14. FileIO3.pl
#!/usr/bin/perl
use warnings;
$IN = "INFILE";
$OUT = "OUTFILE";
$filenamein = "/proc/cpuinfo";
$filenameout = "data2";
open ($IN, "$filenamein") || die "error while opening the file: $!";
open ($OUT, ">$filenameout") || die "error while writing the file: $!";
@data1contents = <$IN>;
foreach (@data1contents){
if (/^processor/ || /^core id/ || /model name/){ # Nesting an if statement with regex
#print $OUT "$_";
s/model name/cpu/; # Replace "model name with cpu"
@cur_data=$_;
print $OUT "@cur_data";
}
}
#END
15. File04.pl
#!/usr/bin/perl
use warnings;
my $PROCESS;
open ($PROCESS, "ps aux | grep -i apache |") || die "process error $!";
@PROCESS_DATA = <$PROCESS>;
#print "@PROCESS_DATA"
foreach (@PROCESS_DATA){
print "$_"
}
# END
16. fileIO04A.pl
#!/usr/bin/perl
use warnings;
my $PROCESS;
open ($PROCESS, "ps aux|") || die "process error $!"; # need to end with | pipe as per the input for $PROCESS.
@PROCESS_DATA = <$PROCESS>;
foreach (@PROCESS_DATA){
if (/apache/){ # <----- Regex.
print "$_"
}
}
17. FileIO4_B.pl
#!/usr/bin/perl
use warnings;
$FH = "FileReadWrite";
$FILENAME = "data1";
$APPEND_OF_FILE = "Appended string\n";
# +< for read and append mode, and it must be in quote.
open ($FH, "+<$FILENAME") || die "file error: $!";
@dataOfFile = <$FH>;
foreach (@dataOfFile){
#print $FH "$_";
}
print $FH "$APPEND_OF_FILE";
18. FileIO05.pl
#!/usr/bin/perl
use warnings;
#$DIR = "/home/amit/Documents/perl";
$DIR = "/etc";
$DH = "Handle";
opendir ($DH, "$DIR") || die "Error opening dir: $!";
@dirlist = readdir($DH); # list the first level of contents.
foreach (@dirlist){
#if (/^[x-z]/){ # regex of start with x-z letters.
# print "$_\n";
#}
print "$_\n";
}
#closedir ($DH); # Good to close the handler.
#@dirlist = `ls -A $DIR`;
#foreach (@dirlist){
# print "$_\n";
#}
#END
19.
#!/usr/bin/perl
use warnings;
#use strict;
#my $mem = perl -wln -e '@mem1 = split /:/, $_; if (/DirectMap2M/){print $mem1[1]} ;' /proc/meminfo
my $MEM_FH1 = "memory_FH";
my $mem_file = "/proc/meminfo";
open ($MEM_FH1, "$mem_file") || die "problem opening file: $!";
my @mem_data_contains = <$MEM_FH1>;
foreach(@mem_data_contains){
if (/^MemFree/){
#my @mem_value = split /:/, @mem_data_contains;
my @mem_free_value = split /\s+/,$_;
my @mem_free_value1 = $mem_free_value[1] * 1024; # in bite conversion
print "Free Memory = @mem_free_value1\n";
#print @mem_data_contains;
}
}
foreach(@mem_data_contains){
if (/^MemTotal/){
#my @mem_value = split /:/, @mem_data_contains;
my @mem_total_value = split /\s+/,$_;
my @mem_total_value1 = $mem_total_value[1] * 1024; # in bite conversion
print "Total Memory = @mem_total_value1\n";
#print @mem_data_contains;
}
}
#my $Free_percent =
20.
#!/bin/bash/perl
use strict;
use warnings;
#my $min = 1;
#my $max = 10;
#my $PROD_NAME = "Testing the perl foreach loop.";
my @array1 = ("Amit", "Kumar", "Mund", "Testing");
foreach (@array1) { # just need to pass the array value.
# body...
print "$_ "; # $_ is an internal variable that keep the complete value.
}
$#array1 +=1;
print "\nTotal arrays element = $#array1";
print "\n";
21.
#!/usr/bin/perl -wl
use strict;
# Note: in hash it need to even number of objects.
my %make_model = (
"Honda","city",
"Maruti","swift"
);
print $make_model{"Maruti"};
#### The nice way of writing the hash:
my $player = "Venus";
my %player_country = (
Venus => "USA",
Sharapova => "Russia",
);
printf "$player represents: ";
print $player_country{"$player"};
###
my @num_of_players_keys = keys %player_country;
my @num_of_players_values = values %player_country;
print "The keys are: @num_of_players_keys[0..$#num_of_players_keys]";
print "The values are: @num_of_players_values[0..$#num_of_players_values]";
22.
#!/usr/bin/perl
#
# The traditional first program.
# Strict and warnings are recommended.
use strict;
use warnings;
# Print a message.
print "Content-type: text/html\n\n";
print "Hello, World!\n";
=begin comment
This is all part of multiline comment.
You can use as many lines as you like
These comments will be ignored by the
compiler until the next =cut is encountered.
=cut
=begin comment
for multiline comment it start with: " =begin" and end with "cut" after
the =
=cut
print "Hello, world\n";
print 'Hello, world\n';
23.
#!/usr/bin/perl
print "Content-type: text/html\n\n";
my $str = <<EOM;
<html>
<head>
<title>CGI Perl Example</title>
</head>
<body>
<h1>CGI Perl Example</h1>
<p>CGI Perl Example</p>
</body>
</html>
EOM
print $str
24. perldb.pl
#!/usr/bin/perl
use warnings;
use strict;
use DBI;
#Setp1 - creating connection object
my $dsn = 'DBI:mysql:thenewboston'; # module:db_engine:db_name
my $user = 'root';
my $pass = 'YourPassword';
my $host = 'localhost';
my $conn = DBI->connect($dsn,$user,$pass) || die "Error connecting" . DBI->errstr;
# step 2 - define query
my $query1 = $conn->prepare('SELECT id,name FROM user') || die "Error preparing query" . $conn->errstr;
# setp 3 - execute query
$query1->execute || die "Error executing query" . $conn->errstr;
# step 4 - return results
my @results;
while (@results = $query1->fetchrow_array()) {
my $id = $results[0];
my $name = $results[1];
#my $name = $results[2];
print "$id,$name\n"
}
# trying for another query too:
my $query2 = $conn->prepare('SHOW TABLES') || die "Error preparing query" . $conn->errstr;
$query2->execute || die "Error executing query" . $conn->errstr;
my @results2;
print "\nFollowing are the tables at thenewboston DB:\n";
while (@results2 = $query2->fetchrow_array()) {
my $tables = $results2[0];
print "$tables\n"
}
25.
#!/usr/bin/perl
use warnings;
use strict;
my @array1 = ("1","2","3","4");
print "@array1\n";
# pop function, to remove the last value.
my $ppop = pop @array1; # over here $ppop will be carring the removed value.
print "@array1\n";
print "$ppop\n"; # printing the remoed value.
# NOTE: if you don;t want you can just pop the @array1 and print the same again and it will remove the last one.
pop @array1;
print "@array1\n";
#my $ppop = pop @array1;
#print "@array1\n";
#print "$ppop\n";
#END
26.
#!/usr/bin/perl
use warnings;
use strict;
my @array1 = ("1","2","3","4");
print "Original array1 values: @array1\n";
# pop function, to remove the last value.
my $ppop = pop @array1; # over here $ppop will be carring the removed value.
print "Value after doing a pop: @array1\n";
print "What is ppop is carring now: $ppop\n"; # printing the remoed value.
# Now push the another value;
push @array1, $ppop; # adding back the removed one.
print "\nValue after doing a push of the ppop value: @array1\n";
# adding one more value.
push @array1, "5";
print "Pushing one more eliment: @array1\n";
# adding one more value.
push @array1, "Amit";
print "Pushing one more eliment: @array1\n\n";
# Adding the element(s) at the beginning of the array.
my $fname = "Amit";
my $mname = "Kumar";
my $lname = "Mund";
unshift (@array1, "$fname", "$mname", "$lname");
print "@array1\n";
# Removing the 1st element from the array
my $s_shift =shift @array1;
print "@array1\n";
print "$s_shift\n";
## "sort", For sorting the string.
my @array2 = ("Amit","kumar", "Mund", "Bitu");
my @sort_array2 = sort @array2;
print "@sort_array2\n";
# We can use the same array name after doing sort and assign the same.
@array2 = sort @array2;
print "@array2\n";
#END
27.
#!/usr/bin/perl
use warnings;
use strict;
# @ARGV variable [ array type spical variable ]
# print "$ARGV[0]\n";
# print "Trying to print all the input argument: @ARGV[0..$#ARGV]\n";
my $REQ = 3;
my $BADARGS = 165;
$#ARGV += 1; # NOTE: No need to use my or our for ARGV. If you give, it will show error.
unless ($#ARGV == 3){
print "$0 requires $REQ variables: ";
print "ERROR! Insufficent argument.\n";
exit "$BADARGS";
}
print "Correct number of argument $#ARGV has been passed.\n";
print "$ARGV[0] $ARGV[1] $ARGV[2]\n";
print "printing with array type : @ARGV[0..$#ARGV]\n"; # saw the same output at training too.
# perldoc -f exit; for more help.
#END
28.
#!/usr/bin/perl -wl
# w: option for the warning.
# l: option for the line group.
$fname = "Amit";
$lname = "Mund";
$fullname = "$fname $lname";
print "$fname $lname";
print "$fullname";
# NOTE: Must end with a semi-collon;
29.
#!/usr/bin/perl
# split, join and input files from shell.
use warnings;
use strict;
while (<>){ # reading by a stdin. [ file name as arg ]
my @username = split /:/, $_;
if(/false/){
print "$username[0]\n";
}
}
# perl -wln -e '@array1 = split /:/, $_; print $array1[0]' passwdFile
# perl -wln -e '@mem1 = split /:/, $_; if (/DirectMap2M/){print $mem1[1]} ;' /proc/meminfo
# 8226816 kB
#END
30.
#!/usr/bin/perl -w
use strict;
printf "Please enter your name: ";
my $fname = <STDIN>; # For standard input, you can declare the variable at the same time.
chomp($fname); # To remove the last newline character.
print "\n***************************************";
print "\nHello $fname, how are you doing today?\n";
print "***************************************\n\n";
31.
#!/usr/bin/perl -w
use strict;
testsub(); # This is how to call a sub-routines, Its the same as function
# and its not needed to be after declating this sub-routines.
sub testsub { # Need to start with "sub"
my $name = "Amit Mund";
print "Hello $name\n";
}
# Note: you can pass the argument too in the sub-routines
testsub1("Amit Mund", "Bitu");
sub testsub1 {
print "Following is an example of getting the value as argument from testsub2\n";
print "Hello: $_[0]\n"; # $_ is the default place holder.
}
# Two argument in the "foreach" loop and printing Hello Amit and Hello Bitu.
testsub2 ("Amit","Bitu","Tutu");
sub testsub2 {
foreach (@_){
print "Hello $_\n";
}
}
# NOTE: @_ is the for all the array value passed on the argument.
testsub3 ("Amit","Bitu","Tutu");
sub testsub3 {
print "Hello @_\n";
}
32.
#!/usr/bin/perl
use warnings;
use strict;
# file handling:
open (fh1, ">> sub2.log") || die "Error opening the file: $!";
my $etcdir = `ls -l /etc/passwd`;
chomp ($etcdir); # to delete extra newline.
my $message = "Launching sub2.pl";
log_message("$message");
log_message("$etcdir");
log_message(`uptime; who`);
sub log_message{
my $current_time = localtime;
print "$current_time - $_[0]","\n";
print fh1 "$current_time - $_[0]", "\n";
}
#perl -e '$decimal=10, print $decimal;'
#NOTE: perl -e always need to be in single quote, e.g:
# perl -l -e '$current_time = localtime, print $current_time;'
33.
#!/usr/bin/perl
use warnings;
use strict;
# Printing the arguments.
#print "$ARGV[0]\n";
#print "Trying to print all the input argument: @ARGV[0..$#ARGV]\n";
# printing value at hex.
#perl -wl -e '$hex = sprintf("0x%x",15), print $hex;'
#######################################
# NOTE: Try to always use the variable.
######################################
# Following is the "c" style for loop.
#my $min = 1;
#my $max = 100;
#my $i;
#
#for ($i=$min; $i<=$max; $i++){
#
# print "$i\n";
#}
my $min = 1;
my $max = 100;
my $i=0;
for ($min..$max){
print "For loop test\n";
}
# can put the same in a single line too:
for ($min..$max){$i++; print "$i\n";}
#END
34.
#!/usr/bin/perl
use warnings;
#use strict;
my $IN = INFILE;
my $infile = passwdFile;
open ($IN, "$infile") || die "problems: $!";
while (<$IN>){
print "$_";
}
#END
35.
#!/usr/bin/perl
use warnings;
@mem = split /:/, $_; if (/DirectMap2M/){print "$mem1[1]";} ;' /proc/meminfo
print @mem;
@myls = `ls -l`;
print @myls;
36.
#!/usr/bin/perl
use warnings;
use strict;
print "Content-type: text/html\n\n";
# syntax:
#while (condition){
#body;
#}
my $value1 = 1;
my $value2 = 20;
while ($value1 <= $value2){
print "$value1,";
$value1 +=2;
}
print "\n";
# syntax:
#until (condition){
#body;
#}
my $value11 = 1;
my $value22 = 20;
until ($value22 <= $value11){
print "$value22,";
$value22 -=2;
}
print "\n";
#END
