Circular references are one the canonical causes of memory leaks. The reason is due to the flexibility provided by the Perl to use the variables, references, etc. Perl uses reference counting garbage collection. This means that Perl keeps a count of what pointers to any variable exist at a given time. If the variable goes out of scope and the count is 0, the variable is cleared.

sub leak {
    my ($foo, $bar);
    $foo = \$bar;
    $bar = \$foo;
}

In the example code above, $foo and $bar are having reference to the other.  When the function leak() finishes, the variables $foo and $bar will go out of the scope.   It will never be collected.  They won’t be destroyed and removed from memory as each one still has a reference leading to it.

The easiest way to prevent this issue is to use weak references. Weak references are references that we should use to access data, but do not count for garbage collection.

use Scalar::Util qw(weaken);

sub dont_leak {
    my ($foo, $bar);
    $foo = \$bar;
    $bar = \$foo;
    weaken $bar;
}

In dont_leak(), $foo has a reference count of 0, $bar has a ref count of 1. When we leave the scope of the subroutine, $foo is returned to the pool, and its reference to $bar is cleared. This drops the ref count on $bar to 0, which means that $bar can also return to the pool.

It can be done as follows:-

#!/usr/bin/perl -w
use strict;
use warnings;
my @arry=(18,96,117,336.9);
my %old_hash=(
    a   =>  {
        aa  =>  {
            aaa =>  "aaa_value",
            aab =>  "aab_value",
            aac =>  "aac_value",
            aad =>  "aad_value",
        },
        ab  =>  {
            aba =>  "aba_value",
            abb =>  "abb_value",
            abc =>  "abc_value",
            abd =>  "abd_value",
        },
        ac  =>  {
            aca =>  "aca_value",
            acb =>  "acb_value",
            acc =>  "acc_value"
        },
        ad  =>  \@arry
    },
    b   =>  {
        ba  =>  {
            baa =>  "baa_value",
            bab =>  "bab_value",
            bac =>  "bac_value",
            bad =>  "bad_value",
        },
        bb  =>  {
            bba =>  "bba_value",
            bbb =>  "bbb_value",
            bbc =>  "bbc_value",
            bbd =>  "bbd_value",
        },
        bc  =>  {
            bca =>  "bca_value",
            bcb =>  "bcb_value",
            bcc =>  "bcc_value"
        },
        db  =>  [5,8,69,99]
    }
);
my %hash=%old_hash;
my $thash=&process_hash(\%hash);
my %new_hash=%{$thash};
use Data::Dumper;
print "Original\n".Dumper(\%old_hash);
print qq{\n\n------------------------------------------------------------------------------\n\n};
print "Modified\n".Dumper(\%new_hash);
sub process_hash {
    my ($temp_hash)=@_;
    if(&is_hash($temp_hash)) {
        foreach my $key(keys %{$temp_hash}) {
            if(&is_hash($temp_hash->{$key})) {
                my %t=%{$temp_hash->{$key}};
                $temp_hash->{$key}=&process_hash(\%t);
            } elsif(&is_array($temp_hash->{$key})) {
                my @t=@{$temp_hash->{$key}};
                $temp_hash->{$key}=&process_hash(\@t);
            } else {
                if($temp_hash->{$key} && $temp_hash->{$key} ne '') {
                    $temp_hash->{$key}="--".$temp_hash->{$key}."--";
                }
            }
        }
    } elsif(&is_array($temp_hash)) {
        my $x=0;
        foreach my $values(@$temp_hash) {
            if(&is_array($values)) {
                my @t=@{$values};
                $temp_hash->[$x]=&process_hash(\@t);
            } elsif(&is_hash($values)) {
                my %t=%{$values};
                $temp_hash->[$x]=&process_hash(\%t);
            } else {
                $temp_hash->[$x]="--".$values."--";
            }
            $x++;
        }
    }
    return $temp_hash;
}
sub is_hash {
    my ($ref) = @_;
    return 0 unless ref $ref;
    if ( $ref =~ /^HASH/ ) {
        return 1;
    } else {
        return 0;
    }
}
sub is_array {
    my ($ref) = @_;
    return 0 unless ref $ref;
    eval {
        my $a = @$ref;
    };
    if ($@=~/^Not an ARRAY reference/) {
        return 0;
    } elsif ($@) {
        die "Unexpected error in eval: $@\n";
    } else {
        return 1;
    }
}

Output:-

