Another simple Perl question...(hash to an array of objects) - arrays

I'm working on creating a Graph class in Perl and I'm hoping to have each Graph contain Nodes. Each Node has some properties and also (for now) an array which contains references to each other node it is connected to. So far I have this definition of a node:
use strict;
package Node;
sub new{
my $class = shift;
my #array = ();
my $array_r = \#array;
my $self = {
code => undef,
name => undef,
country => undef,
continent => undef,
timezone => undef,
coordinates => undef
population => undef,
region => undef,
arrayRef => $array_r,
#_,
};
bless $self, $class;
return $self;
}
Yet upon calling the following function from my main script:
sub getSetArray{
my $self = shift;
my $param = shift;
my $temp = $self->{arrayRef};
push(#{$temp}, $param) if defined $param;
return $self->{arrayRef};
}
and trying to iterate over a Node's array(which will contain more Nodes that it is connected to):
my $firstnode = Node->new(); # Node constructor should have #array of
my $secondnode = Node->new();
$firstnode->getSetCode("test");
print "The current code is ", $firstnode->getSetCode(), "\n";
my $array_r = $firstnode->getSetArray($secondnode);
$array_r = $firstnode->getSetArray($firstnode);
foreach my $obj (#{$array_r}){
print $obj;
}
This prints out Node=HASH(0x10092bb00)Node=HASH(0x100907bd8). Which leads me to believe that I am dealing with an array containing 2 nodes (this is what I want). But upon attempting to call any methods of this $obj's I am told that I
Can't call method "getSetNode" without a package or object reference.
I had already previously blessed these two objects when calling new on these nodes. So I'm not sure why they aren't recognized as Nodes and I can't call their methods....
EDIT -
foreach my $obj (#{$array_r}){
print $obj->getSetCode();
}
where getSetCode() is
sub getSetCode{
my $self = shift;
my $param = shift;
$self->{code} = $param if defined $param;
return $self->{code};
}

Show how you are trying to call getSetNode on $obj, and the code of getSetNode?
By the way, $temp isn't needed; you can directly do:
push #{ $self->{arrayRef} }, $param if defined $param;
Maybe helpful to you: http://perlmonks.org/?node=References+quick+reference
Also note that you are setting up a cyclical data structure ($firstnode indirectly referencing itself) that perl won't garbage collect automatically, even when all external references go away; you can fix this (if this is even a concern) with:
if (defined $param) {
push #{ $self->{arrayRef} }, $param;
Scalar::Util::weaken( $self->{arrayRef}[-1] ) if $param == $self;
}
As far as your problem goes, putting all your code together (and adding a missing , on the coordinates line) into this:
use warnings;
use strict;
package Node;
sub new {
my $class = shift;
my #array = ();
my $array_r = \#array;
my $self = {
code => undef,
name => undef,
country => undef,
continent => undef,
timezone => undef,
coordinates => undef,
population => undef,
region => undef,
arrayRef => $array_r,
#_,
};
bless $self, $class;
return $self;
}
sub getSetArray{
my $self = shift;
my $param = shift;
my $temp = $self->{arrayRef};
push(#{$temp}, $param) if defined $param;
return $self->{arrayRef};
}
sub getSetCode{
my $self = shift;
my $param = shift;
$self->{code} = $param if defined $param;
return $self->{code};
}
my $firstnode = Node->new(); # Node constructor should have #array of
my $secondnode = Node->new();
$secondnode->getSetCode("test2");
$firstnode->getSetCode("test");
print "The current code is ", $firstnode->getSetCode(), "\n";
my $array_r = $firstnode->getSetArray($secondnode);
$array_r = $firstnode->getSetArray($firstnode);
foreach my $obj (#{$array_r}){
print $obj->getSetCode(), "\n";
}
gives this output for me:
The current code is test
test2
test

Related

How to iterate through an Array of hashes in Perl?

I have the following array:
ifNameList -> $VAR1 = [
{
'VALUE' => ' gpon_olt-1/1/1',
'ASN1' => '285278465'
},
{
'VALUE' => ' gpon_olt-1/1/2',
'ASN1' => '285278466'
},
{
'VALUE' => ' gpon_olt-1/1/3',
'ASN1' => '285278467'
},
{
'VALUE' => ' gpon_olt-1/1/4',
'ASN1' => '285278468'
},
{
'VALUE' => ' gpon_olt-1/1/5',
'ASN1' => '285278469'
},
]
I need to iterate through this array of hashes comparing the "VALUE" field of each hash, until it matches and do some action.
I've already made the following code, but its not working. What I'm doing wrong?
sub GetIfIndexFromName{
my $ifName = shift;
my #ifList = shift;
my $index;
for (#ifList){
my %interfaceHash = %$_;
# Just trims any blank space on the string:
$interfaceHash->{"VALUE"} =~ s/^\s+|\s+$//g;
if($interfaceHash->{"VALUE"} eq $ifName){
print "trimmed interface name-> ".$interfaceHash->{"VALUE"}."\n\n";
$index = $interfaceHash->{"ASN1"};
}
}
print "Returning index value: ".$index;
return $index;
}
Two errors.
Problem 1: Wrong variable
ALWAYS use use strict; use warnings;. It would have found this error:
# Access the `VALUE` element of the hash referenced by `$interfaceHash`.
$interfaceHash->{"VALUE"}
You have no variable named $interfaceHash.
There are three ways to fix this:
for ( #ifList ) {
my %interfaceHash = %$_;
... $interfaceHash{ VALUE } ...
}
for my $interfaceHash ( #ifList ) {
... $interfaceHash->{ VALUE } ...
}
The latter is recommended. It avoids creating a copy of the hash, which involves create a number of temporary scalars. This is all useless work.
Problem 2: Incorrect parameter retrieval
The following is wrong:
my #ifList = shift;
shift returns a scalar. There's absolutely no point in using an array to hold exactly one scalar at all times.
sub GetIfIndexFromName {
my $ifName = shift;
my $ifList = shift;
for ( #$ifList ) {
...
}
}
# Pass a reference to the array.
GetIfIndexFromName( $ifName, $VAR1 )
sub GetIfIndexFromName {
my $ifName = shift;
my #ifList = #_;
for ( #ifList ) {
...
}
}
# Pass each element of the array.
GetIfIndexFromName( $ifName, #$VAR1 )
The former convention is more efficient, but the latter can create cleaner code in the caller. Probably not in your program, though.
How I'd write this:
use strict;
use warnings;
use feature qw( say );
use List::Util qw( first );
sub trim_inplace { $_[0] =~ s/^\s+|\s+\z//g; }
my #ifList = ...;
my $ifName = ...;
trim_inplace( $_->{ VALUE } ) for #ifList;
my $match = first { $_->{ VALUE } eq $ifName } #ifList
or die( "Interface not found.\n" );
my $asn1 = $match->{ ASN1 };
say $asn1;

perl array not populating, despite hours of tinkering

Um...I have the following code snippet, and was wondering why the second subroutine, search($$) fails to yield results...while the first routine, search_item($$$), performs admirably (imo).
########################
# generate and return a list of users which match only
# one criteria (eg: eyes=2)
#
# $users is a reference to an array of 6-digit hexidecimal user IDs (eg: 000001, 000002, etc)
# $name is the name of the key (or field) to find (eg: 'eyes')
# $value (eg: 2) is compared with the value stored in the key
# if $value matches what's in the $name'd key, then add the uid to a list
sub search_item($$$) {
my ($users, $name, $value) = #_;
my #searched;
foreach my $uid (#$users) {
my %ustats = user::getUserStats($uid);
if ($ustats{$name} eq $value) { push #searched, $uid; }
}
return #searched;
}
########################
# generate and return a list of users which match
# many criteria (eg: eyes=2, hair=1, etc)
#
# $users is a reference to an array of user IDs (eg: 000001, 000002, etc)
# $terms is a reference to an array of search terms (eg: $terms[0] = "eyes=2";)
sub search($$) {
my $users = $_[0]; # an array reference
my $terms = $_[1]; # an array reference
my #searched;
my $first = 1;
foreach my $term (#$terms) {
# since #$terms is an array of scalars, in the format of 'name=value' pairs
my $name = $term; $name =~ s/=(.)*//;
my $value = $term; $value =~ s/$name=//;
if ($first) {
# search the given list reference ($users)
#searched = search_item($users, $name, $value);
$first = 0; # set to 0 cause now we gotta use #searched
} else {
# otherwise use a reference to #searched
#searched = search_item(\#searched, $name, $value);
}
}
return #searched;
}
i have setup the data so the code should return 1 hit. the data is correct and underlying functions (eg: getUserStats($)) also perform flawlessly.
both user 000001 and 969696 have eyes=2 all others eyes=1 and
user ID 000001 is gender=1, all others gender=0
so...if i write:
my #users = getUsers();
foreach my $uid (search_item(\#users, 'eyes', 2)) {
print "$uid<br>\n";
}
i get 2 hits of a total of 6 users in my database (this IS a correct result, of course). satisfied with those results, I run the search routine.
my #terms = ('eyes=2', 'gender=1'); # gender=0 is a boy. 1 is a girl
my #sResults = search(\#users, \#terms);
if (#sResults) {
foreach my $uid (#sResults) {
print "$uid<br>\n";
}
} else {
print "nothing found!<br>\n";
}
i always see "nothing found!" when i pray and hope to see "000001" instead... :(
this seems like legit code....so....whud am i doin wrong guys??? am i not derefencing something correctly? or...is the dereferencing / referencing the source of my dilema? i loath pointers...however incredibly useful :p
Your code does actually work if you pass correct parameters. My best guess is that the strings like eyes=2 that you're using contain spurious whitespace such as a trailing newline
Here's the test program that I used to work on your subrouitines
use strict;
use warnings;
use 5.010;
my %users = (
'000001' => { eyes => 2, gender => 1 },
'000002' => { eyes => 1, gender => 0 },
'000003' => { eyes => 1, gender => 0 },
'000004' => { eyes => 1, gender => 0 },
'969696' => { eyes => 2, gender => 0 },
);
sub user::getUserStats {
my ( $uid ) = #_;
%{ $users{$uid} };
}
########################
# generate and return a list of users which match only
# one criteria (eg: eyes=2)
#
# $users is a reference to an array of 6-digit hexidecimal user IDs (eg: 000001, 000002, etc)
# $name is the name of the key (or field) to find (eg: 'eyes')
# $value (eg: 2) is compared with the value stored in the key
# if $value matches what's in the $name'd key, then add the uid to a list
sub search_item($$$) {
my ( $users, $name, $value ) = #_;
my #searched;
foreach my $uid ( #$users ) {
my %ustats = user::getUserStats( $uid );
if ( $ustats{$name} eq $value ) { push #searched, $uid; }
}
return #searched;
}
########################
# generate and return a list of users which match
# many criteria (eg: eyes=2, hair=1, etc)
#
# $users is a reference to an array of user IDs (eg: 000001, 000002, etc)
# $terms is a reference to an array of search terms (eg: $terms[0] = "eyes=2";)
sub search($$) {
my $users = $_[0]; # an array reference
my $terms = $_[1]; # an array reference
my #searched;
my $first = 1;
foreach my $term ( #$terms ) {
# since #$terms is an array of scalars, in the format of 'name=value' pairs
my $name = $term;
$name =~ s/=(.)*//;
my $value = $term;
$value =~ s/$name=//;
if ( $first ) {
# search the given list reference ($users)
#searched = search_item( $users, $name, $value );
$first = 0; # set to 0 cause now we gotta use #searched
}
else {
# otherwise use a reference to #searched
#searched = search_item( \#searched, $name, $value );
}
}
return #searched;
}
my $users = [ keys %users ];
say for search( $users, [ 'eyes=2', 'gender=1' ] );
output
000001
Here's how I would write similar subroutines that behave identically and take the same parameters, but there is a lot in the design of this application that is less that optimal
sub search_item {
my ( $users, $name, $value ) = #_;
grep {
my %ustats = user::getUserStats( $_ );
$ustats{$name} eq $value;
} #$users;
}
sub search {
my ($users, $terms) = #_;
my #searched;
for my $term ( #$terms ) {
my ($name, $value) = split /=/, $term;
#searched = search_item( $users, $name, $value );
$users = \#searched;
}
#searched;
}
but I think user::getUserStats should be called User::get_user_stats (because Perl reserves capital letters for global identifiers such as package names) and it should return a reference to a hash instead of just a list

Optionally return either an array or a hash from a subroutine?

How can I return either a hash or an array from a subroutine, depending on what the user wants?
Basically I want a subroutine that when asked to return a hash it will return a hash, but when asked to return an array it will return an array containing what would be the keys of that hash.
ex:
my %hash = foo();
my #array = foo(); # #array contains "keys %hash"
# pseudo code
sub foo {
# Define a hash
my %hash = (
'key1' => 'val1',
'key2' => 'val2',
'key3' => 'val3',
);
# I know this is not valid Perl code, but it represents what I want.
return keys %hash if wantarray;
return %hash if wanthash;
}
I know you can use wantarray to determine whether you want an array or a scalar to be returned, but I need a similar functionality for optionally returning an array or a hash.
Your subroutine may return array or reference to hash.
my #array = foo(); # #array contains "keys %hash"
my $hash_reference = foo();
print $array[0],"\n"; # keys returned by foo are in random order
print $hash_reference->{key1},"\n";
# sample code
sub foo {
# Define a hash
my %hash = (
'key1' => 'val1',
'key2' => 'val2',
'key3' => 'val3',
);
if( wantarray) {
return keys %hash;
}else{
return \%hash
}
}
Just add a parameter so that if it's passed in, it returns keys:
sub foo {
my $want_keys = shift;
my %hash = (a => 1, b => 2, c => 3, );
return keys %hash if $want_keys;
return %hash;
}
my %hash = foo();
my #keys = foo(1); # or foo('keys');
The only other way to do this is a hash is returned if a list is wanted, otherwise an array reference of the keys, which means the caller will have to dereference afterwards:
sub foo {
my %hash = (a=>1, b=>2);
return %hash if wantarray;
return [keys %hash];
}
my $keys = foo();
my %hash = foo();

Generating a unordered list hash from a array

I am trying to use hashes to generate an unordered list that i can further use in a jstree. But this array has to be generated only from an array that has been passed thru .
my #array = ( "New Order","Recurring Order","Previously Cancelled Order");
I want the output to look something like
$data = {
"New Order" => {
"Recurring Order" =>{
Previously cancelled Order = 1
}
}
};
I can simply do
my $data{$array[0]}{$array[1]}{$array[2]} = 1
but the array can be of n variables, so it becomes a bit more complicated than that. I am thinking of recursion, but i have been sitting here for the last hour trying to figure that out
This will generate the data structure as you have defined it. Not sure why you'd want it though.
my #input = ( "New Order","Recurring Order","Previously Cancelled Order");
my $data = 1;
$data = {$_ => $data} for reverse #input;
use Data::Dump;
dd $data;
If you're just wanting to randomize your array, then use List::Util;
use List::Util qw(shuffle);
my #newOrder = shuffle #input;
sub recursive {
my $v = shift #_;
return #_>1 ? { $v => recursive(#_) } : { $v => #_ };
}
my #array = ( "New Order","Recurring Order","Previously Cancelled Order");
use Data::Dumper; print Dumper recursive(#array, 1);
output
$VAR1 = {
'New Order' => {
'Recurring Order' => {
'Previously Cancelled Order' => 1
}
}
};

Dynamical array as a class member

There is a following class:
package MyClass;
use strict;
use warnings;
sub new
{
my $class = shift();
my $self = {
_class_array => []
};
bless ($self, $class);
return $self;
}
How can I set/get add values to this array?
I tried the following code:
sub AddDataType
{
my $self = shift();
my $new_element = shift();
my #array = $self->{_class_array};
print("Number of elements ".($self->{_class_array})."\n");
push(#array, $new_element);
$self->{_class_array} = #array;
print("Element added. Number of elements ".($self->{_class_array})."\n");
}
The output is the following:
Number of elements ARRAY(0x21bb4c)
Element added. Number of types 2
Number of elements 2
Element added. Number of types 2
Number of elements 2
Element added. Number of types 2
Questions are:
What does that mean: Number of elements ARRAY(0x21bb4c)?
Why array length always stays 2?
You are using an arrayref as an array. Try:
sub AddDataType {
my ( $self, $new_element ) = #_;
print "Number of elements " . scalar #{ $self->{_class_array} } . "\n";
push #{ $self->{_class_array} }, $new_element;
print "Element added. Number of elements " . scalar #{ $self->{_class_array} } . "\n";
return;
}
As others have noted, your array class element is an array reference. Your method should look like this
sub AddDataType {
my ($self, $new_element) = #_;
my $array = $self->{_class_array};
print "Number of elements " . scalar #$array . "\n";
push #$array, $new_element;
print "Element added. Number of elements " . scalar #$array . "\n";
}
You got good answers already. I just want to mention that Moose traits can really make this kind of attribute stuff simple/fun.
BEGIN {
package MyClass;
use Moose;
has "data" =>
traits => ["Array"],
is => "ro",
isa => "ArrayRef[Str]",
default => sub { [] },
handles => {
AddDataType => "push",
DataCount => "count",
NoData => "is_empty",
AllData => "elements",
};
}
my $thingy = MyClass->new();
print "DOES HAS DATAS? ", $thingy->NoData ? "NOE" : "YES", $/;
$thingy->AddDataType("OHAI");
print "CAN HAS DATA? ", $thingy->NoData ? "NOE" : "YES", $/;
$thingy->AddDataType(qw/ ANUDDER CUPLA HERE / );
print "I HAZ DATAS: ", $thingy->DataCount, $/;
print "HERE DEY IS: ", join(", ", $thingy->AllData), $/;
__DATA__
DOES HAS DATAS? NOE
CAN HAS DATA? YES
I HAZ DATAS: 4
HERE DEY IS: OHAI, ANUDDER, CUPLA, HERE

Resources