Home  |  Guest BookTechnical PagePersonal Page | <--Back 

Perl Programming
 
About Me
Who is a Good QA
Latest News
Testing Concepts
Automation Tools
Agile Development
UNIX Basics
Perl Scripting
Python Scripting
MySQL
Technology
Repository
Imp. Commands
My Resume

Perl Programming (Various useful functions)

 

 

count no of element in directory and array

#Purpose: Count number of elements in the array

$directory_path --> is path of directory inside which you want to check no of files.
@contents --> array in which list will store
($#contents) --> no of elements present in array

my @contents=</$directory_path/*>
my $total_report_files=($#contents+1);

get data from list

#Purpose: Get list from directory and get data from list

1. split data with space

2. put that data in array

3. pop last data in an array

 

                        my $report_file1_11=`ls -ltr | tail -1 `;

                        my @report_file1_1=split(' ',$report_file1_11);

                        $report_file1=pop(@report_file1_1);

                        chomp($report_file1);

                        $report_file1=trim($report_file1);

                        print ("Report File Name in tail is: $report_file1 \n");

                        $#report_file1_1 = -1;

Trim function

#Purpose: Trim string

 sub trim($)
   {
      my $string = shift;
      $string =~ s/^\s+//;
      $string =~ s/\s+$//;
      return $string;
   }

#Purpose: To round digit to specific number after dot
sub round {
  my $number = shift || 0;
  my $dec = 10 ** (shift || 0);
  return int( $dec * $number + .5 * ($number <=> 0)) / $dec;
}

Email using MIME::Lite

#Purpose: Send email uaing MIME Lite

 sub email {

       # get incoming parameters
       local ($to, $from, $subject, $message) = @_;
      
       # create a new message
    $msg = MIME::Lite->new(
       From => $from,
       To => $to,
       Cc => $cc,
       Type => "text/html",
       Subject => $subject,
       Data => $message
       );
      
       # send the email
       MIME::Lite->send('smtp', '192.168.4.98', Timeout => 60);
       $msg->send();
   }

conversion

#Purpose: Convert decimal to hexadecimal  

sub dec2hex {

    my $decnum = $_[0];

    my $hexnum;

    my $tempval;

    while ($decnum != 0) {

        $tempval = $decnum % 16;                        # get the remainder (modulus function) by dividing by 16

                if ($tempval > 9) {

                  $tempval = chr($tempval + 55);            # convert to the appropriate letter if the value is greater than 9

                }

 # 'concatenate' the number to what we have so far in what will be the final variable 

               $hexnum = $tempval . $hexnum ;          

                $decnum = int($decnum / 16);                # new actually divide by 16, and keep the integer value of the answer

                if ($decnum < 16) {

                    if ($decnum > 9) {

                                $decnum = chr($decnum + 55); # if we cant divide by 16, this is the last step convert to letters again..

                    }

# add this onto the final answer..  reset decnum variable to zero so loop  will exit  

                $hexnum = $decnum . $hexnum;               

$decnum = 0

                }

    }

return $hexnum;

}

 

 

#Purpose: Convert ASCII to hexadecimal format

sub ascii_to_hex ($){

                (my $str = shift) =~ s/(.|\n)/sprintf("%02lx", ord $1)/eg;

                return $str;

}

 

 

#Purpose: Convert hexadecmal to ASCII

sub hex_to_ascii ($){

                (my $str = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg;

                return $str;

}

 

 

#Purpose:  Convert decimal to binary

sub dec2bin {

    my $str = unpack("a7", pack("a7", shift));

    $str =~ s/^0+(?=\d)//;   # otherwise you'll get leading zeros

    return $str;

}

 

#Purpose: Convert binary to decimal

sub bin2dec {

    return unpack("c", pack("a7", substr("0" x 8 . shift, -8)));

}

 

hash of hash

my %hash_of_hashes =( 
                                              '0' =>  {
                                                          '1.     Name'   => 'Kunal Saxena', 
                                                         '2.      DoB' => '18_Mar_1978',
                                                         '3. Relation' => 'myself',
                                                        },
                                            );      

Print hash contents

    for my $k1 (sort keys %hash_of_hashes ) {
        for my $k2 (sort keys %{$hash_of_hashes{$k1}}) {
            print "$k2 :\t$hash_of_hashes{$k1}{$k2}\n";
        }
   }

 

Reading and parsing file in 2 Dim

Reading and Storing csv File in 2 Dimensions

sub readFile(){
     my ($tmpFileName,$tmplength,$counterRow,$counterCol);
     $tmpFileName=$_[0];$counterRow=0;$counterCol=0;
     print("Reading File \n");
     open (FILE,"< $tmpFileName") or die "unable to open $tmpFileName file";
            while(<FILE>) {
                       my @tmpLine=split(",",$_);$tmplength=scalar(@tmpLine);
                       foreach my $data (@tmpLine){
                               $FileData[$counterRow][$counterCol]=$data;
                               $counterCol++;
                       }
                       $counterRow++;$counterCol=0;
            }
     close(FILE);
}

Checking value in 7th place of csv file

sub findDatainFile(){
     my ($refArray,$tmpval,$tmpret,@tmpMultiArray,$rows,$col);
     $refArray=$[0];$tmpval=$[1];@tmpMultiArray=@$refArray;
     $rows=$#tmpMultiArray;$col=$#{$tmpMultiArray[0]};
               for my $i (0..$#tmpMultiArray) {
                       if($tmpMultiArray[$i][6] eq $tmpval){
                               $tmpSAI=$tmpMultiArray[$i][43];
                       }
               }
return $tmpret;
}

&readFile($FileName);
 
$tmpvalret=&findDatainFile(\@FileData,$valtpCheck);
 

 

Using FTP and Telnet Module

use Net::FTP;
use Net::Telnet;

&getiniFile("10.10.10.10","username","password","path","filename");
my $Dataret=&executeCommandTelnet("10.10.10.10","username","password","path","ls");


my @tmpData=@$Dataret ;
print("Dataret:@$Dataret  \n");

foreach my $data (@tmpData){
       print("Line: $data \n");
}


sub getiniFile(){
my ($host,$ftplogin,$ftppass,$remote_cwd,$fileName)=@_;
print("\t\tDownloading $fileName file from $host Machine \n");
my $ftp;
       $ftp=Net::FTP->new($host,Timeout=>240,Passsive=>1) or "Can't ftp to $host: $!\n";
       $ftp->login("$ftplogin","$ftppass") or die ("Incorrect server credentials");
       $ftp->cwd($remote_cwd) or die ("Cannot connect to the folder on Server");
       $ftp->get($fileName) or die ("Error occured while fetching the file");
       $ftp->quit;
}

sub executeCommandTelnet(){
my ($host,$telnetlogin,$telnetpass,$remote_cwd,$command)=@_;
my ($telnet,@line);
print("Executing script and printing its answers \n");
      $telnet = Net::Telnet->new(Timeout => 10);
      $telnet->open($host);
      $telnet->login("$telnetlogin","$telnetpass");

       $telnet->cmd("cd /Disk/KUNAL/perlLearning");
       @line = $telnet->cmd("./closureUndrestand.pl");
       print("@line \n");

print("Getting answer of ls command through Nettelnet\n");        
       $telnet->cmd("cd $remote_cwd");
      @line = $telnet->cmd("ls");
       $telnet->close;

return (\@line);
}

 

Find Date Difference

#Purpose: Returns YES / NO , if date is between 7 days or not Date Format: yyyy-mm-dd
sub DateDifference(){
my ($CurrentDate,$oldDate)=@_;
my ($ResultReturn,$year,$month,$day,$Oyear,$Omonth,$Oday,$Cyear,$Cmonth,$Cday,,$monthSPan,$monthEND);
($Oyear,$Omonth,$Oday)=split("",$oldDate);($Cyear,$Cmonth,$Cday)=split("",$CurrentDate);
$ResultReturn="NO";$monthSPan=$Cmonth - $Omonth;
       if($monthSPan > 1){
               $ResultReturn="NO";
               goto END;
       }
       if($Cday < $Oday){
               $monthEND=monthEndDate($Omonth);
               $day=$monthEND - $Oday + $Cday
       }
       else{
               if($Cmonth != $Omonth){
                       $monthEND=monthEndDate($Omonth);
               }
               $day = $monthEND - $Oday + $Cday;
       }
       $ResultReturn="YES" if($day < 7);
END:

return         $ResultReturn;
}

#Purpose: get month end date for passed month
sub monthEndDate(){
my ($monthPass,$NoOfDays);
$monthPass=$_[0];
       $NoOfDays=31 if($monthPass == 1);
       $NoOfDays=28 if($monthPass == 2);
       $NoOfDays=31 if($monthPass == 3);
       $NoOfDays=30 if($monthPass == 4);
       $NoOfDays=31 if($monthPass == 5);
       $NoOfDays=30 if($monthPass == 6);
       $NoOfDays=31 if($monthPass == 7);
       $NoOfDays=31 if($monthPass == 8);
       $NoOfDays=30 if($monthPass == 9);
       $NoOfDays=31 if($monthPass == 10);
       $NoOfDays=30 if($monthPass == 11);
       $NoOfDays=31 if($monthPass == 12);

return $NoOfDays;
}

#Purpose: Returns current date
sub getTodaysDate(){
my ($option,$second,$minute,$hour,$dayOfMonth,$month,$yearOffset,$dayOfWeek,$dayOfYear,$daylightSavings,$year,$theTime,$planned_start_time)="abc";
$option=$_[0];
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @weekDays = qw(Sun Mon Tue Wed Thu Fri Sat Sun);
($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime();
       $year = 1900 + $yearOffset;
       $theTime = "$hour:$minute:$second, $weekDays[$dayOfWeek] $months[$month] $dayOfMonth, $year";
       $month=$month+1;
       $planned_start_time="$year-$month-$dayOfMonth" if($option == 0);
       $planned_start_time="$dayOfMonth $months[$month - 1]" if($option == 1);

return ($planned_start_time,$hour);
}

 

h

 

i

 

send message on port

sub connect()

{

          # initialize host and port

          my $workorder_number_2=$_[0];

          my $message="$workorder_number,CHANGESTATUS";

          #print("$message\n");

          my $host = shift || $DefaultIP;

          my $port = shift || $DPCGUIPort;

          #print ("host: $DefaultIP\nport: $port\n");

          my $proto = getprotobyname('tcp');

          # get the port address

          my $iaddr = inet_aton($host);

          my $paddr = sockaddr_in($port, $iaddr);

 

          #Purpose:Create the socket, connect to the port

          socket(SERVER, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";

          connect(SERVER, $paddr) or die "connect: $!";

          #print SERVER "Client Kunal is Connected  ...\n";

 

          #Purpose: Send messages

          print SERVER "$message\n";

          #print ("Closing Socket\n");

          close SERVER or die "close: $!";

}

Code For Server: Socket Programming

#! /usr/bin/perl -w 

#print ("1");

use strict;

use Socket;

my $counter=0;

my $port = shift || 7542;

my $proto = getprotobyname('tcp');

socket(SERVER, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";

setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1) or die "setsock: $!";

my $paddr = sockaddr_in($port, INADDR_ANY);

bind(SERVER, $paddr) or die "bind: $!";

listen(SERVER, SOMAXCONN) or die "listen: $!";

print "Waiting for Client Connection on Port : $port\n";

my $client_addr;

while ($client_addr = accept(CLIENT, SERVER)) {

        my ($client_port, $client_ip) = sockaddr_in($client_addr);

        my $client_ipnum = inet_ntoa($client_ip);

        my $client_host = gethostbyaddr($client_ip, AF_INET);

#          print("counter:$counter\n");

#          print("client_port:$client_port\n");

#          print("server_port:$port\n");

 

            if ($counter eq 0) {

                        print "Got a connection from: $client_host","[$client_ipnum]\n";

#                      print CLIENT "C Server is connected to you\n";

#                      print "NC Server is connected to you\n";

#                      close CLIENT;

                        $counter = $counter + 1;

                        }

#        print "before picking client\n";

        select(CLIENT);

        $|=0;

#        print "after picking client\n";

        select(STDOUT);

        while( my $line = <CLIENT> ) {

                chomp($line);

                if( $line !~ /exit/i ) {

                        print "Message From the Client => $line\n";

                        if($line eq "darling") {

                                    print "Got $line from Client--> invoking Darling function now \n";

                        }                       

                        if($line eq "execute") {

                                    print "Got $line from Client--> invoking Execute function now \n";

                        }

#                      print "NC Got the Message From YOU";

                        print CLIENT "C Got the Message From YOU";

#                      close CLIENT;

                }

                else {

                        print CLIENT "In else Block";

                }

        }

        print CLIENT "Get Lost -> and never come again\n";

#        close CLIENT;

}

close CLIENT;

Code for Client: Socket Programming

#! /usr/bin/perl -w

# client1.pl - a simple client

#----------------

 

use strict;

use Socket;

 

# initialize host and port

my $host = shift || '127.0.0.1';

my $port = shift || 7542;

print ("host: $host\n");

print ("port: $port\n");

my $proto = getprotobyname('tcp');

my $line ="start";

 # get the port address

 my $iaddr = inet_aton($host);

 my $paddr = sockaddr_in($port, $iaddr);

 # create the socket, connect to the port

socket(SERVER, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";

connect(SERVER, $paddr) or die "connect: $!";

 print SERVER "Trying to connect to SERver\n";

print SERVER "Kunal Starting now ...\n";

#while ( $line ne "exit") {

#          print "Send message to server: ";

#          $line = <STDIN>;

#          chomp($line);

#          print SERVER "Kunal Here";

#          print SERVER "$line";

#}

 print ("Closing Socket\n");

 close SERVER or die "close: $!";

 
Copyright 2009 Kunal Saxena Inc. All rights reserved