how to store and retrieve perl objects - perl

Problem : I want to have a list of objects stored so that i can call the corresponding methods at latter point in time
my #tc = ("TC_1","TC_2");
my %obj_list = ();
foreach my $test (#tc) {
$obj_list{$test} = Test->new($test);
}
In the same module file at latter stage where i need to call the corresponding methods of those objects
foreach my $test (keys %obj_list) {
if (some specific condition is satisfied for a test) {
1 --> $obj_list->$test->action();
2 --> $obj_list{$test}->action();
}
}
I tried 1 and 2 and they are not working. Could some one tell me what i could be doing wrong here.Any inputs would be of great help.

Your code is basically correct - other than a few syntax errors.
# Use ( ... ) to initialise an array.
my #tc = ("TC_1","TC_2");
my %obj_list = ();
foreach my $test (#tc) {
$obj_list{$test} = Test->new($test);
}
foreach (keys %obj_list) {
if (some specific condition is satisfied for a test) {
# This version is incorrect
# $obj_list->$key->action();
# This version will work, except you have the
# key in $_, not $key.
$obj_list{$_}->action();
}
}
Adding use strict and use warnings to your code would have helped you find some of these problems.

Related

How to compare two perl object values?

I need to compare two Perl object values, one is from a variable and another one is from an array value
ImmediateParent and data contain path directive values(C:\Users\Public\Documents)
while (length(basename(dirname(($immediateParent)))) > 1)
{
$immediateParent = (dirname(($immediateParent)));
my ($dictionaryitem) = $';
my $boolean =0;
foreach $dictionaryitem (#data)
{
if ($immediateParent eq $dictionaryitem->[0])
{
$boolean = 1;
last;
}
}
if ($boolean)
{
last;
}
}
I attempted to compare the values of two paths directories, but the condition always returned true, so it was ineffective. Would you kindly advise me on how to compare two path values?
If Data::Dumper shows
$immediateParent = 'C:\\Users\\Public';
$dictionaryitem = 'C:\\Users\\Public';
then you should compare them directly without array dereference, i.e. remove the ->[0]:
if ($immediateParent eq $dictionaryitem)
The fact that Perl let you dereference a string is weird. Are you not using strict?

how to combine two next if together

I have a script that run on the list of files to do some of the changes, each file of them has a call event and the call event details contains 4 elements so i just want to do the changes on 2 of them only here I'm stuck with how to combine two next if in one loop, here I have used 2 loops to do the job but it takes more time , is there any idea about how to do that ?
my $calleventtag = $struct->{'transferBatch'}->{'callEventDetails'};
my #indexes = reverse (grep { exists $calleventtag->[$_]->{'supplServiceEvent'} } 0..$#$calleventtag);
my $sup_event_cnt = $#indexes;
foreach my $index (#indexes)
{
splice (#$calleventtag , $index,1);
}
foreach (0..$#$calleventtag)
{
next if ( ! exists $calleventtag->[$_]->{'mobileOriginatedCall'}) ;
if ( exists $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'destinationNetwork'} )
{
delete $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'destinationNetwork'};
}
if ( exists $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'chargeableSubscriber'}->{'simChargeableSubscriber'}->{'msisdn'}
&& $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'chargeableSubscriber'}->{'simChargeableSubscriber'}->{'msisdn'} !~ m/^96279/
)
{
delete $calleventtag->[$_]->{'mobileOriginatedCall'}->{'basicCallInformation'}->{'chargeableSubscriber'}->{'simChargeableSubscriber'}->{'msisdn'};
}
}
foreach (0..$#$calleventtag)
{
next if ( ! exists $calleventtag->[$_]->{'gprsCall'});
if ( exists $calleventtag->[$_]->{'gprsCall'}->{'gprsBasicCallInformation'}->{'gprsDestination'}->{'accessPointNameOI'} )
{
delete $calleventtag->[$_]->{'gprsCall'}->{'gprsBasicCallInformation'}->{'gprsDestination'}->{'accessPointNameOI'};
}
}
for (...) {
next if ...;
...
}
can also be written as
for (...) {
if (!...) {
...
}
}
You could use the following:
use Data::Diver qw( Dive );
my $call_event_details = Dive($struct, qw( transferBatch callEventDetails ));
for my $call_event_detail (#$call_event_details) {
next if !$call_event_detail->{supplServiceEvent};
if ( my $bci = Dive($call_event_detail, qw( mobileOriginatedCall basicCallInformation )) ) {
delete $bci->{destinationNetwork};
if ( my $scs = $bci->{simChargeableSubscriber} ) {
my $msisdc = $scs->{msisdn};
delete $scs->{msisdn} if $msisdc && $msisdc !~ /^96279/;
}
}
if ( my $dest = Dive($call_event_detail, qw( gprsCall gprsBasicCallInformation gprsDestination )) ) {
delete $dest->{accessPointNameOI};
}
}
Notes:
The quotes around string literals aren't needed in hash indexes if the string is valid valid identifier. For example, $hash->{'foo'} can be written as $hash->{foo}.
-> isn't needed between two indexes. For example, $hash->{foo}->{bar} can be written as $hash->{foo}{bar}.
If a hash element is either a reference or doesn't exist, you don't need to use exists to check if you have a reference; you can use a simple truth test since references are always true.
[BUG FIX] $hash->{foo}{bar} can autovivify $hash->{foo} (cause a reference to be assigned to it), so your tests to check if stuff exists could actually be causing things to be created. To fix this, you can replace
if ($hash->{foo}{bar})
with
if ($hash->{foo} && $hash->{foo}{bar})
or
if (Dive($hash, qw( foo bar )))
Using the same long chain of indexes (->{foo}{bar}{baz}) repeatedly is error prone.
It's best to use plural names for arrays. First, it's more descriptive, but it also makes choosing names for loop variables easier.
Speaking of variable names, why would use $calleventtag for the name of the variable containing callEventDetails nodes?
You don't need to check if a hash element exists before trying to delete it; delete can be passed an element that doesn't exist.
No need to loop over the indexes of an array if you don't need the indexes.
grep was a good choice, but splice was not. You should have used: $calleventtag = [ grep { ... } #$calleventtag ];. I moved the check into the loop.

Iterating the results returned from fetchall_arrayref

I have a sql wherein I am fetching few records, sorted by full name.
My requirement is to extract chunks of similar names and then do some operation on it.
Say, the sql returns some records containing names like [name1,name1,name2,name3,name3]
I need to split them to [name1,name1] , [name2] , [name3,name3]
I am able to do it, but I am not happy with my implementation as I have to call doSomethingWithNames()twice.
while (my $paRecs = $pStatementHandle->fetchall_arrayref({}, 3)){
foreach my $phRec(#{$paRecs}){
my $pCurrentName = $phRec->{'FULL_NAME'};
if ((scalar(#aParentRecords) eq 0) or ($aParentRecords[-1] eq $pCurrentName)){
push(#aParentRecords, $pCurrentName);
} else {
doSomethingWithNames(\#aParentRecords);
#aParentRecords= ();
push(#aParentRecords, $pCurrentName);
}
}
};
doSomethingWithNames(\#aParentRecords); # This should be inside while loop
I believe am running into this issue because while doesn't go into the loop for
the last iteration as fetch* returns undef.
Sounds basic PERL stuff, but tried many loop constructs with no luck.
Any pointer will be a great help
The trick is to postpone existing the loop by converting it into an infinite loop. This requires checking the loop-terminating condition (!$rows) twice, though.
my $rows = [];
my $prev_name = '';
my #group;
while (1) {
$rows = $sth->fetchall_arrayref({}, 3) if !#$rows;
if (!$rows || $rows->[0]->{FULL_NAME} ne $prev_name)
if (#group) {
do_something(\#group);
#group = ();
}
last if !$rows;
}
$prev_name = $rows->[0]->{FULL_NAME};
push #group, shift(#$rows);
}

Perl return list of array refs of unknown length

I have a sub in Perl that needs to return a list of array refs to fit in with the rest of the package. The problem is that I don't know in advance how many array refs I will generate. My usual method of pushing the array refs that I generate into an array and returning a reference to that doesn't work with the rest of the code, which I can't change without breaking some legacy stuff.
sub subTrackTable {
my ($self, $experimentName, $subTrackAttr) = #_;
# return nothing if no subtracks required
if ($subTrackAttr eq 'no_sub') {
return;
}
# get distinct values for subtrack attr (eg antibody) from db
my $dbh = $self->dbh();
my $sh = $dbh->prepare("SELECT DISTINCT * blah sql");
$sh->execute();
my #subtrackTable;
while (my ($term, $value) = $sh->fetchrow_array()) {
my $subtrack = [':$value', $value];
push (#subtrackTable, $subtrack);
}
$sh->finish();
# this is hard-coded for one experiment and does what I want
# Want to loop through #subtrackTable and return a list of all the array refs it contains
# Returning nested array refs doesn't work with external code
return ([":H3K4me3", "H3K4me3"],[":H4K20me3", "H4K20me3"]);
}
The problem is that because I am dynamically getting values from a database, I don't know how many there will be. Just returning \#subtrackTable, which would be my usual strategy breaks the rest of the code. If I knew in advance how many there would be I could also do something like
my $a1 = [":$value1", $value1];
my $a2 = [":$value2", $value2];
...
my $an = [":$valuen", $valuen];
return($a1, $a2,...$an);
but I can't see how to make this work with an unknown number of arrayrefs.
Help appreciated!
It looks like you just need to
return #subtrackTable;
Also, this line
my $subtrack = [':$value', $value];
must be changed to use double quotes, like this
my $subtrack = [ ":$value", $value ];

how to copy(insert) hash reference to another hash reference in perl?

recently started doing perl. I'm reading old code and trying to rewrite some stuff. I've got a question here about hash references.
#declar anon hash ref that will be returned
my $store_hash = {};
foreach my $item (#list)
{
#this will iterate based on list
my $ret_hash = ops_getval($item, $user)
#do some magic here to map $ret_hash into $store_hash
}
ops_getval is a function that returns a type of ref hash. I want to insert those values into $store_hash. How should I approach this? Can I directly do
$store_hash = ops_getval($var1,$var2)
Much appreciated!
I think the standard way to do this is:
#$store_hash{ keys %$ret_hash } = values %$ret_hash;
This merges all of the hashes returned by all of the calls to ops_getval into $store_hash.
An alternate approach that might be clearer to the eye, possibly at the cost of a lot of redundant data copying:
%$store_hash = (%$store_hash, %$ret_hash);
You would do something like:
$store_hash->{$item} = $ret_hash
In general:
$hashref->{$key} = $value
See here for more: http://perldoc.perl.org/perlref.html#Using-References
To be clear, you can use a loop and get this done.
foreach ( keys%{ $ret_hash } ){
$store_hash->{ $_ } = $ret_hash->{ $_ } ;
}