PERL Code Compilation

Jul 28, 2011

Here is the list of my PERL codes that I always use since I started programming in this great scripting tool. This code helps me to build larger scripts fast that I used in automating data extraction, data manipulation, reports, auto telnet, auto ssh, auto putty, auto ftp and more. For more intermediate to advance scripts like site scraping and creating SP4M messages you can email me and I will send you my PERL script for that. Please be reminded that I use it only for educational purposes and you should comply to that also. Feel free to copy and paste this code and use it right away in your PERL scripts.

If you have a question just leave a comment below and I will get back to you as soon as possible. I will update this list whenever I have my free time.

How To Put Commas In Numbers in PERL

#————————————————————————

# How To Solve DBI connect failed Error in PERL

#————————————————————————

# How To Manually Catch Parameters in PERL

#————————————————————————

# How To Store a regular expression in a variable in PERL

$local = “TR|PL|EX|TQ|TA|SN|BA|BS|DT|BH|GL”;

$pcode = qr/^s*($local)dw?s+d[A-Z]{2}s*$/;

@vcheck = (“SN12 6QL”,”G3 7XR”,”GLZ 7PX”,” OX11 0EY”,”NW1 1AD”);

foreach $tp (@vcheck) {

$tp =~ $pcode and print “$1n”;}

#————————————————————————

# How To avoid “Illegal division by zero” ERROR in PERL

$ave = $ave/@kpps; # from this
$ave = @kpps && $ave/@kpps; # change to this

#————————————————————————

# How To Use Join In PERL

@myNames = (‘Jacob’, ‘Michael’, ‘Joshua’, ‘Matthew’);
$someNames = join(‘, ‘, @myNames);

# Think of the @myNames array as a row of numbered boxes,
# each with a name in it. The join() function would take all of the
# content in those boxes in the @myNames array and connect
# them together with a comma and a space.
# The value of $someNames then becomes “Jacob, Michael, Joshua, Matthew”.
# The list of names is concatenated, or joined, by commas.

#————————————————————————

# How To Convert XML to CSV in PERL

#!/usr/bin/perl
use warnings;
use strict;
use XML::XPath;

my($xp) = XML::XPath->new( join(”, <DATA>) );
my(@records) = $xp->findnodes( ‘/records/record’ );
my($firstTime) = 0;

foreach my $record ( @records ) {
my(@fields) = $xp->find( ‘./child::*’, $record )->get_nodelist();
unless ( $firstTime++ ) {
print( join( ‘,’, map { $_->getName() } @fields ), “n”);
}

print( join( ‘,’, map { $_->string_value() } @fields ), “n”);
}

# __DATA__
# <records>
# <record>
# <id>1</id>
# <name>George Foo</name>
# <phone>555.666.7777</phone>
# </record>
# <record>
# <id>2</id>
# <name>Betty Bar</name>
# <phone>666.777.8888</phone>
# </record>
# </records>

# [trwww@waveright perl]# perl xml2csv.pl
# id,name,phone
# 1,George Foo,555.666.7777
# 2,Betty Bar,666.777.8888

# If your data has commas in it, then you can run $_->string_value()
# through a filter that escapes the comma.

# enjoy,

# by Todd W.

#————————————————————————

# How To Find files in a directory including subdirectory in PERL

use strict;
use warnings;

use File::Find;

my $localdir = ‘/ddrive/db2_text’;

find( sub { print $File::Find::name, “n” if /.txt$/ },$localdir);

#————————————————————————

# How To Match Date and Time in PERL

sub isvaliddate {
my $input = shift;
if ($input =~ m!^((?:19|20)dd)[- /.](0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])$!) {
# At this point, $1 holds the year, $2 the month and $3 the day of the date entered
if ($3 == 31 and ($2 == 4 or $2 == 6 or $2 == 9 or $2 == 11)) {
return 0; # 31st of a month with 30 days
} elsif ($3 >= 30 and $2 == 2) {
return 0; # February 30th or 31st
} elsif ($2 == 2 and $3 == 29 and not ($1 % 4 == 0 and ($1 % 100 != 0 or $1 % 400 == 0))) {
return 0; # February 29th outside a leap year
} else {
return 1; # Valid date
}
} else {
return 0; # Not a date
}
}

