Perl Quick Start Template

When starting a new script, you can use this template as a base which consists of:

1. RCS, CVS or SVN "Id" keyword to keep the version information.
2. Support script arguments.
3. Show usage function.
4. A trim function.

#!/usr/bin/perl -w
# $Id: $
#
use strict;
use Getopt::Long;

my $VERSION = "1.0";

my %option;
die unless GetOptions(
    "help"         => \$option{'help'},
);

if (defined( $option{'help'} )) {
    print_usage();
}

...


# Perl trim function to remove whitespace from the start and end of the string
sub trim {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}

# Print usage
sub print_usage {
    my $usage = <<EOF;
DESCRIPTION:
    

OPTIONS:
    --[h]elp    Show this help text.

EXAMPLE:
    \$ $0
EOF
    die($usage);
}

How to Change Linux Password via SSH

Script to change Linux password remotely via SSH.

Prerequisite
For ActivePerl users, you need to download the Net::SSH2 package. Version 5.10.x

C:\>ppm install http://cpan.uwinnipeg.ca/PPMPackages/10xx/Net-SSH2.ppd

Version 5.12.x

C:\>ppm install http://cpan.uwinnipeg.ca/PPMPackages/12xx/Net-SSH2.ppd

Scripts

#!/usr/bin/perl 

use strict;
use Net::SSH2;

use Getopt::Long;

my %option = (
    'server'       => 'localhost',
    'userid'       => '',
    'password'     => '',
    'newpassword'  => '',
);

if (!GetOptions("server|s=s"       => \$option{'server'},
                "userid|u=s"       => \$option{'userid'}, 
                "password|p=s"     => \$option{'password'}, 
                "newpassword|n=s"  => \$option{'newpassword'})) {
    print_usage();  
}

my $ssh2 = Net::SSH2->new();

$ssh2->connect($option{'server'}) or die "Unable to connect Host $option{'server'} \n";

$ssh2->auth_password($option{'userid'}, $option{'password'}) or die "Unable to login\n";

my $chan = $ssh2->channel();
$chan->blocking(0);
$chan->ext_data('merge');

my $cmd = "chage -l $option{'userid'}; " 
        . "echo -e \"$option{'password'}\\n$option{'newpassword'}\\n$option{'newpassword'}\\n\" | passwd 2>&1\n";

# print $cmd;

$chan->exec($cmd);

while (<$chan>) { 
    print $_;
} 

#########################################################################
# Subroutines
#########################################################################
sub print_usage {
    # ...
}

Check for Holiday with Perl

In some cases we would like to avoid to execute the script during public holiday e.g. Don’t send alert during holiday. This script contains 2 functions i.e. “load_holiday_file” and “is_holiday” where you can include in your script to check for holiday.

#!/usr/bin/perl
use strict;

my @holidays = ();
my @now = localtime(time());

my $date = sprintf("%02d-%02d-%04d", $now[3], $now[4]+1, $now[5]+1900 );

load_holiday_file(\@holidays, 'holiday.txt');

if (is_holiday(\@holidays, $date)) {
    print "Today is holiday";
}

# Check the date is holiday
# "date_to_check" is in "DD-MM-YYYY" format.
sub is_holiday {
    my $holidays = shift;
    my $date_to_check = shift;
       
    my $counter = 0;
    my $found = 0;
       
    while($counter <= $#{holidays} && !$found) {
        my $holiday = $holidays->[$counter];
               
        if ($date_to_check =~ /^$holiday/) {
            $found = 1;
        }
        else {           
            $counter++;
        }   
    }

    return $found;
}

