PERL : BLESS

bless associates a reference with a package.

It doesn't matter what the reference is to, it can be to a hash (most common case), to an array (not so common), to a scalar (usually this indicates an inside-out object) or even a reference to a file or directory handle (least common case).

The effect bless-ing has is that it allows you to apply special syntax to the blessed reference.

For example, if a blessed reference is stored in $obj (associated by bless with package "Class"), then $obj->foo(@args) will call a subroutine foo and pass as first argument the reference $objfollowed by the rest of the arguments (@args). The subroutine should be defined in package "Class". If there is no subroutine foo in package "Class", a list of other packages (taken form the array @ISA in the package "Class") will be searched and the first subroutine foo found will be called.

package MyClass;

my $object = { };

bless $object, "MyClass";

Now when you invoke a method on $object, Perl know which package to search for the method.

If the second argument is omitted, as in your example, the current package/class is used.

For the sake of clarity, your example might be written as follows:

sub new { 

  my $class = shift; 

  my $self = { }; 

  bless $self, $class; 

PERL : array operations

use Data::Dumper;
my @array1 = ("first","second","third","forth");
print "\nOriginal array : \n".Dumper(@array1);
push(@array1,"fifth");
print "\narray after push : \n".Dumper(@array1);
my $arrayPop = pop @array1;
print "\nElement extracted with POP : ".$arrayPop;
print "\nArray after POP command \n".Dumper(@array1);
unshift(@array1,"UNSHIFT");
print "\nArray after UNSHIFT : \n".Dumper(@array1);
my $arrayShift = shift @array1;
print "\nShift element from array : ".$arrayShift;
print "\nArray after SHIFT\n".Dumper(@array1);

Results:
Original array :
$VAR1 = 'first';
$VAR2 = 'second';
$VAR3 = 'third';
$VAR4 = 'forth';


array after push :
$VAR1 = 'first';
$VAR2 = 'second';
$VAR3 = 'third';
$VAR4 = 'forth';
$VAR5 = 'fifth';


Element extracted with POP : fifth
Array after POP command
$VAR1 = 'first';
$VAR2 = 'second';
$VAR3 = 'third';
$VAR4 = 'forth';


Array after UNSHIFT :
$VAR1 = 'UNSHIFT';
$VAR2 = 'first';
$VAR3 = 'second';
$VAR4 = 'third';
$VAR5 = 'forth';


Shift element from array : UNSHIFT
Array after SHIFT
$VAR1 = 'first';
$VAR2 = 'second';
$VAR3 = 'third';
$VAR4 = 'forth';

PERL : Operator $call_sign

my $call_sign = 1;
print "\ncall_sign : ".$call_sign;
my $next_sign = $call_sign++;
print "\nnext_sign is call_sign plus 1: ".$next_sign."\n";
my $prev_sign = $call_sign--;
print "\nprev_sign is call_sign minus 1: ".$prev_sign."\n";


$call_sign = "string";
print "\ncall_sign : ".$call_sign;
my $next_sign = $call_sign++;
print "\nnext_sign is call_sign plus 1: ".$next_sign."\n";
my $prev_sign = $call_sign--;
print "\nprev_sign is call_sign minus 1: ".$prev_sign."\n";

RESULT:
call_sign : 1
next_sign is call_sign plus 1: 1
prev_sign is call_sign minus 1: 2
call_sign : string
next_sign is call_sign plus 1: string
prev_sign is call_sign minus 1: strinh

PERL : Examples using given and when statements

use feature ":5.10";
unless ($#ARGV == 0)
{
say "$0 requires 1 integer parameter in order to work";
exit 0;
}
print "\nYou have entered $ARGV[0]";
given($_)
{
when ($_ < 10)
{
say "\nNumber $input is less then 10";
}
when($_ > 10)
{
say "\nNumber $input is greater then 10";
}
}

PERL : Include HELP in scripts

use Getopt::Long;


my $help = <<EndHelp;
Usage:
SCRIPT.pl <PARAM1> <PARAM2> [-help|-h]
The arguments meaning:
----------------------
<PARAM1> - param1 description
<PARAM2> - param2 description
[-help|-h] - print this help screen
EndHelp
# Verify the ARGS
my $hlp;
my $result = GetOptions( "help|h" => \$hlp );
# Print Help Message
if($result == 0 || $#ARGV == -1 || $hlp)
{
  print $help;
  exit 0;
}
# Input Parameters
my $var1 = $ARGV[0];
my $var2 = $ARGV[1];

PERL : Database

rpm -qa | grep perl #get the perl packeges like perl-DBI-1.32-5 and perl-DBD-MySQL-2.1021-3
perlscript -> perlDBI(database_interface) -> perl DBD (database_driver) -> DATABASE
http://localhost/phpmyadmin # you can see the databases
you can use : select, insert, update, delete


pico db1.pl
#!/usr/bin/perl -w
use warnings;
use strict;
use DBI;
#Step 1 - create connection objection. Object that gants you access to the database
my $dsn = 'DBI:mysql:contacts';#driver-mysql, database-contacts
my $user = 'user';
my $password = 'pass';
my $conn = DBI->connect($dns, $user,$password) || die "Error connecting" . DBI->errstr;
#Step 2 - define query
my $query1 = $conn->prepare('SELECT * FROM addressbook') || dir "Error preparing query" .$conn->errstr; #check if the sqlstatemant is correct
#Step 3 - execute the query
$query1->execute || die "Error Executing query" .$query1->errstr;
#Step 4 - return results from query
my @results;
while (@results = $query1->fetchrow_array())
{
my $firstname = $results[0];
print $firstname\n;
foreach(@results)
{
print $_\n;#prints all the values
}
}
if($query1->rows == 0)
{
print "No Records \n";
}
#end


cp di1.pl db2.pl
#!/usr/bin/perl -w
use warnings;
use strict;
use DBI;
#Step 1 - create connection objection. Object that gants you access to the database
my $dsn = 'DBI:mysql:contacts';#driver-mysql, database-contacts
my $user = 'user';
my $password = 'pass';
my $conn = DBI->connect($dns, $user,$password) || die "Error connecting" . DBI->errstr;
my $firstname = "Mark";
my $lastname = "Sloan";


#Step 2 - INSERT/UPDATE/DELETE queries are shortend to 2 steps
$conn->do("INSERT INTO addressbook(firstname,lastname) VALUES ('$firstname','$lastname')") || dir "Error preparing query" .$conn->errstr; 
#end


nano dbinsert.txt
Mark Sloan 101010
George Bush 232323
Hilary Clinton 32121
Tony Macarony 43198


#!/usr/bin/perl -w
use warnings;
use strict;
use DBI;
#Step 1 - create connection objection. Object that gants you access to the database
my $dsn = 'DBI:mysql:contacts';#driver-mysql, database-contacts
my $user = 'user';
my $password = 'pass';
my $conn = DBI->connect($dns, $user,$password) || die "Error connecting" . DBI->errstr;
open (han1, "dbinsert.txt") || die "Error : $!";
my @newrecords = <han1>;
foreach(@newrecords)
{
my @columns = split;
$firstname = $columns [0]; 
$lastname = $columns [1]; 
$zip = $columns [2]; 
$conn->do("INSERT INTO addressbook(firstname,lastname,zip) VALUES ('$firstname','$lastname','$zip')") || dir "Error preparing query" .$conn->errstr; 
}
#end


nano db3.pl
#!/usr/bin/perl -w
use warnings;
use strict;
use DBI;
#Step 1 - create connection objection. Object that gants you access to the database
my $dsn = 'DBI:mysql:contacts';#driver-mysql, database-contacts
my $dsn2 = 'DBI:mysql:contacts2:192.168.1.10';
my $user = 'user';
my $password = 'pass';
my $conn = DBI->connect($dns, $user,$password) || die "Error connecting" . DBI->errstr;
$firstname = $Marko; 
$lastname = $columns [1]; 
$zip = $columns [2]; 
$conn->do("UPDATE addressbook SET firstname='$firstname' WHERE firstname='Mark'") || dir "Error preparing query" .$conn->errstr; 
$conn->do("DELETE addressbook WHERE firstname='George'") || dir "Error preparing query" .$conn->errstr; 
#end

PERL : Check For new files

pico checkfornewfiles.pl
#!/usr/bin/perl -w
use strict;
AscertainStatus();


sub AscertainStatus
{
my $DIR = "test2";
opendir (HAN1, "$DIR") || die "Problems: $!";
my @array1 = readdir(HAN1);
if("$#array1" > 1)#we know we have a new files. by default folders '.' and '..' exists.
{
for(my $i = 0 ; $i < 2 ; $i ++)
{
shift @array1; #removes '.' and '..'. Shift function removes the first element of an array
}
MailNewFiles(@array1);
}
else
{
print "No New Files!";
}
}


sub MailNewFiles
{
use Mail::Mailer;
my $from = "root";
my $to = "root";
my $subject = "Subject: New Files";
my $mailer = Mail::Mailer->new();
$mailer->open({ From => $from,
To => $to,
Subject => $subject,
});
my $header = " New Files";
print $mailer $#_ + 1;#prints the number of new files
print $mailer "$header\n";
foreach(@_)$the files are stored in @_
{
print $mailer "$_\n";
}
}
#end

PERL : Modules

tar - many file roled into one
perl -e 'print "@INC"' # an array containing a list of modules to include upon executing scripts
perl -MCPAN -e shell
cpan>help
cpan>i /SFTP/ #search for secure FTP
cpan>b #bundle(related modules) available on CPAN
cpan>i Net::SFTP # info about a module
cpan>install Net::SFTP
cpan>install CPAN::Bundle

PERL Use '-e' '-F' '-a' '-n' options. Perl One Liners

perl -e 'print "Hello World\n";'
perl -e 'print "Hello World\n"; print "Today is Sunday\n";'
perl -e '$PROD="Linux"; $VERSION="\nversion1"; print "\n$PROD $VERSION";'
perl -e '"\t"';
perl -ne 'print "$_";' data1 #This command prints all the lines from data1 file. -n option makes iterations like while 
perl -ane 'print "$F[0]";' data1 # This prints the first column from a file. -a performs autospliting
perl -ane 'print "@F[0..1]";' data1
awk '{ print $1,$2}' data1 # prints the first 2 columns from the file data1
perl -F: -ane 'print "@F";' /etc/passwd #Prints ll elements from /etc/passwd without delimiter. -F: - change delimeter to ':'
perl -F: -ane 'print "$F[0]";' /etc/passwd # prints the first column that is the users without new line
perl -F: -ane 'print "$F[0]\n";' /etc/passwd # prints the first column that is the users with new line
perl -F: -ane 'print "@F[0..2]";' /etc/passwd # returns the first 3 columns from the file

PERL : CGI - common gateway interface

cd /etc/httpd/conf
grep cgi httpd.conf # Here ScriptAlias /cgi-bin/ "/var/www/cgi-bin"
http:..192.168.1.10/cgi-bi/helloworld.pl
cd /var/www/cgi-bin
nano helloworld.pl
#!/usr/bin/perl -w
use strict;
print "Content-type: text/html\n\n";
print "<h1>Hello World! - our first perl CGI script</h1>";
#end
chmod +x helloworld.pl
open a browser - http://192.168.1.10/cgi-bi/helloworld.pl


nano enviroment1.pl
#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
print "<table>";
foreach (sort keys %ENV)
{
print "<tr><td>$_</td><td>$ENV{$_}</td></tr>"
}
print "</table>";#All the values are printed in 2 columns
#end


nano form1.pl
#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
print "<html><title>Our first HTML Perl Form</title></head><body>";
print "<form method='post' action='action1.pl'>";#form methods: GET, POST
print "Name: <input='text' name='name' size='25'><br>";
print "E-Mail: <input='text' name='e-mail' size='25'><br>";
print "<input type='submit' value='Submit'>"
print "</form>";
print "</body></html>";
#end


nono action1.pl
#!/usr/bin/perl -w
use strict;
use cgi;
my $cgi = new CGI;
print $cgi->header();
print cgi->start_html("Action Page");
print $cgi->param('name'), "<br>";
print $cgi->param('email');
print $cgi->end_html();
#end
chmod u+x action1.pl
http://192.168.1.10/cgi-bi/helloworld.pl. After you enter the name and email the follwoing page appear http://192.168.1.10/cgi-bi/action1.pl. Here the name and email are displayed

PERL : File Attributes

cd test3/
touch file{1,2,3,4,5}
ls -l
checkiffileaccess1.pl
#!/usr/bin/perl -w
use strict;
my @flist = `ls -A file*`;
#my @flist = `ls -A file{1,2,3,4,5}`;
foreach(@flist)
{
chomp;
print $_\n;
#stat($_);#returns an array of 13 elements, atributes. In these variable you can find the modification time and access time.
my @stats = stat($_);
(my $atime, my $mtime) = ($stats[8], $stats[9]);
print "Access time: $atime - Mod Time: $mtime";
#expr $atime $mtime; #return the difference between the 2 values;
#foreach (@stats)
#{
# print "$_\n";
#}
if($atime = $mtime != 0)
{
print "File $_ has been accessed \n";
my $new_name = "$_".".old";
rename($_,$new_name);
}
}
#end
file file5 # returns empty if the file is empty.
echo "test" >> file5
file file5 # return ASCII text
ls -l --time=atime file1#access file
ls-i file1#modification file1

PERL : References

#!/usr/bin/perl -w
# 3 data types : scalars, arrays(lists), hashes(key value Pairs)
@uscities = ("boston","charlote","new york","san francisco");
$USC=\@uscities;#first rule for creating references
print "@{$USC}\n";
#OR
foreach(@{$USC})
{
print "$_\n";
}
#end


#!/usr/bin/perl -w
$USC = ["boston","charlote","new york","san francisco"];
foreach (@{$USC})
{
print $_;
}
%contacts = ("firstname","Mark","lastname","Sloan");#rule 1
$contacts = \%contacts;
print ${$contacts}{'firsname'};#value of a key;#rule 1
$contacts = { fistname => "Mark", lastname => "Sloan" };#rule 2
print $contacts->{'firstname'};#rule 2
#end

PERL : File Tests Functions

pico filetest1.pl
#!/usr/bin/perl -w
#inherent file testing functions
$file = "test";
if (-e $file) # '-e' tests if the file exists
{
print "file exists!";
}
if (-z $file) # '-z' tests if the file is a zero bytes file
{
print "file exists and has 0 bytes";
}
if (-f $file) # '-f' tests if the file is a file
{
print "file exists and is a file";
}
if (-d $file) # '-d' tests if the directory is a directory
{
print "directory exists and is a directory";
}
#end
perldoc -f -X #documentation regarding files

PERL : Mail Integration

/usr/lib/sendmail -oi -t
From: linux
To: root
Subject: Sub
#one space is required after subject and then the body begins


Test body
pico sendmail1.pl
#!/usr/bin/perl -w
$MAIL = "SENDMAIL";#file handle that redirects to a pipe everything
open ($MAIL, "| /usr/lib/sendmail -oi -t") || die "Errors with sendmail $!";#we open a pipe
print $MAIL <<"EOF";
From: Mark
To: root
Subject: testing mail from perl


Testing body of message
EOF
close ($MAIL);


#end
mutt - see mails
#!/usr/bin/perl -w


$MAIL = "SENDMAIL";#file handle that redirects with the help of a  pipe everything to sendmail
open ($MAIL, "| /usr/lib/sendmail -oi -t") || die "Errors with sendmail $!";#we open a pipe
print $MAIL <<"EOF";
$BODY="Directory listing";
@dirlist=`ls -Al`
From: Mark
To: root
Subject: testing mail from perl


$BODY
@dirlist
EOF
close ($MAIL);


#end


perl -MMail::Mailer -e 1#query the local perl distribution on your computer to see if that module is installed on your computer. If the module is installed the result is 0.
perl -MCPAN -e "install Mail::Mailer" # install a module in perl
sendmail2.pl
#!/usr/bin/perl -w
use Mail::Mailer
$from = "root";
$to = "root";
$subject = "subject";
$BODY="Directory listing";
$mailer = Mail::Mailer->new();
$mailer->open({From => $from,
To => $to,
Subject => $subject,
});
print $mailer $BODY;
#end
ssh -l user localhost

PERL : Common Functions

pico shell1.pl
#!/usr/bin/perl
#comman ways to interact with shell
#exec - older form of the newer version system. Executes commands from an shell enviroment and does not return an exit command
exec "ls -Al" || die "unable to run the process";#does not return an exit status and is deprecated
$DIR="/etc/init.d"
system "ls $DIR";#return an exit status
print "$?\n";
system "$DIR/httpd stop";


$SERVICE = "httpd";
@array1 = ("$DIR/$SERVICE","stop");
system (@array1);
print "$?\n";
if ($? == 0)
{
print "$SERVICE has been stoped\n";
}
else
{
print $SERVICE has ALREADY been stopped\n";
}
#end
/etc/init.d/httpd start
#!/usr/bin/perl
$DIR="/etc/init.d" # prints one file
$DIR="/etc/init.d/" # prints all the file
$filelist = `ls -Al $DIR | wc -l`;
@filelist = `ls -Al $DIR`;
foreach (@filelist)
{
print "$_";
}
#end

PERL : Regular Expressions

pico re1.pl
#!/usr/bin/perl -w
#anything between '/ /' is considerated by perl a regular expresion
#perl parse the content of $_
$firstname = "Mark";
if ($firstname =~ /Mark/)
{
print "TRUE";
}
if ($firstname =~ /mark/i)
{
print "TRUE";
}
#Anchor Tags - ^ = search at the begining of the string
#Anchor Tags - $ = search at the end of the string
$fullname = " Mark Sloan";
if ($fullname =~ /^mark/i)
{
print $fullname;
}
@array1 = ("Mark Sloan","Sloan Mark");
foreach(@array1)
{
if (/^Mark/i)
{
print $_\n;
}
}
foreach(@array1)
{
s/Mark/Marko/g;#using 'g' will work globally
print $_;
}
#end


#!/usr/bin/perl -w
$IN = "INFILE";
$OUT = "OUTFILE";
$FILENAMEIN = "data1";
$FILENAMEOUT = "data2";
open ($IN, "$FILENAMEIN") || die "Problems opening file: $!";
open ($OUT, "$FILENAMEOUT") || die "Problems creating file : $!";
@filecontents = <$IN>;
foreach (@filecontents)
{
if(/Mark/i)
{
s/Mark/Marko/;
print $OUT "$_";
}
}
#end


Groping
#!/usr/bin/perl -w
$var1 = "Linux 1 2 3 4";
#\d extracts only digits
$var1 =~ /(\w*)(\s\d)(\s\d)(\s\d)(\s\d)/;#returns all digits and the text
print $1 $2 $3 $4 $5; 
#end


date -> Sun Oct 12 13:45:34 EDT 2011
date +%r -> 1:45:34 PM
#!/usr/bin/perl -w
$time =`date +%r`;
$time =~ /(\d\d):(\d\d):(\d\d)\s(.*)/;
print $1 $2 $3 $4;
#OR
$hour = $1;
$minute = $2;
$seconds = $3;
$tod = $4;
print "Hour: $hour Minute:$minute Seconds:$seconds TOD:$tod";
#end


#!/usr/bin/perl -w
@array1 = ("might","night","right","tight","goodzight","dog");
foreach(@array1)
{
if(/[mnrt]ight/i)#character class
{
print $_\n;
}
if(/dog|cat|bird/i)#grops
{
print $_\n;
}
}
#end


#!/usr/bin/perl -w
$IN = "INFILE";
$filename = "data3";
open ($IN, "$filename") || die "Problems : $!";
while(<$IN>)
{
if(/^Mark/)
{
print $_;
}
if(m!^Mark!)#instead of / you can use m!
{
print $_;
}
if(/(.:)(.*\\)/)#c:\windows
{
print $_;#both values are not separated
print $1 $2;#both values are separated
}
if(/\+/)#get all line containing + sign. metacharacterss must be escaped
if(/yes/i)#get all lines containing yes word
if(/./)#removes all the lines
if(/[a-z]\d+/i)
if(/.*@.*/)#match email addresses
if(/(.*)@(.*)/)#match email addresses
if(/^$/) #match blank lines
}
#end