Original
$VAR1 = {
          'a' => {
                   'ab' => {
                             'abb' => 'abb_value',
                             'abc' => 'abc_value',
                             'aba' => 'aba_value',
                             'abd' => 'abd_value'
                           },
                   'ad' => [
                             18,
                             96,
                             117,
                             '336.9'
                           ],
                   'ac' => {
                             'acb' => 'acb_value',
                             'aca' => 'aca_value',
                             'acc' => 'acc_value'
                           },
                   'aa' => {
                             'aaa' => 'aaa_value',
                             'aad' => 'aad_value',
                             'aac' => 'aac_value',
                             'aab' => 'aab_value'
                           }
                 },
          'b' => {
                   'db' => [
                             5,
                             8,
                             69,
                             99
                           ],
                   'ba' => {
                             'bad' => 'bad_value',
                             'baa' => 'baa_value',
                             'bab' => 'bab_value',
                             'bac' => 'bac_value'
                           },
                   'bb' => {
                             'bbc' => 'bbc_value',
                             'bbb' => 'bbb_value',
                             'bbd' => 'bbd_value',
                             'bba' => 'bba_value'
                           },
                   'bc' => {
                             'bcc' => 'bcc_value',
                             'bca' => 'bca_value',
                             'bcb' => 'bcb_value'
                           }
                 }
        };


------------------------------------------------------------------------------

Modified
$VAR1 = {
          'a' => {
                   'ab' => {
                             'abb' => '--abb_value--',
                             'abc' => '--abc_value--',
                             'aba' => '--aba_value--',
                             'abd' => '--abd_value--'
                           },
                   'ad' => [
                             '--18--',
                             '--96--',
                             '--117--',
                             '--336.9--'
                           ],
                   'ac' => {
                             'acb' => '--acb_value--',
                             'aca' => '--aca_value--',
                             'acc' => '--acc_value--'
                           },
                   'aa' => {
                             'aaa' => '--aaa_value--',
                             'aac' => '--aac_value--',
                             'aad' => '--aad_value--',
                             'aab' => '--aab_value--'
                           }
                 },
          'b' => {
                   'ba' => {
                             'baa' => '--baa_value--',
                             'bad' => '--bad_value--',
                             'bab' => '--bab_value--',
                             'bac' => '--bac_value--'
                           },
                   'db' => [
                             '--5--',
                             '--8--',
                             '--69--',
                             '--99--'
                           ],
                   'bb' => {
                             'bbb' => '--bbb_value--',
                             'bbc' => '--bbc_value--',
                             'bba' => '--bba_value--',
                             'bbd' => '--bbd_value--'
                           },
                   'bc' => {
                             'bcc' => '--bcc_value--',
                             'bca' => '--bca_value--',
                             'bcb' => '--bcb_value--'
                           }
                 }
        };

We can add or subtract ‘n’ number of days from current date in Perl using the most prominent date module POSIX. It can be done as follows.

#!/usr/bin/perl -w
use POSIX;
my $current_date=strftime "%m/%d/%Y", localtime; # let it be 02/17/2016
my $today = time;
my $lastweek = $today - 7 * 24 * 60 * 60; # current date - 7 days
my $lastweek_date=strftime "%m/%d/%Y", localtime($lastweek);
my $nextweek = $today + 7 * 24 * 60 * 60; # current date + 7 days
my $nextweek_date=strftime "%m/%d/%Y", localtime($nextweek);
print qq{Current Date = }.$current_date."\n";
print qq{Current Date - 7 Days = }.$lastweek_date."\n";
print qq{Current Date + 7 Days = }.$nextweek_date."\n";

Output :

Current Date =  02/17/2016
Current Date - 7 Days = 02/10/2016
Current Date + 7 Days = 02/24/2016

Perl has in-built function called sort that can sort contents in array . By default sort  function consider the content as string. That means comparing the first character in both strings. “1” to “3”. “1” is ahead of “3” in the ASCII table and thus the string “12” will come before the string “3”.

my @numbers = (14, 3, 12, 2, 23);
my @sorted_numbers = sort @numbers;
say Dumper \@sorted_numbers;

Output :-

$VAR1 = [
    12,
    14,
    2,
    23,
    3
];

Perl don’t understand automatically that you need a sorting based on numerical methods.

No problem though as we can write a comparison function that will compare the two values as numbers. For that we use the <=> (also called spaceship operator) that will compare its two parameters as numbers and return 1, -1 or 0.

my @sorted_numbers = sort { $a <=> $b } @numbers;

Output:-

$VAR1 = [
    2,
    3,
    12,
    14,
    23
];