#If you want to require the delimiters to be consistent, you could use a backreference. 2
$date =~ m!^(19|20)dd([- /.])(0[1-9]|1[012])2(0[1-9]|[12][0-9]|3[01])$!;
# will match 1999-01-01 but not 1999/01-01.

# Note: To figure out the number of a particular backreference,
# scan the regular expression from left to right and count the opening round brackets.
# The first bracket starts backreference number one, the second number two, etc.

# To match a date in mm/dd/yyyy format, rearrange the regular expression to
$date =~ m!^(0[1-9]|1[012])([- /.])(0[1-9]|[12][0-9]|3[01])2(19|20)dd$!;

# You can analyze this regular expression using RegexBuddy.

# For dd-mm-yyyy format, use
$date =~ m!^(0[1-9]|[12][0-9]|3[01])[- /.](0[1-9]|1[012])[- /.](19|20)dd$!;

#————————————————————————

# How To Remove a character in a string in PERL

# Remove (,) from the number “1,435,435″

$millions = “1,435,435″;
$millions =~ s/,//g;
print $millions;

#Output: 1435435

# Usage: s/PATTERN/REPLACEMENT
# g – replace all occurences of PATTERN

#————————————————————————

# How To Use The Substr Function in PERL

$x = “xyz”
print substr($x,0,-1); # output: xy
print substr($x,-1,1); # output: z
print substr($x,-2,1); # output: y

#————————————————————————

# How To Debug PERL scripts

# perl -d <script>
# s – single steps
# n – single steps within a subroutine
# r – returns from the current subroutine
# p EXPR – prints the EXPR expression
# b [ LINE [ CONDITION ]] – Sets breakpoint at LINE, default is the current line.

#————————————————————————

# How To Test If A File Exist using PERL

$file = “C:\folder1\folder 2\file1.txt”;

print $file.” exist!” if -e $file;
print $file.” does not exist!” if !-e $file;

# Note: if you use / instead of \ “if -e” will fail but no error

# Other file test operators
# -r -w -x File is readable/writable/executable by effective uid/gid.
# -R -W -X File is readable/writable/executable by real uid/gid.
# -o -O File is owned by effective/real uid.
# -e -z File exists / has zero size.
# -s File exists and has non-zero size. Returns the size.
# -f -d File is a plain file, a directory.
# -l -S -p File is a symbolic link, a socket, a named pipe (FIFO).
# -b -c File is a block/character special file.
# -u -g -k File has setuid/setgid/sticky bit set.
# -t Tests if filehandle (STDIN by default) is opened to a tty.
# -T -B File is a text/non-text (binary) file. -T and -B return true on a null
# file, or a file at EOF when testing a filehandle.
# -M -A -C File modification/access/inode-change time. Measured in days.
# Value returned reflects the file age at the time the script started.

#————————————————————————

# How To Execute DOS commands in PERL

# Use the “system()” command

# Example: to run the DOS command “dir *.* /a/s”
system( “dir *.* /a/s” );

