PERL SCRIPTS

PERL BASICS

String to Number conversion

my $string = "10";
$string = int($string); ## convert
print "$string\n";
(or)
my $string = "10";
$string = sprintf("%d", $string); ## convert
print "$string\n";

Substring

$string = "Hello World";
print length $string . "\n";
print substr($string, 0, 1) . "\n";
$vowels = () = $string =~ /([aeiou])/gi;

my $filesize = -s "OVIDDP\_OUT/$foldername1\.err";

($danansi, $dandate, $danan) = split(/\-/,$1);

FILE BASENAME

use File::Basename;
($name,$dir,$ext) = fileparse($ARGV[0],'\..*');
($fn, $ext) = fileparse($dir);

FILE COPY

use strict;
use warnings;
use File::Copy::Recursive qw(dircopy);
dircopy('C:\Documents and Settings\sundar\Desktop\Test1','C:\Documents and Settings\sundar\Desktop\OUT') or die("$!\n");

use File::Copy;
rename("0132981\_1\_temp/cover.png", "0132981\_1\_temp/a.png");

use File::Copy;
copy("E:/sundar/finalfolder/final.xml", "C:/Documents and Settings/sundar/Desktop/Test1/test.xml");

use File::Copy;
move("E:/sundar/finalfolder/final.xml", "C:/Documents and Settings/sundar/Test1/");
unlink("C:/Documents and Settings/sundar/Desktop/test.xml");

use File::Path;

rmtree("C:/Documents and Settings/sundar/Desktop/Test1");

