Category Archives: Perl Scripts

It contains Perl Scripts that I learn newly.

Perl Program to calculate age

To calculate the age, we can use following subroutine :

print &age($tmpdob[2],$tmpdob[1],$tmpdob[0]);
sub age {
           # Assuming $birth_month is 0..11
           my ($birth_day, $birth_month, $birth_year) = @_;
           my ($day, $month, $year) = (localtime)[3..5];
          $year += 1900;
          $month+=1;
          my $age = $year - $birth_year;
          $age-- unless sprintf("%02d%02d", $month, $day)
            >= sprintf("%02d%02d", $birth_month, $birth_day);
          my $mnth=($month>$birth_month)?$month-$birth_month:12+($month-$birth_month);
          return $age."Y/".$mnth."M ";

}

How to create a folder in perl?

In Perl we can create a folder using mkdir() function.

eg:

 mkdir("new_folder_name");

How to check availability of a folder in perl?

We can check the availability of a folder using Perl as follows :

if(-d "cgi-bin")
{
          # directory called cgi-bin exists
}
elsif(-e "cgi-bin")
{
          # cgi-bin exists but is not a directory
}
else 
{
          # nothing called cgi-bin exists
}

As a note, -e doesn’t distinguish between files and directories. To check if something exists and is a plain file, use -f.

is_array in perl?

There is no predefined is_array subroutine in Perl. if you are in need of such a function use the below code.

 

sub is_array {
  my ($ref) = @_;
  # Firstly arrays need to be references, throw
  #  out non-references early.
  return 0 unless ref $ref;

  # Now try and eval a bit of code to treat the
  #  reference as an array.  If it complains
  #  in the 'Not an ARRAY reference' then we're
  #  sure it's not an array, otherwise it was.
    eval {
        my $a = @$ref;
    };
    if ($@=~/^Not an ARRAY reference/)
    {
        return 0;
    }
    elsif ($@)
    {
        die "Unexpected error in eval: $@\n";
    }
    else
    {
        return 1;
    }
}

Need of an example? It’s given below :

#!/usr/bin/perl -w
use warnings;
use XML::Simple;

my @file;
$file[0]= '
    
        
            1000
        
        
            12001
            25000
        
    ';
$file[1]= '
    
        
            1000s
        
        
            12001x
        
    ';
foreach my $temp(@file)
{
    my $test_data = XMLin($temp);
    if(is_array($test_data->{proc}->{cpt}))
    {
        foreach my $dx (@{$test_data->{proc}->{cpt}})
        {
            print $dx."\n";
        }
    }
    else
    {
        print $test_data->{proc}->{cpt}."\n";
    }
}

How to fix the number of values after the decimal?

It can be done as follows :

sprintf '%.2f', '10.0500000'