Perl - Class::Struct Deferencing array - perl

use Class::Struct;
struct (TimingStruct => {
_timingSense => '$',
_timingType => '$',
_relatedPin => '$',
_whenCond => '$'
});
struct (OutPinStruct => {
_outPinName => '$',
_outFunction => '$',
_timingarray => '#', #_timingarc => 'TimingStruct'
});
my #tarray = ();
my $t;
$t = TimingStruct->new(_timingSense => 'Unate',
_timingType => 'Wave',
_relatedPin => 'CO',
_whenCond => 'A ^ B'
);
push(#tarray, $t);
$t = TimingStruct->new(_timingSense => 'Combinational',
_timingType => 'Rising',
_relatedPin => 'ICO',
_whenCond => 'A ^ B ^ CI'
);
push(#tarray, $t);
my $op = OutPinStruct->new(_outPinName => "CO",
_outFunction => "A ^ B ^ CI",
_timingarray => \#tarray);
print $op->_outPinName . "\n";
print $op->_outFunction . "\n";
print $op->_timingarray . "\n";
my $t = ${${$op->_timingarray}[0]}[0];
print "\$t = \$op->_timingarray = $t->_timingSense() \n";
my #t = {$op->_timingarray};
print "\#t = \#{\$op->_timingarray} = $$t[1] \n";
Every output pin can have many timing-arcs and the OutPinStruct has a array to hold the timing-arcs. I'm not sure about de-referencing arrays(_timingarray) could someone tell me what is it that I'm doing wrongly?
Thanks.

$op->_timingarray is a "list of hashes". In general the keys to a hash are unordered and you cannot lookup the hash values through a numbered index. The elements you can access are
$op->_timingarray->[0]{'TimingStruct::_whenCond'}
$op->_timingarray->[0]{'TimingStruct::_timingSense'}
$op->_timingarray->[0]{'TimingStruct::_relatedPin'}
$op->_timingarray->[0]{'TimingStruct::_timingType'}
$op->_timingarray->[1]{'TimingStruct::_whenCond'}
$op->_timingarray->[1]{'TimingStruct::_timingSense'}
$op->_timingarray->[1]{'TimingStruct::_relatedPin'}
$op->_timingarray->[1]{'TimingStruct::_timingType'}

Related

Iterating through an array of Class::Struct objects

I'm using the Class::Struct module
and have two structures, Cat and Kitten, Cat is a mother cat, and one of the attributes of Cat should be an array of Kitten objects. I'm having difficulty getting this right.
If I save the kittens array as an object I cannot iterate through it as expected; I just get an array with one element which appears to be an array. If I save it as a reference I can not figure out how to deference it correctly.
#!/usr/bin/perl
use strict;
use warnings;
use Class::Struct;
use Data::Dumper;
struct Cat => [
name => '$',
age => '$',
kittens => '$',
];
struct Kitten => [
name => '$',
age => '$',
];
my $lil_kitten = Kitten->new( name => 'Lil Socks', age => 2 );
my $big_kitten = Kitten->new( name => 'Big Socks', age => 3 );
my $old_kitten = Kitten->new( name => 'Old Socks', age => 4 );
my #kitten_array = ( $lil_kitten, $big_kitten, $old_kitten );
my $kitten_count = scalar #kitten_array;
print "There were $kitten_count kittens\n";
foreach my $k ( #kitten_array ) {
bless $k, 'Kitten';
print "Kitten: ", $k->name, " is ", $k->age, " years old.\n";
print Dumper($k), "\n";
}
my $cat = Cat->new( name => 'Socks' );
$cat->age(17);
#$cat->kittens(#kitten_array);
$cat->kittens(\#kitten_array);
my $ref_type = $cat->kittens;
print "Ref type: ", $ref_type, "\n\n\n\n";
#$kitten_count = scalar #$cat->kittens;
#print "There were $kitten_count kittens\n";
print "Once a cat called ", $cat->name, " who was ", $cat->age, "\n";
#foreach my $kat(#$cat->kittens) {
foreach my $kat($cat->kittens) {
bless $kat, 'Kitten';
print "Kitten: ", $kat->name, " is ", $kat->age, " years old.\n";
print Dumper($kat), "\n";
}
You should initialize 'kittens' to be an array (using '#') and use curly brackets for precedence in the dereference. I have flagged the changed lines with the comment # CHANGED.
#!/usr/bin/perl
use strict;
use warnings;
use Class::Struct;
use Data::Dumper;
struct Cat =>
[
name => '$',
age => '$',
kittens => '#', # CHANGED
];
struct Kitten =>
[
name => '$',
age => '$',
];
my $lil_kitten = Kitten->new( name => 'Lil Socks', age=> 2);
my $big_kitten = Kitten->new( name => 'Big Socks', age=> 3);
my $old_kitten = Kitten->new( name => 'Old Socks', age=> 4);
my #kitten_array = ($lil_kitten, $big_kitten, $old_kitten);
my $kitten_count = scalar #kitten_array;
print "There were $kitten_count kittens\n";
foreach my $k(#kitten_array) {
bless $k, 'Kitten';
print "Kitten: ", $k->name, " is ", $k->age, " years old.\n";
print Dumper($k), "\n";
}
my $cat = Cat->new( name => 'Socks');
$cat->age(17);
#$cat->kittens(#kitten_array);
$cat->kittens(\#kitten_array);
my $ref_type = $cat->kittens;
print "Ref type: ", $ref_type, "\n\n\n\n";
$kitten_count = scalar #{$cat->kittens}; # CHANGED
print "There were $kitten_count kittens\n";
print "Once a cat called ", $cat->name, " who was ", $cat->age, "\n";
#foreach my $kat(#$cat->kittens) {
foreach my $kat($cat->kittens) {
bless $kat, 'Kitten';
print "Kitten: ", $kat->name, " is ", $kat->age, " years old.\n";
print Dumper($kat), "\n";
}
The problem with #$cat->kittens is that it first dereferences $cat to become an array, then tries to call the method kittens() on that array. This involves Perl trying to interpret #$cat as a class name by turning it into a string - that is, scalar #$cat, which is the size of the array. You end up calling "3"->kittens().

perl: Print object property names and values

The following:
for my $z (#$y) {
# prints number of observables for a given activity summary
# print STDERR 'property count'.keys $z
print Dumper($z);
}
Prints:
$VAR1 = {
'activity' => 'walking',
'duration' => '591',
'calories' => 26,
'distance' => '435',
'steps' => 871,
'group' => 'walking'
};
$VAR1 = {
'steps' => 168,
'group' => 'walking',
'distance' => '100',
'activity' => 'walking',
'duration' => '200',
'calories' => 6
};
How can I iterate over each property and print its name and value? Im using perl.
Here's one way:
for my $z (#$y) {
for my $k (keys %$z) {
print "$k: $z->{$k}\n";
}
}
See perldoc -f keys for more information about keys; perldoc perldata for general information about hashes (because your $z values are hash references, not objects); perldoc perlreftut for references and nested data structures.
you can try this:
my $z = {
'activity' => 'walking',
'duration' => '591',
'calories' => 26,
'distance' => '435',
'steps' => 871,
'group' => 'walking'
};
while((my $key, my $value) = each (%{$z})){
print "key : $key -> value : $value\n";
}

order hash perl using another array

Im trying to sort a Hash using a list/array
my $hash = { cta => '01340031810312074443',
ttr => '001',fil => '0000',
ref => '0000',
mef => '0000000000000060000',
mch => '0000000000000000000',
nli => '00000000',
tdi => 'V',
ndi => '006126952',
tdip => 'V',
ndip => '006126952',
};
#order = qw(cta ttr fil ref mef mch nli tdi ndi tdip ndip);
We know Perl dont save orders in hash but I need to print in that order. How can I do that?
Thanks
If you just want to print the values and not the keys, you can also use a hash slice:
use feature 'say';
say join "\t", #hash{#order};
for my $key (#order) {
print $key . ": " . $hash->{$key} . "\n";
}
Try this:
for (#order) {
print $_, " => ", $hash->{$_}, "\n";
}

Deleting Key from 2D Hash in Perl

My Hash looks like this
%hIDSet = (
'TSASD2' => {
'country' => 'US',
'newid' => 'IMRAN',
'oldid' => 'TSASD4'
}
'TS767' => {
'country' => 'DE',
'newid' => 'B90LKT',
'oldid' => '432553'
},
);
when I do
my $sID = "TSASD2";
delete $hIDSet{$sID};
The output I get is
%hIDSet = (
'TSASD2' => {},
'TS767' => {
'country' => 'DE',
'newid' => 'B90LKT',
'oldid' => '432553'
},
);
My question is why the ID is not deleted completely?
You did delete the key, so you must have recreated it before dumping the hash again as in the following snippet:
my $sID = "TSASD2";
my %hIDSet = ( $sID => {} );
delete $hIDSet{$sID};
print(Dumper(\%hIDSet)); # It's gone
if ($hIDSet{$sID}{foo}) { '...' }
print(Dumper(\%hIDSet)); # You've recreated it.
Keep in mind that
$hIDSet{$sID}{foo}
is short for
$hIDSet{$sID}->{foo}
and that
EXPR->{foo}
means
( EXPR //= {} )->{foo}
so
$hIDSet{$sID}{foo}
means
( $hIDSet{$sID} //= {} )->{foo}
Note that this can assign to $hIDSet{$sID}.
Cannot reproduce.
You are confusing the syntax for Perl hashes, and hashref literals. This signifies a hashref:
use Data::Dumper;
my $hashref = {
foo => 'bar', # ← note comma between items
baz => 'qux',
};
delete $hashref->{foo};
print Dumper $hashref;
# $VAR1 = { baz => "qux" };
On the other hand, hashes are just lists:
use Data::Dumper;
my %hash = ( # note parens
foo => 'bar',
baz => 'qux',
);
delete $hash{foo};
print Dumper \%hash;
# $VAR1 = { baz => "qux" };
The code your provided shouldn't compile because of a missing comma, and would fail to run with use strict; use warnings; because of the hash–hashref mismatch. Clean up the types, and it should work allright.

How to manually specify the column names using DBD::CSV?

I am using DBD::CSV to show csv data. Sometimes the file doesn't contain column names, so we have to manually define it. But after I followed the documentation, I got stuck with how to make the attribute skip_first_row work. The code I have is:
#! perl
use strict;
use warnings;
use DBI;
my $dbh = DBI->connect("dbi:CSV:", undef, undef, {
f_dir => ".",
f_ext => ".txt/r",
f_lock => 2,
csv_eol => "\n",
csv_sep_char => "|",
csv_quote_char => '"',
csv_escape_char => '"',
csv_class => "Text::CSV_XS",
csv_null => 1,
csv_tables => {
info => {
file => "countries.txt"
}
},
FetchHashKeyName => "NAME_lc",
}) or die $DBI::errstr;
$dbh->{csv_tables}->{countries} = {
skip_first_row => 0,
col_names => ["a","b","c","d"],
};
my $sth = $dbh->prepare ("select * from countries limit 1");
$sth->execute;
while (my #row = $sth->fetchrow_array) {
print join " ", #row;
print "\n"
}
print join " ", #{$sth->{NAME}};
The countries.txt file is like this:
AF|Afghanistan|A|Asia
AX|"Aland Islands"|E|Europe
AL|Albania|E|Europe
But when I ran this script, it returns
AX Aland Islands E Europe
AF AFGHANISTAN A ASIA
I expected it to either return:
AF AFGHANISTAN A ASIA
a b c d
or
a b c d
a b c d
Does any know what's going on here?
For some reason, contrary to the documentation, it doesn't see the per-table settings unless you pass them to connect.
my $dbh = DBI->connect("dbi:CSV:", undef, undef, {
f_dir => ".",
f_ext => ".txt/r",
f_lock => 2,
csv_eol => "\n",
csv_sep_char => "|",
csv_quote_char => '"',
csv_escape_char => '"',
csv_class => "Text::CSV_XS",
csv_null => 1,
csv_tables => {
countries => {
col_names => [qw( a b c d )],
}
},
FetchHashKeyName => "NAME_lc",
}) or die $DBI::errstr;
Then it works fine:
my $sth = $dbh->prepare ("select * from countries limit 1");
$sth->execute;
print "#{ $sth->{NAME} }\n"; # a b c d
while (my $row = $sth->fetch) {
print "#$row\n"; # AF Afghanistan A Asia
}