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 threeCircular 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.
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;
}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
You must be logged in to post a comment.