# Example 2: mkdir “c:\folder1\folder 2″
system( “mkdir ”c:\folder1\folder 2”" );

# Note: perl has it’s own mkdir command
# mkdir DIR, MODE
# Creates a directory with given permissions. Sets $! on failure.

#————————————————————————

# How To Pass Parameters To A PERL Script

# Use the special variable $ARGV[x];
# x is an integer value starting from 0 that indicate as your first parameter[0], second[1], third[2] etc.

# To test if an $ARGV[x] holds a value, you can test for ord($ARGV[x]) == 0
# If true, it has no value

# Example: perl pscript.pl parameter1 parameter2
$ARGV[0] = “parameter1″; $ARGV[1] = “parameter2″;
if ( ord($ARGV[2]) == 0 ){ print “value not specified”; };

# Note: Use double qoutes when specifying string value that contains spaces especially directory names

#————————————————————————

# How To Execute PERL command directly from the command line

# This is normally used to test a code for it’s output

# You can do this just by typing: perl -e “<code>”
# You should separate each code by “;”
# When specifying strings as variable use – ”;
# Also used when specifying string that contains spaces ex. c:\Documents and Settings\folder1\file 2.txt
# Example: perl -e “$var = ”asdf”;print $var;” <press Enter>

#————————————————————————

# How To List Files Of A Directory in PERL

# I created my own function for this

sub getfiles
{
my ( $dirname, $pattern ) = @_;
my @files = ();
opendir(DIR, $dirname) or die “can’t opendir $dirname: $!”;
@files = grep{ /$pattern/ } readdir(DIR);
closedir(DIR);
return @files;
}

# Usage:

@files = getfiles( “C:\”, “*.txt” ); # get all text files from the C: drive

# Or you can use the “glob” function
@files = glob “c:\*.txt”; # the only difference is that “glob” includes the full path of the file

foreach( @files ) # display all text files in the screen to verify
{
print $_.”n”;
};

#————————————————————————

# How To Use The PERL Split command

# Removing carriage return/line feed at the end of a string.
# This is usually done when reading a file line by line

$line = (split(/n/,$line))[0];

# Getting only the file name part, excluding the file extension

$fname = (split(/./,”filename.extension”))[0]; # $fname will contain “filename”

# Getting only part of directory name

$folder = (split(///,”C:\folder1\folder2\folder3″))[0]; # $folder = C:
$folder = (split(///,”C:\folder1\folder2\folder3″))[1]; # $folder = folder1
$folder = (split(///,”C:\folder1\folder2\folder3″))[2]; # $folder = $folder2
$folder = (split(///,”C:\folder1\folder2\folder3″))[3]; # $folder = ?
# I bet that you already know the answer to this one =)

#————————————————————————

# How To Determine the Simple Difference between two arrays

# Simple Difference means members of a set not found in another set

# assume @A and @B are already loaded
%seen = ( );                    # lookup table to test membership of B
@aonly = ( );                   # answer

# build lookup table
foreach $item (@B) { $seen{$item} = 1 }

# find only elements in @A and not in @B
foreach $item (@A) {
unless ($seen{$item}) {
# it’s not in %seen, so add to @aonly
push(@aonly, $item);
}
}

## Simple Difference
perl -e “%seen=();@aonly=();@A=(1,2,3,4);@B=(1,3,5);foreach $item(@B){$seen{$item}=1};foreach $item(@A){unless($seen{$item}){push(@aonly,$item);}};print ”@aonly”;”;

%seen=();@aonly=();@A=(1,2,3,4);@B=(1,3,5);

foreach $item(@B)
{
$seen{$item}=1};
foreach $item(@A)
{
unless( $seen{$item} ){ push(@aonly,$item); };
};
};

## Union, Intersection, Symmetric Difference
perl -e “@a=(1,3,5,6,7,8);@b=(2,3,5,7,9);@union=@isect=@diff=();%union=%isect=();%count=();foreach $e(@a,@b){$count{$e}++};@union=keys %count;foreach $e(keys %count){if($count{$e}==2){push @isect,$e;}else{push @diff,$e;};};print ”@unionn”;print ”@isectn”;print ”@diffn”;”;

@a=(1,3,5,6,7,8);@b=(2,3,5,7,9);@union=@isect=@diff=();%union=%isect=();%count=();
foreach $e(@a,@b){$count{$e}++};
@union=keys %count;
foreach $e(keys %count)
{
## if the iteration happens twice, that element is a member of both sets
if($count{$e}==2){push @isect,$e;}
## if the iteration happens only once, that element is a member of either set but not both
else{push @diff,$e;};
};

## Assume there are two sets: set A & set B
## UNION -> all elements from both sets
## INTERSECTION -> element/s of both sets
## SYMMETRIC DIFFERENCE -> element/s of a set not found from the other set

#————————————————————————

# How To Extract Unique Records From A Given List

@items = grep { ! $seen{ $_ }++ } @items;

#————————————————————————

# How To Remove Leading and Trailing Spaces in PERL

$string =~ s/^s+//; # remove the spaces at the beginning of the string
$string =~ s/s+$//; # remove the spaces at the end of the string

# create a function that will implement this solution

sub trimspaces
{
my $string = $_[0];
$string =~ s/^s+//; # remove the spaces at the beginning of the string
$string =~ s/s+$//; # remove the spaces at the end of the string
return $string;
}

#————————————————————————

# How To Implement A Circular List in PERL

unshift(@circular, pop(@circular));  # the last shall be first
push(@circular, shift(@circular));   # and vice versa

# pop – gets the last value
# push – insert a value at the end
# shift – is the inverse of pop
# unshift – is the inverse of push

#————————————————————————

# How To Convert A PERL String To PERL Array

$string = “0123456789thequick”;

@chars = split(//,$string);

# @chars now contains (’0′, ’1′, ’2′, ’3′, ’4′, ’5′, ’6′, ’7′, ’8′, ’9′, ‘t’, ‘h’, ‘e’, ‘q’, ‘u’, ‘i’, ‘c’, ‘k’)

# print the contents
foreach(@chars)
{
print $_.”n”;
};

#————————————————————————

# How To Creat A File From Array Using Tie:File

use Tie::File;

$dest = “c:\folder\file1.ext”; # the location were the file will be save and the filename
my @contents = (); # clear the contents of the @contents array

for $i(0..10)
{
push(@contents, “this is line no: $i”); # put some contents in the @contents array
};

tie @contents, ‘Tie::File’, $dest; # associate the contents of the $dest file to @fcontents array
untie @contents; # de-associate

# clear the contents
@contents = ();
@fcontents = ();

#————————————————————————

# How To Roundup Numbers in PERL

sub roundup {
my $n = shift;
return(($n == int($n)) ? $n : int($n + 1))
}

#————————————————————————

# How To Sort PERL Arrays and Hashes

# Arrays :

@arrays = sort{ $a <=> $b } @arrays; # ascending
# for descending change to $b <=> $a

# Hashes :

%hashes = sort{ $hash->{$a} <=> $hash->{$b} } keys(%hashes)
# for descending change to $hash{$b} <=> $hash{$a}

# Note: if you want to sort non-numeric values change “<=>” to “cmp”

#————————————————————————

# How To Specify the number of decimals after the decimal point

# use the sprintf function
$qoutient = 2435235.4353535345;
$qoutient = sprintf(“%.3f”, $qoutient);
$qoutient = 2435235.435;

#————————————————————————

# How To Avoid Divide-by-Zero Error

# instead of using this statement
$numerator / $denominator;

# use this instead
$denominator && $numerator / $denominator;

#———————————

# How To Clear The Contents Of An Array

# Just give the array an empty list
# then its done
@array = ();

#————————————————————————

# How To Assign Members Of An Array

@array = (“item1″, 4, “item4″);
@arrays = ( @array, “dog”, “cat”, 45 );

# Now, @arrays = (“item1″, 4, “item4″, “dog”, “cat”, 45);

#————————————————————————

# How To Access Array Members

# the default variable is used
# if you do not specify the variable
# that will hold the current member
foreach(@array)
{
print $_;
};

# —or—

# this time, $array is used to access the values of @array
foreach $array(@array)
{
print $array;
};

# —or—

# another method using for statement
# $#array is the index of the last element of @array
for $i(0..$#array)
{
print $array[$i];
};

#————————————————————————

# How To Implement Arrays of Array using array reference

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

# this is fine as long as you dont need to access the members of each group
@all = (@array1, @array2, @array3);

# this will do the trick, pass the reference of each array as members of the @all array
# Note: Arrays in perl are zero-indexed
@all = (@array1, @array2, @array3);

# to access the members of @array1

$ref1 = $all[0]; # pass the reference of @array1 to a variable

# iterate on each member
foreach(@$ref1)
{
print $_;
};

# —or—

for $i(0..$#$ref1)
{
print $ref1->[$i];
};

# to access all arrays
foreach(@all)
{
$ref = $_;
foreach(@$ref)
{
print $_;
};
};

#————————————————————————

# How To Write To A File

$file = “C:\folder1\file.txt”; # make sure that the folder1 exists in your drive
$contents = “Hello World!”;

open FH, “>>$file”;        # open for appending, creating it if necessary
print FH “$contents”.”n”; # write the contents as new line
close FH;                  # close the file

#————————————————————————

# How To Read From A File

open INPUT, “<$file”; # assign INPUT as file handle of $file
@contents = <INPUT>;  # retrieve the content of the whole $file
close INPUT;          # close the file handle
return @contents;     # put the contents of the $file in an array

@contents = <INPUT>; or while(<INPUT>)

#————————————————————————

# How To Retrieve Array Members Fast

The xxxquick brown
fox jumps over
the laxxxzy dog
Old McDonal
has a farmxxx

@tmp = grep { $_ =~ /xxx/ } @lines;

# Now, @tmp will contain the 1st, 3rd and the 5th line
# Note: If the complexity of the pattern matching increases, the retrieval time also increases

#————————————————————————–