open(FIN, "undef $/;
$filestr = ;
close(FIN);

print $filestr;
$dir = @ARGV[0];

chomp $dir;

opendir(DIR, "$dir");
@files = grep(/\.xml/i, readdir DIR);
closedir(DIR);

print scalar @files;

use Cwd;
$folder = getcwd;
opendir(DIRNAME, $folder);
    @xmlfiles = grep(/\.xml$/i, readdir DIRNAME);
closedir(DIRNAME);

for my $xmlfile (@xmlfiles)
{
    open(IN, "$folder/$xmlfile");
    undef $/;
    $data = ;
    close (IN);

      $data =~ s/
    open(OUT, ">$folder/$xmlfile");
    print OUT $data;
    close (OUT);
}

FILE FIND

use File::Find;

#$dir = @ARGV[0];

$dir = "C:/Documents and Settings/sundar/Desktop/Test1/date/Converted";

chomp $dir;

my @array;

find sub{push @array, "$File::Find::name" if(-f "$File::Find::name");}, $dir;

for $file (@array)

{

    print $file . "\n";

}

use File::Find;

use File::Basename;

use File::Path;

$dir = "@ARGV[0]";

chomp $dir;

@folder_all;

@folders;

find sub{push @folder_all, "$File::Find::name" if(-d "$File::Find::name");}, $dir;

for $folder_temp (@folder_all)

{

    ($fn, $fd) = fileparse($folder_temp);

    if($fn eq "Converted")

    {rmtree("$folder_temp");}

    else

    {push(@folders, "$folder_temp");}

}



for $folder (@folders)

{

    opendir(DO, "$folder") or die "test";

    @files = grep(/\.xml$/i, readdir DO);

    closedir(DO);

    if(@files)

    {mkdir("$folder/Converted");}



    for $file (@files)

    {

        open(FO, "<$folder/$file");

            undef $/;$data = ;

        close(FO);

        $data =~ s/

        open(FW, ">$folder/conversion/$file");

            print FW $data;

        close(FW);

    }

}

use Cwd;
use File::Basename;
open(FO, "C:/Documents and Settings/sundar/Desktop/Test1/ch01_09.xml") or die("$!/n");
$i = 0;
$file = "C:/Documents and Settings/sundar/Desktop/Test1/ch01_09.xml";
($filename, $fd) = fileparse($file);
$dir = $fd;
open(ERR, ">$dir/logg.err");

while(<FO>)
{
    $i++;
    if($_ =~m#    {
        $col = index($_, "        print ERR "$i:$col\n";
    }
}

close(ERR);
close(FO);

$num = 120;

$result = sprintf("%#.5d", $num);
print $result;

ARRAY COMPARE

@array1=(1,2,1,1,4,6,7,8);
@array2=(1,2,3,5,6,7);

map $count{$_}++, @array1, @array2;
$, = " ";
print "Array 1 : ", grep $count{$_} == 1, @array1;
print "\nArray 2 : ", grep $count{$_} == 1, @array2;
print "\nArray 1 Array 2 : ", grep $count{$_} == 1, @array1, @array2;
print "\n";

my @newworkflowjurnl = ("APP", "POLA", "POLB", "BTPR", "GCC", "HED", "CNCR", "CNCY", "LARY", "PRO", "STEM", "BIOF", "CCC", "HBM", "AIC", "CCD", "AR", "IBD", "JHET", "MUS", "JHM", "QUA", "MOP", "MRM", "JMRI", "DUDY");
my $element = 'HED';
if (grep {$_ eq $element} @newworkflowjurnl)
{
print "Element '$element' found!\n";
}
else
{
print "not found";
}

#not condition
if (!grep {$_ eq $element} @newworkflowjurnl)
{
print "Element '$element' found!\n";
}
else
{
print "not found";
}

$num = "3-8, 1, 25";
$num =~ s/\-/\.\./g;
@arr = eval($num);
@arr = sort {$a <=> $b} @arr;
$, = ",";
print @arr;

%months = ('January'=>'01','February'=>'02','March'=>'03','April'=>'04','May'=>'05','June'=>'06','July'=>'07','October'=>'10','November'=>'11','December'=>'12');

print "$months{January}\n";

Net::Address::IP::Local

use Net::Address::IP::Local;

# Get the local system's IP address that is "en route" to "the internet":

my $address = Net::Address::IP::Local->public;

FIND FILES AND PASTE IN SINGLE FOLDER

Copy files and paste in new folder if the file already exist with the same name/extension then create unique sequence

#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use File::Spec::Functions qw'catfile';
use File::Copy qw'move';
#use autodie    qw'move';
use File::Basename;

my ($filename);#    = 'DUMBFILE';
my $origin      = '/home/itadmin/FoldersFind/OriginalFolder';
my $destination = '/home/itadmin/FoldersFind/Destination';

mkdir($destination, 0777); 
my ($path);
find(\&wanted, $origin);

sub wanted
{
        if(-e $origin)
        {
                if($File::Find::name=~m/\.(exe|cmd|bat)$/gs)
                {
                        $filename = basename($File::Find::name);
                }
        }
        $path = "$destination/$filename";
        my $cnt;
        while(-e $path)
        {
                $cnt++;
                $path = catfile $destination, "$filename.$cnt";
        }
        move($filename, $path);
}

FIND AND PRINT LONGEST PARAGRAPHS


#!/usr/bin/perl -w
use strict;
use warnings;
my $lmax = '0';
open(TMP,"file.txt") || die "$!";
my($len,@word,@longest);
while (<TMP>)
{
      if (($len = length($_)) > $lmax)
      {
            $lmax = $len;
            @longest = ($_);
            @word = scalar(split(/\s+/, $_));
      }
      elsif ($len == $lmax)
      {
            push(@longest, $_);
      }
}
close(TMP);
print "@longest\n";
print "@word\n";

FIND FIBONACCI


#!/usr/bin/perl

print "How many numbers of the sequence would you like? ";
chomp( my $n =  <STDIN>);
print "\n"; # Just to visually separate the user's input from the program's outp#ut
fibonacci($n);

sub fibonacci
{
      my $a = 0;
      my $b = 1;
      for( 0 .. ($_[0] - 1) )
      {
            print "$a\t";
            ($a, $b) = ($b, ($a + $b));
            print "$b\n";
      }
}

PRINT DIAMOND SHAPE STARS

print "Your Keyboard numbers: ";

my $input = <STDIN>;
chomp($input);

for ($i = 1; $i <= (($input * 2) - 1); $i += 2)
{
      if ($i <= $input)
      {
            $stars = $i;
            $spaces = ($input - $stars) / 2;
            while ($spaces--)
            {
                  print " ";
            }
            while ($stars--)
            {
                  print "*";
            }
      }
      else
      {
            $spaces = ($i - $input) / 2;
            $stars = $input - ($spaces * 2);
             while ($spaces--)
             {
               print " ";
             }
             while ($stars--)
             {
                  print "*";
             }
      }
      print "\n";
}

FIND PRIME NUMBERS


#!/usr/bin/perl
use warnings;
use strict;
sub testprime
{
      my $m = shift @_;
      my $i = 2;
      while ($i < $m)
      {
            return 0 unless ($m % $i++);
      }
      return 1;
}
print "Enter a number to find the prime \n";
chomp (my $n = <STDIN>);
my $FindPrime = testprime $n;
if ( $FindPrime == 1)
{
      print "Yes, the given number is Prime \n";
}
else
{
      print "No, It is NOT a prime Number \n";
}

COMPARING FILES AND FIND COMMON LINE

use strict;
use warnings;

my %in_files;

open(my $f1, '<', 'FILE1.txt') or die "can't open FILE1: $!\n";
while (<$f1>) {
    $in_files{$_} .= '1';
}

open(my $f2, '<', 'FILE2.txt') or die "can't open FILE2: $!\n";
while (<$f2>) {
    $in_files{$_} .= '2';
}

open(my $common, '>', 'common_lines') or die "can't open common_lines:
+ $!\n";
open(my $u1, '>', 'unique_1') or die "can't open unique_1: $!\n";
open(my $u2, '>', 'unique_2') or die "can't open unique_2: $!\n";
for (keys %in_files) {
    if ($in_files{$_} =~ m/12/) { print $common $_; }
    elsif ($in_files{$_} =~ m/1/) { print $u1 $_; }
    else { print $u2 $_; }
}

MAIL SENDING PROCESSING USING MIME::LITE

sub SendMailProcess
{

    chomp (my $server = "server");
    my $from = 'sender@domain.com';
    my $to = 'receiver@domain.com';
    my $cc = 'copier@domain.com';
    my $mail_host = $server;
    my $subject = 'subject';
    my $message_body = "Content (Message)";

    #Attachment
    my $localfile = getcwd();
    my $attchfile = "$localfile/attachedfile";
    my $filename = "attachedfile";

    my $msg = MIME::Lite->new (
                               From => $from,
                               To => $to,
                               Cc => $cc,
                               Subject => $subject,
                               Type =>'multipart/mixed'
                                    ) or die "Error creating multipart container: $!\n";

    $msg->attach (
                  Type => 'TEXT',
                  Data => $message_body
                       ) or die "Error adding the text message part: $!\n";

    $msg->attach (
                  Type => 'text/html',
                  Path => $attchfile,
                  Filename => $filename,
                  Disposition => 'attachment'
                              ) or die "Error adding $attchfile: $!\n";

    MIME::Lite->send('smtp', $mail_host, Timeout=>60);
    $msg->send;
}

ZIP HTML FILES HAS EPUB

use strict;
use warnings;
use Cwd;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Copy;my $Dir = ;
chomp($Dir);
my $NcxFile = "Sample.ncx"; my $OpfFile = "Sample.opf";
my(@MyItemRef_One,@MyItemRef_Two);
opendir(DIR, "$Dir") || die "Can't open the $Dir $!";
my @HtmFiles = grep /\.(htm|html|css)$/, readdir(DIR);
unless(-d "$Dir/Output") { mkdir("$Dir/Output"); };
open(NCX, ">Output/$NcxFile") || die "Can't create the file $NcxFile $!";
open(OPF, ">Output/$OpfFile") || die "Can't create the file $OpfFile $!";
MetaData();

my $ItemRefCnt = '1'; my $NavPntCnt = '1';

foreach my $Singlefile(@HtmFiles)
{
        use File::Basename; my $Tmp;
        my $Filenames = basename($Singlefile);
        push(@MyItemRef_One, "\n");
        push(@MyItemRef_Two, "\n");
        print NCX "\n$Filenames\n\n\n";

        if($Singlefile=~m/\.(htm|html)$/gs)
        {
                open(HTM, $Singlefile) || die "Can't open the html file $Singlefile $!";
                { local $/; $_=; $Tmp=$_; }
                close(HTM);

                copy($Singlefile, "$Dir/Output/$Singlefile");
        }
        elsif($Singlefile=~m/\.css$/gs)
        {
                copy($Singlefile, "$Dir/Output/$Singlefile");
        }
        else {}
        $ItemRefCnt++; $NavPntCnt++;
}

print OPF @MyItemRef_One;
print OPF @MyItemRef_Two;

close(OPF);
close(NCX);

&Zipfiles();

sub MetaData
{

        my $PrintMet = <<SUNDAR

<?xml version="1.0" encoding="UTF-8"?>
<package version="2.0" xmlns="http://www.idpf.org/2007/opf" unique-identifier="BookId">
<metadata xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:opf="http://www.idpf.org/2007/opf">
<meta name="cover" content="cvr01"/>
<dc:title>title</dc:title>
<dc:language>english</dc:language>
<dc:identifier id="BookId" opf:scheme="ISBN">xxx-x-xxxxx-xxx-x</dc:identifier>
<dc:creator opf:role="aut">sundar</dc:creator>
<dc:publisher>Publisher</dc:publisher>
<dc:date>yyyy-mm-dd</dc:date>
</metadata>
<manifest><manifest>
SUNDAR
;
print OPF $PrintMet;
}

sub Zipfiles()
{

        opendir(IMG, "$Dir/Images") || die "Can't read the directory $Dir: $!\n";
        my @Imagefiles = grep /\.(jpeg|png|jpg|tiff)$/i, readdir(IMG);
        closedir(IMG);
        my $ImgFolder = "Images";
        move("$Dir/$ImgFolder","$Dir/Output/$ImgFolder");
        my $Zipdir = "$Dir/Output";
        my $Zipfiles = Archive::Zip->new();
        $Zipfiles->addTree( $Zipdir );
   unless($Zipfiles->writeToFileNamed("Sample\.epub") == AZ_OK)
        { die 'write error'; }

}

MAIL SENDING PROCESSING IN MAIL::SENDER

#!/usr/bin/perl -w

use Cwd;

use strict;

use Mail::Sender;

my $loginName = getlogin();

my $CmdIPConfig = ((`ipconfig`) =~ /IP Address. . . . . . . . . . . . : (\S+)/);

my $IP_Address = $1;

my $LocalFile = 'INPUT.csv';

my $ClntList;

open(CSV, $LocalFile) || die "Can't read/open the dir $LocalFile: $!";

while(<CSV>)

{

        my ($ClnNme,$MailId);

        my $Single = $_;

        $Single=~s/^(.*?)$/\n$1\n/gs;

        $Single=~s/\n/\n\n/gs;

        if($Single=~m/\n(\w+)\t(.*?)\n/gs)

        {

                $ClnNme = $1; $MailId = $2;

                &SendMailProcess($ClnNme,$MailId);

        }

}

#======================

sub SendMailProcess

#======================

{

        my $NameClnt = shift;

        my $MailClnt = shift;

        print "Client Name: $NameClnt\tMail Id: $MailClnt\n";

        my $sender = new Mail::Sender {

                auth => 'PLAIN',

                authid => 'authuser@domain.com',

                authpwd => 'mailpassword',

                smtp => 'smtp.domain.com',

                port => nnn,

                from => 'authuser@domain.com',

                to => $MailClnt,

                subject => 'SUBJECT',

                msg => "BODY CONTENT",

                #file => 'PATH ',

                #debug => "PATH",

                #debug_level => n,

                #timeout => nnn,

        };

        #my $result = $sender->MailFile({

        my $result = $sender->MailMsg({

                msg => $sender->{msg},

                #file => $sender->{file},

        });

        #print "$sender->{error_msg}\n>>>End.\n";

        1;

}

SPLIT LINE WITH LIMITED TEXT (for example 80 characters and break the line)

my $limit = 80;

my $NF;

open(NF, "test.txt");

open(OUT, ">text.txt");

while (<NF>) {

    my $line = $_;

    do {

        if ($line =~ /^(.{0,$limit})(?:(\s+)(.*)$|$)/) {

        print OUT $1;

        $line = $3;

        print OUT "/\n$2" if(length($line) > 0);

        }

    } while (length($line) > 0);

    print OUT "\n";

}

close(NF);

NUMBERS CONVERT TO WORDS

my $num = '4698985';

my %maps =( 1 => "one",

2 => "two",

3 => "three",

4 => "four",

5 => "five",

6 => "six",

7 => "seven",

8 => "eight",

9 => "nine",

0 => "zero",

);

my @valuescnt = split(//, $num);

# @valuescnt = map {$maps->{$_}} @valuescnt;

foreach my $sngval(@valuescnt)

{

print $sngval, "=", $maps{$sngval}, "\n";

}

FIND A PALINDROME

#!usr/bin/perl

print "\nEnter a word to find palindrome: ";
chomp ( $palin = <STDIN> );

@palindrm = split( //, $palin );
@reverses = reverse( @palindrm );

$szPalindrome = @palindrm;

for( $i = 0; $i < $szPalindrome; $i++ ){
    # If any of the letters do not match then
    # the loop is broken
    if( $palindrm[$i] ne $reverses[$i] ){
        $pali = "";
        last;
    }
    else{
        $pali = "true";
    }

}

if( $pali )
{
    print "$palin is a palindrome\n";
}
else{
    print "$palin is not a palindrome. It is normal word.\n";
}

PALINDROME SECOND WAY

use strict;
use warnings;

print "Enter the numbers your want to check: ";
my $nums = <STDIN>;
chomp($nums);
my $org = $nums;
my $ns; my $ds='';
my @revs;
while($nums gt 0)
{
    $ns = $nums % 10;
    $nums = $nums / 10;
    if($ns gt '0')
    {
       $ds .= $ns;
    }
    else {}
}

$org eq $ds ? print "Ok....\n" : print "NOT Ok....\n";

COMPARE TWO FILES

    use strict;
    use warnings;
    use File::Slurp qw/read_file/;
    use List::Compare;

    chomp( my @a_file = read_file 'a_file.txt' );
    chomp( my @b_file = read_file 'b_file.txt' );

    my @a_file_only = List::Compare->new( \@a_file, \@b_file )->get_Lonly;

    print "$_\n" for @a_file_only;

COMPARE TWO FILES DIFFERENT FOLDERS

use strict;

use warnings;

use Cwd;

use File::Slurp qw/read_file/;

use List::Compare;

my $cwdget = getcwd();

my $prepflder = "first_folder"; my $srvrflder = "second_folder";

opendir(DIR, "$cwdget/$prepflder") || die "$!";

my @sqlfiles = grep (/\.sql$/i, readdir(DIR));

closedir(DIR);

open(OUT, ">OUTlog.err") || die "$!";

foreach my $sqlfile(@sqlfiles)

{

    chomp( my @a_file = read_file "$cwdget/$prepflder/$sqlfile");

    chomp( my @b_file = read_file "$cwdget/$srvrflder/$sqlfile");

    my @a_file_only = List::Compare->new( \@a_file, \@b_file )->get_Lonly;

    for (@a_file_only)

    {

        $_=~s/\n/\n\n/gs;

        $_=~s/regex \[regex\]//gs;

        $_=~s!/*(.*?)*/!!gs;

        chomp($_);

        $_=~s/\n/\n\n/gs;

        print OUT "$sqlfile\t\t$_\n";

    }

#    print "$_\n" for @a_file_only;

}

Perlspringers Learn and Educate

Search This Blog