# Load holiday file
# Holiday file
# 1. DD-MM-YYYY
# 2. DD-MM (Every year on this date)
sub load_holiday_file {
    my $holidays     = shift;
    my $holiday_file = shift;
       
    if (open(HOLIDAY_FILE, $holiday_file)) {
   
        my $line;
        while (defined($line = <HOLIDAY_FILE>)) {   
            chomp($line);
             
            next if ($line =~ /^\s*#/ );
            next if ($line =~ /^$/);
           
            # Trim the string
            $line =~ s/^\s+//;   
            $line =~ s/\s+$//;
                                               
            push @{holidays}, $line;
        }        
        close(HOLIDAY_FILE);
    }
} 












Holiday File
# Holiday file
# 1. DD-MM-YYYY
# 2. DD-MM (Every year on this date)
27-01-2011       
03-02-2011
03-02-2011
22-04-2011
02-05-2011
17-05-2011
09-08-2011
30-08-2011
26-10-2011
06-11-2011
26-12-2011
02-01-2012

Sort Date in "DD MMM YYYY" format

To sort date in "DD MMM YYYY" format (e.g. "02 DEC 2010")

#/usr/bin/perl -w
use strict;

# Constants
my %MONTH_NUMBER = (
    'JAN' => 1,
    'FEB' => 2,
    'MAR' => 3,
    'APR' => 4,
    'MAY' => 5,
    'JUN' => 6,
    'JUL' => 7,
    'AUG' => 8,
    'SEP' => 9,
    'OCT' => 10,
    'NOV' => 11,
    'DEC' => 12,    
);

my @myarray = (
    '08-DEC-10',
    '30-NOV-10',
    '26-NOV-10',
    '25-NOV-10',
    '25-NOV-10',
    '24-NOV-10',
    '11-NOV-10',
    '10-NOV-10',
    '10-NOV-10',
    '08-NOV-10',
    '03-NOV-10',
    '02-NOV-10',    
    '01-NOV-10',
);

my @sorted_array = sort sort_func @myarray;

print "@sorted_array"; 

####################
# Subroutine
####################
# Sort function
sub sort_func() {
    # To sort in desc, just swap $a and $b
    #return convert_datenumber($b) 
    #   cmp convert_datenumber($a);
  
    return convert_datenumber($a) 
       cmp convert_datenumber($b);
}

# Convert "DD MMM YYYY" into "YYYYMMDD"
sub convert_datenumber() {
    my $in_date = $_[0];
    
    my $out_date = 0;
            
    if (length($in_date)) {
        my $day        = substr($in_date, 0, 2);
        my $month      = $MONTH_NUMBER{ substr($in_date, 3, 3) };
        my $year       = substr($in_date, 7);
        
        $out_date = $year * 10000 
                  + $month * 100
                  + $day;                                    
    }
        
    return $out_date;
}

Output:

01-NOV-10 02-NOV-10 03-NOV-10 08-NOV-10 10-NOV-10 10-NOV-10 11-NOV-10 24-NOV-10 25-NOV-10 25-NOV-10 26-NOV-10 30-NOV-10 08-DEC-10

Arguments By Reference

Modify scalar, hash and list through a subroutine.

#!/usr/bin/perl -w
use strict;

my $name;
my %contacts;
my @children;

&my_function(\$name, \%contacts, \@children);


print "Name = $name\n";

foreach my $key ( keys(%contacts) ) {
    print "$key = $contacts{$key}\n";
}
 
foreach my $child (@children) {
    print "Child = $child\n";
}

sub my_function() {
    my $ref_name      = $_[0];
    my $ref_contacts  = $_[1];
    my $ref_children  = $_[2];
    
    $$ref_name = "Harry";
    $$ref_contacts{'home'} = '1234567890';
    $ref_contacts->{'work'} = '9876543210';

    push(@$ref_children, 'James');
    push(@$ref_children, 'Mary');

    print "Name = $$ref_name\n";
    
    foreach my $key ( keys(%$ref_contacts) ) {
        print "$key = $$ref_contacts{$key}\n";
    }
    
    foreach my $child (@$ref_children) {
        print "Child = $child\n";
    }
    print "\n";       
}

Handle Command Line Arguments

Command line argument is commonly use in passing in the configuration to a Perl script. Fortunately, Perl's core module come with a parsing library i.e. GetOpt::Long which ease the parsing of arguments.

Here is the sample code:

#!/usr/bin/perl
use Getopt::Long;

my @files = ();
my $outputfile;

# Checking for missing arguments
if (@ARGV == 0 || 
  !GetOptions("input=s{1,}" => \@files, 
              "output|dest=s" => \$outputfile) || 
  @files == 0 || 
  !defined($outputfile)) { 
  # Print Usage
  print "Invalid arguments!\n"; 
  exit 1;
}
print "Total Input File: " . @files . "\n";
foreach my $file (@files) {
  print "-> $file\n";
}
print "Output File: $outputfile\n";

Output:

D:\>GetOptions.pl -i a.txt b.txt -d my.txt
Total Input File: 2
-> a.txt
-> b.txt
Output File: my.txt

The checking for the missing arguments:

• Check for zero argument: if (@ARGV == 0 ||
• Check options are in "s" or "o" or "d": !GetOptions("input=s{1,}" => \@files, "output|dest=s" => \$outputfile)
• Check for no input files: @files == 0
• Check for missing output file: !defined($outputfile)

To get multiple values the option, you can use "input=s{1,}", it will store the values into a list (@files).

NOTE: In Perl, a subroutine parameter start with back slash ("\") e.g. \@files, indicates pass by reference. It means the parameter can be changed through the subroutine.

How to Process Multiple Files from Wildcard Arguments

To process multiple files from wildcard arguments, use glob() function.

#!/usr/bin/perl
@files = glob("@ARGV");
foreach (@files) {
    print "File: $_\n";
}

Please notice that the @ARGV is surrounded by double quotes. Without double quotes, it will return the count of arguments.

Example:

D:\>process_files.pl test*.pl myperl.pl exec_cmd.pl
File: TestBack.pl
File: TestCSV.pl
File: TestDate.pl
File: myperl.pl
File: exec_cmd.pl