Remove duplicate value from an array in perl

Remove duplicate value from an array in perl

 

#!/usr/bin/perl -w
use strict;
use warnings;
sub unique {
    my %seen;
    grep !$seen{$_}++, @_;
}

my @array = qw(one two three two three);
my @filtered = unique(@array);

print @filtered . "\n";

Output:-

one two three

Circular References In Perl Memory Leaks

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.

How to submit a form to a new window in post method using javascript?

To submit a form to a new window in post method,

HTML

<form name="form_message_center_popup" id="form_message_center_popup" method="post" action="/folder/file.ext">
    <input type="text" name="user_name" id="user_name" value="abc"/>
    <input type="text" name="clientid" id="clientid" value="efg"/>
    <input type="button" onclick="form_submiter()" value="submit"/>
</form>

JavaScript

function customer_support_msg() {
    var customer_support = window.open("about:blank", "_form", "location=no, menubar=no, toolbar=no, fullscreen=yes, scrollbars=yes, resizable=yes, width=800, height=600, replace=true");
    document.forms["form_message_center_popup"].target='_form';
    document.forms["form_message_center_popup"].submit();
    return false;
}

Program to iterate through hash and / or array in perl.

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--'
                           }
                 }
        };

How to add or subtract ‘n’ number of days from current date in Perl?

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