In Perl, can refer to an array using its name? - perl

I'm new to Perl and I understand you can call functions by name, like this:
&$functionName();. However, I'd like to use an array by name. Is this possible?
Long code:
sub print_species_names {
my $species = shift(#_);
my #cats = ("Jeffry", "Owen");
my #dogs = ("Duke", "Lassie");
switch ($species) {
case "cats" {
foreach (#cats) {
print $_ . "\n";
}
}
case "dogs" {
foreach (#dogs) {
print $_ . "\n";
}
}
}
}
Seeking shorter code similar to this:
sub print_species_names {
my $species = shift(#_);
my #cats = ("Jeffry", "Owen");
my #dogs = ("Duke", "Lassie");
foreach (#<$species>) {
print $_ . "\n";
}
}

Possible? Yes. Recommended? No. In general, using symbolic references is bad practice. Instead, use a hash to hold your arrays. That way you can look them up by name:
sub print_species_names {
my $species = shift;
my %animals = (
cats => [qw(Jeffry Owen)],
dogs => [qw(Duke Lassie)],
);
if (my $array = $animals{$species}) {
print "$_\n" for #$array
}
else {
die "species '$species' not found"
}
}
If you want to reduce that even more, you could replace the if/else block with:
print "$_\n" for #{ $animals{$species}
or die "species $species not found" };

You can achieve something close by using a hash of array references:
%hash = ( 'cats' => [ "Jeffry", "Owen"],
'dogs' => [ "Duke", "Lassie" ] );
$arrayRef = $hash{cats};

You could also use eval here:
foreach (eval("#$species")) {
print $_ . "\n";
}
I should have made it clear that you need to turn off strict refs for this to work. So surrounding the code with use "nostrict" and use "strict" works.
This is whats known as a soft reference in perl.

Related

how to declare array reference in hash refrence

my $memType = [];
my $portOp = [];
my $fo = "aster.out.DRAMA.READ.gz";
if($fo =~/aster.out\.(.*)\.(.*)\.gz/){
push (#{$memType},$1);
push (#{$portOp},$2);
}
print Dumper #{$memType};
foreach my $mem (keys %{$portCapability->{#{$memType}}}){
//How to use the array ref memType inside a hash//
print "entered here\n";
//cannot post the rest of the code for obvious reasons//
}
I am not able to enter the foreach loop . Can anyone help me fix it?
Sorry this is not the complete code . Please help me.
%{$portCapability->{#{$memType}}}
This doesn't do what you may think it means.
You treat $portCapability->{#{$memType}} as a hash reference.
The #{$memType} is evaluated in scalar context, thus giving the size of the array.
I aren't quite sure what you want, but would
%{ $portCapability->{ $memType->[0] } }
work?
If, however, you want to slice the elements in $portCapability, you would need somethink like
#{ $portCapability }{ #$memType }
This evaluates to a list of hashrefs. You can then loop over the hashrefs, and loop over the keys in an inner loop:
for my $hash (#{ $portCapability }{ #$memType }) {
for my $key (keys %$hash) {
...;
}
}
If you want a flat list of all keys of the inner hashes, but don't need the hashes themselves, you could shorten above code to
for my $key (map {keys %$_} #{ $portCapability }{ #$memType }) {
...;
}
I think what you want is this:
my $foo = {
asdf => {
a => 1, b => 2,
},
foo => {
c => 3, d => 4
},
bar => {
e => 5, f => 6
}
};
my #keys = qw( asdf foo );
foreach my $k ( map { keys %{ $foo->{$_} } } #keys ) {
say $k;
}
But you do not know which of these $k belongs to which key of $foo now.
There's no direct way to get the keys of multiple things at the same time. It doesn't matter if these things are hashrefs that are stored within the same hashref under different keys, or if they are seperate variables. What you have to do is build that list yourself, by looking at each of the things in turn. That's simply done with above map statement.
First, look at all the keys in $foo. Then for each of these, return the keys inside that element.
my $memType = [];
my $portOp = [];
my $fo = “aster.out.DRAMA.READ.gz”;
if ($fo =~ /aster.out\.(\w+)\.(\w+)\.gz/ ) { #This regular expression is safer
push (#$memType, $1);
push (#$portOp, $2);
}
print Dumper “#$memType”; #should print “DRAMA”
#Now if you have earlier in your program the hash %portCapability, your code can be:
foreach $mem (#$memType) {
print $portCapability{$mem};
}
#or if you have the hash $portCapability = {…}, your code can be:
foreach $mem (#$memType) {
print $portCapability->{$mem};
}
#Hope it helps

Perl hash returning value

I am a newbie in newbies for perl. I am trying to create a function which returns the value of the hash. The following piece of code simply returns the last index of the hash. I googled around and couldnt find what i need. Appreciate if anyone can tell me where I am going wrong.
I am expecting, if I pass "he_1", I should get a return back value of 1, etc.. but all I see is 9.
#!/usr/bin/perl
my %IndexMap = ();
my $MAX_V = 5;
my $MAX_T = 10;
sub InitIndexMap {
foreach my $i (0..$MAX_V-1) {
$IndexMap["he_".$i] = $i;
print "he_".$i;
print $IndexMap["he_".$i];
}
foreach my $i ($MAX_V..$MAX_T-1) {
$IndexMap["un".$i] = $i;
print "un".$i;
print $IndexMap["un".$i];
}
}
sub GetVal {
my ($name) = #_;
return $IndexMap[$name];
}
&InitIndexMap();
my ($index) = &Getval("he_4");
print $index;
To read a hash, use curly braces, not brackets. Try this:
sub InitIndexMap {
foreach my $i (0..$MAX_V-1) {
$IndexMap{ "he_" . $i } = $i;
print "he_".$i;
print $IndexMap{ "he_" . $i };
}
foreach my $i ($MAX_V..$MAX_T-1) {
$IndexMap{ "un" . $i } = $i;
print "un".$i;
print $IndexMap{ "un" . $i };
}
}
sub GetVal {
my ( $name ) = #_;
return $IndexMap{ $name };
}
You should add this to the top of the script:
use strict;
use warnings;
The general rule to always turn those pragmas. They warnings and errors that that cause would have probably led you to the answer to your question.
You should access hashes with curly brackets like { and }.
$hash_name{$key} = $value;
In your example.
$IndexMap{"he_".$i} = $i;
You should consider doing some tutorials.
This is VERY BASIC knowledge in Perl.

Optimize perl hash mess

I have Perl code, which looks messy:
my $x = $h->[1];
foreach my $y (keys %$x) {
my $ax = $x->{$y};
foreach my $ay (keys %$ax) {
if (ref($ax->{$ay}) eq 'JE::Object::Proxy') {
my $bx = $ax->{$ay};
if ($$bx->{class_info}->{name} eq 'HTMLImageElement') {
print $$bx->{value}->{src}, "\n";
}
}
}
}
Is it possible to optimize the code above to not use any variables, just $h, as that one is an input?
Here's my crack at it:
print $$_->{value}{src}, "\n" for grep {
ref $_ eq 'JE::Object::Proxy' &&
$$_->{class_info}{name} eq 'HTMLImageElement'
} map {
values %$_
} values %{ $h->[1] };
You're using keys, when you really just want values.
foreach my $h ( grep { ref() eq 'HASH' } values %$x ) {
foreach my $obj (
grep { ref() eq 'JE::Object::Proxy'
and $_->{class_info}{name} eq 'HTMLImageElement'
} values %$h
) {
say $obj->{value}{src};
}
}
A lot of the "messiness" can be cleaned up by reducing your line count and minimizing how much nested code you have. Use the each command to get the next key and its associated value from the hash in one line. [EDIT: as Axeman pointed out, you really only need the values, so I'm replacing my use of each with values]. Also, use a pair of next statement to skip the print statement.
for my $ax (values %{$h->[1]} ) {
for my $bx (values %$ax ) {
next unless ref($bx) eq 'JE::Object::Proxy';
next unless $$bx->{class_info}->{name} eq 'HTMLImageElement';
print "$$bx->{value}->{src}\n";
}
}
Just removing the helper variables is easy, something like this should do it:
foreach my $y (keys %{$h->[1]}) {
foreach my $ax (%{$h->[1]->{$y}) {
foreach my $ay (keys %$ax) {
if(ref($h->[1]->{$y}->{$ay}) eq 'JE::Object::Proxy') {
if($h->[1]->{$y}->{$ay}->{class_info}->{name} eq 'HTMLImageElement') {
print $h->[1]->{$y}->{$ay}->{value}->{src}, "\n";
}
}
}
}
}
You could also remove the duplicated if:
foreach my $y (keys %{$h->[1]}) {
foreach my $ax (%{$h->[1]->{$y}) {
foreach my $ay (keys %$ax) {
if(ref($h->[1]->{$y}->{$ay}) eq 'JE::Object::Proxy' && $h->[1]->{$y}->{$ay}->{class_info}->{name} eq 'HTMLImageElement') {
print $h->[1]->{$y}->{$ay}->{value}->{src}, "\n";
}
}
}
}
But I don't really see how to make it more readable: it is a iteration over a three dimensional structure.

Equivalent of "shift" for a hash to create a $class->next() method

I almost feel like saying "it's me again!".
Anyway, here we go.
I like using while $object->next() style constructs. They appeal to me and seem "neat".
Now, when the thing I'm iterating over is an array, it's straightforward ("shift #ary or return undef")
sub next {
my ( $self, $args ) = #_;
my $next = shift #{ $self->{list_of_things} } or return undef;
my ( $car, $engine_size, $color )
= split( /\Q$opts->{fieldsep}/, $next );
$self->car = $host;
$self->engine_size = $engine_size;
$self->color = $color;
}
In this example I use AUTOLOAD to create the getters and setters and then have those instance variables available in my object during the while loop.
I'd like to do something similar but with the "list_of_things" being a %hash.
Here's a non-OO example that doesn't make it into the first iteration. Any ideas why?
(The total "list_of_things" is not that big - maybe 100 entries - so to do a keys(%{$hash}) every time doesn't seem too wasteful to me).
use strict;
use warnings;
use Data::Dumper;
my $list_of_things = {
volvo => {
color => "red",
engine_size => 2000,
},
bmw => {
color => "black",
engine_size => 2500,
},
mini => {
color => "british racing green",
engine_size => 1200,
}
};
sub next {
my $args = $_;
my #list = keys( %{$list_of_things} );
return undef if scalar #list == "0";
my $next = $list_of_things->{ $list[0] };
delete $list_of_things->{ $list[0] };
return $next;
}
while ( next()) {
print Dumper $_;
print scalar keys %{ $list_of_things }
}
Is there a better way of doing this? Am I doing something crazy?
EDIT:
I tried Ikegami's suggestion. Of course, Ikegami's example works flawlessly. When I try and abstract a little, so that all that is exposed to the object is a next->() method, I get the same "perl-going-to-100%-cpu" problem as in my original example.
Here's a non-OO example:
use Data::Dumper qw( Dumper );
sub make_list_iter {
my #list = #_;
return sub { #list ? shift(#list) : () };
}
sub next {
make_list_iter( keys %$hash );
}
my $hash = { ... };
while ( my ($k) = next->() ) {
print Dumper $hash->{$k};
}
It does not seem to get past the first step of the while() loop.
I am obviously missing something here...
If you don't want to rely on the hash's builtin iterator (used by each, keys and values), there's nothing stopping you from making your own.
use Data::Dumper qw( Dumper );
sub make_list_iter {
my #list = #_;
return sub { #list ? shift(#list) : () };
}
my $list_of_things = { ... };
my $i = make_list_iter(keys %$list_of_things);
while (my ($k) = $i->()) {
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
say "$k: " . Dumper($list_of_things->{$k});
}
The each operator is a builtin that iterates over hashes. It returns undef when it runs out of elements to return. So you could so something like
package SomeObject;
# creates new object instance
sub new {
my $class = shift;
return bless { hash_of_things => { #_ } }, $class
}
sub next {
my $self = shift;
my ($key,$value) = each %{ $self->{hash_of_things} };
return $key; # or return $value
}
Calling keys on the hash will reset the each iterator. It's good to know this so you can reset it on purpose:
sub reset {
my $self = shift;
keys %{ $self->{hash_of_things} }
}
and so you can avoid resetting it on accident.
The section on tie'ing hashes in perltie also has an example like this.
Here's how List::Gen could be used to create an iterator from a list:
use strict;
use warnings;
use List::Gen 'makegen';
my #list_of_things = ( # This structure is more suitable IMO
{
make => 'volvo',
color => 'red',
engine_size => 2000,
},
{
make => 'bmw',
color => 'black',
engine_size => 2500,
},
{
make => 'mini',
color => 'british racing green',
engine_size => 1200,
}
);
my $cars = makegen #list_of_things;
print $_->{make}, "\n" while $cars->next;
Well, if you don't need $list_of_things for later, you can always do something like
while(keys %$list_of_things)
{
my $temp=(sort keys %$list_of_things)[0];
print "key: $temp, value array: " . join(",",#{$list_of_things->{$temp}}) . "\n";
delete $list_of_things->{$temp};
}
And if you do need it, you can always assign it to a temporary hash reference and perform the same while loop on it.

Where can I find an array of the (un)assigned Unicode code points for a particular block?

At the moment, I'm writing these arrays by hand.
For example, the Miscellaneous Mathematical Symbols-A block has an entry in hash like this:
my %symbols = (
...
miscellaneous_mathematical_symbols_a => [(0x27C0..0x27CA), 0x27CC,
(0x27D0..0x27EF)],
...
)
The simpler, 'continuous' array
miscellaneous_mathematical_symbols_a => [0x27C0..0x27EF]
doesn't work because Unicode blocks have holes in them. For example, there's nothing at 0x27CB. Take a look at the code chart [PDF].
Writing these arrays by hand is tedious, error-prone and a bit fun. And I get the feeling that someone has already tackled this in Perl!
Perhaps you want Unicode::UCD? Use its charblock routine to get the range of any named block. If you want to get those names, you can use charblocks.
This module is really just an interface to the Unicode databases that come with Perl already, so if you have to do something fancier, you can look at the lib/5.x.y/unicore/UnicodeData.txt or the various other files in that same directory to get what you need.
Here's what I came up with to create your %symbols. I go through all the blocks (although in this sample I skip that ones without "Math" in their name. I get the starting and ending code points and check which ones are assigned. From that, I create a custom property that I can use to check if a character is in the range and assigned.
use strict;
use warnings;
digest_blocks();
my $property = 'My::InMiscellaneousMathematicalSymbolsA';
foreach ( 0x27BA..0x27F3 )
{
my $in = chr =~ m/\p{$property}/;
printf "%X is %sin $property\n",
$_, $in ? '' : ' not ';
}
sub digest_blocks {
use Unicode::UCD qw(charblocks);
my $blocks = charblocks();
foreach my $block ( keys %$blocks )
{
next unless $block =~ /Math/; # just to make the output small
my( $start, $stop ) = #{ $blocks->{$block}[0] };
$blocks->{$block} = {
assigned => [ grep { chr =~ /\A\p{Assigned}\z/ } $start .. $stop ],
unassigned => [ grep { chr !~ /\A\p{Assigned}\z/ } $start .. $stop ],
start => $start,
stop => $stop,
name => $block,
};
define_my_property( $blocks->{$block} );
}
}
sub define_my_property {
my $block = shift;
(my $subname = $block->{name}) =~ s/\W//g;
$block->{my_property} = "My::In$subname"; # needs In or Is
no strict 'refs';
my $string = join "\n", # can do ranges here too
map { sprintf "%X", $_ }
#{ $block->{assigned} };
*{"My::In$subname"} = sub { $string };
}
If I were going to do this a lot, I'd use the same thing to create a Perl source file that has the custom properties already defined so I can just use them right away in any of my work. None of the data should change until you update your Unicode data.
sub define_my_property {
my $block = shift;
(my $subname = $block->{name}) =~ s/\W//g;
$block->{my_property} = "My::In$subname"; # needs In or Is
no strict 'refs';
my $string = num2range( #{ $block->{assigned} } );
print <<"HERE";
sub My::In$subname {
return <<'CODEPOINTS';
$string
CODEPOINTS
}
HERE
}
# http://www.perlmonks.org/?node_id=87538
sub num2range {
local $_ = join ',' => sort { $a <=> $b } #_;
s/(?<!\d)(\d+)(?:,((??{$++1})))+(?!\d)/$1\t$+/g;
s/(\d+)/ sprintf "%X", $1/eg;
s/,/\n/g;
return $_;
}
That gives me output suitable for a Perl library:
sub My::InMiscellaneousMathematicalSymbolsA {
return <<'CODEPOINTS';
27C0 27CA
27CC
27D0 27EF
CODEPOINTS
}
sub My::InSupplementalMathematicalOperators {
return <<'CODEPOINTS';
2A00 2AFF
CODEPOINTS
}
sub My::InMathematicalAlphanumericSymbols {
return <<'CODEPOINTS';
1D400 1D454
1D456 1D49C
1D49E 1D49F
1D4A2
1D4A5 1D4A6
1D4A9 1D4AC
1D4AE 1D4B9
1D4BB
1D4BD 1D4C3
1D4C5 1D505
1D507 1D50A
1D50D 1D514
1D516 1D51C
1D51E 1D539
1D53B 1D53E
1D540 1D544
1D546
1D54A 1D550
1D552 1D6A5
1D6A8 1D7CB
1D7CE 1D7FF
CODEPOINTS
}
sub My::InMiscellaneousMathematicalSymbolsB {
return <<'CODEPOINTS';
2980 29FF
CODEPOINTS
}
sub My::InMathematicalOperators {
return <<'CODEPOINTS';
2200 22FF
CODEPOINTS
}
Maybe this?
my #list =
grep {chr ($_) =~ /^\p{Assigned}$/}
0x27C0..0x27EF;
#list = map { $_ = sprintf ("%X", $_ )} #list;
print "#list\n";
Gives me
27C0 27C1 27C2 27C3 27C4 27C5 27C6 27C7 27C8 27C9 27CA 27D0 27D1 27D2 27D3
27D4 27D5 27D6 27D7 27D8 27D9 27DA 27DB 27DC 27DD 27DE 27DF 27E0 27E1 27E2
27E3 27E4 27E5 27E6 27E7 27E8 27E9 27EA 27EB
I don't know why you wouldn't say miscellaneous_mathematical_symbols_a => [0x27C0..0x27EF], because that's how the Unicode standard is defined according to the PDF.
What do you mean when you say it doesn't "work"? If it's giving you some sort of error when you check the existence of the character in the block, then why not just weed them out of the block when your checker comes across an error?