I would like to have a subroutine as a member of a hash which is able to have access to other hash members.
For example
sub setup {
%a = (
txt => "hello world",
print_hello => sub {
print ${txt};
})
return %a
}
my %obj = setup();
$obj{print_hello};
Ideally this would output "hello world"
EDIT
Sorry, I failed to specify one requirement
I should be able to do
$obj{txt} = "goodbye";
and then $obj{print_hello} should output goodbye
If you want the calling code to be able to modify the message in the hash, you need to return the hash by reference. This does what you asked for:
use strict;
use warnings;
sub self_expressing_hash {
my %h;
%h = (
msg => "hello",
express_yourself => sub { print $h{msg}, "\n" },
);
return \%h;
}
my $h = self_expressing_hash();
$h->{express_yourself}->();
$h->{msg} = 'goodbye';
$h->{express_yourself}->();
However, it's a bizarre concoction -- essentially, a data structure that contains some built-in behavior. Sounds a like an object to me. Perhaps you should look into an O-O approach for your project.
This will work:
sub setup {
my %a = ( txt => "hello world" );
$a{print_hello} = sub { print $a{txt} };
return %a;
}
my %obj = setup();
$obj{print_hello}->();
Close:
sub setup {
my %a = (
txt => "hello world",
print_hello => sub {
print $a{txt};
});
return %a;
}
my %obj = setup();
$obj{print_hello}->();
Related
I have a global hash
our %employee = (
'ename'=>"rahul",
'eno'=>"25",
);
later I want to use it in a subroutine wid different values
sub emp
{
print ("$employee->'ename' = 'satish'");
}
but this is not happening can you please suggest me what is wrong here..?
%employee is a hash not a hash reference. So try to modify the value like $employee{'ename'}= "Satish";
use strict;
our %employee = (
'ename' => "rahul",
'eno' => "25",
);
sub emp {
print "Original Value: $employee{'ename'} \n";
$employee{'ename'} = "Satish";
print "Modified Value: $employee{'ename'}\n";
}
emp();
Output:
Original Value: rahul
Modified Value: Satish
Just like you would modify another hash value.
Say you have a package like so:
package TestPack;
use warnings;
use strict;
our %employee = (
ename => 'rahul',
eno => 25,
);
You could modify the hash like so:
#!/usr/bin/perl
use warnings;
use strict;
use TestPack;
print "name: $TestPack::employee{'ename'}\n";
$TestPack::employee{'ename'} = "Chris";
print "name: $TestPack::employee{'ename'}\n";
The output:
$ ./test.pl
name: rahul
name: Chris
Although it probably isn't best to handle the data directly when working on larger projects with many people, instead you can have something like "accessors/mutators" in TestPack:
sub get_value {
my $val = shift;
if( exists($employee{$val}) ) {
return $employee{$val};
} else {
return "No such value: $val";
}
}
sub update_ename {
my $ename = shift;
$employee{'ename'} = $ename;
}
The other module/script could add something like this:
my $new_new_ename = "Mike";
TestPack::update_ename($new_new_ename);
print "name: ", TestPack::get_value('ename'), "\n";
print "name: ", TestPack::get_value('foobar'), "\n";
Output:
name: Mike
name: No such value: foobar
This is my problem:
I have a file-system like data-structure:
%fs = (
"home" => {
"test.file" => {
type => "file",
owner => 1000,
content => "Hello World!",
},
},
"etc" => {
"passwd" => {
type => "file",
owner => 0,
content => "testuser:testusershash",
},
"conf" => {
"test.file" => {
type => "file",
owner => 1000,
content => "Hello World!",
},
},
},
);
Now, to get the content of /etc/conf/test.file I need $fs{"etc"}{"conf"}{"test.file"}{"content"}, but my input is an array and looks like this: ("etc","conf","test.file").
So, because the length of the input is varied, I don't know how to access the values of the hash. Any ideas?
You can use a loop. In each step, you proceed one level deeper into the structure.
my #path = qw/etc conf test.file/;
my %result = %fs;
while (#path) {
%result = %{ $result{shift #path} };
}
print $result{content};
You can also use Data::Diver.
my #a = ("etc","conf","test.file");
my $h = \%fs;
while (my $v = shift #a) {
$h = $h->{$v};
}
print $h->{type};
Same logic as what others given, but uses foreach
#keys = qw(etc conf test.file content);
$r = \%fs ;
$r = $r->{$_} foreach (#keys);
print $r;
$pname = '/etc/conf/test.file';
#names = split '/', $pname;
$fh = \%fs;
for (#names) {
$fh = $fh->{"$_"} if $_;
}
print $fh->{'content'};
Path::Class accepts an array. It also gives you an object with helper methods and handles cross platform slash issues.
https://metacpan.org/module/Path::Class
You can just build the hash element expression and call eval. This is tidier if it is wrapped in a subroutine
my #path = qw/ etc conf test.file /;
print hash_at(\%fs, \#path)->{content}, "\n";
sub hash_at {
my ($hash, $path) = #_;
$path = sprintf q($hash->{'%s'}), join q('}{'), #$path;
return eval $path;
}
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.
I have a list of functions in Perl. Example:
my #funcs = qw (a b c)
Now they all belong to this module Foo::Bar::Stix. I would like to call them iteratively in a loop:
foreach $func (#funcs) {
Foo::Bar::Stix::$func->(%args)
}
where args is a hash of arguments. However I keep getting this error: "Bad name after :: ..." at the line which contains Foo::Bar::Stix::$func->(%args) How do I fix this error?
a b and c are not function objects but strings
Rather than storing the names of the functions in your array, store references to them in a hash so that you can refer to them by name. Here's a simple code example:
#!/usr/bin/perl
use strict;
use warnings;
my %func_refs = (
'a' => \&Foo::Bar::Stix::a,
'b' => \&Foo::Bar::Stix::b,
'c' => \&Foo::Bar::Stix::c
);
foreach my $func_ref ( values %func_refs ) {
print $func_ref->( "woohoo: " ), "\n";
}
{
package Foo::Bar::Stix;
sub a {
my $arg = shift;
return $arg . "a";
}
sub b {
my $arg = shift;
return $arg . "b";
}
sub c {
my $arg = shift;
return $arg . "c";
}
}
If you're stuck with storing the names for some reason, try this:
my $package = "Foo::Bar::Stix";
my #func_names = qw/ a b c /;
foreach my $func_name (#func_names) {
my $str = &{ "$package\::$func_name" }( "woohoo: " );
print $str, "\n";
}
However, this doesn't work under use strict, and because of this I prefer the first solution. Whatever you do, try to avoid using eval. It's unnecessary, and will likely only cause you problems.
Also, most people who work with Perl capitalize it as Perl rather than PERL. Here's a Stackoverflow question on the subject:
How should I capitalize Perl?
Bad answer: use a symbolic reference:
for $func (#funcs) {
&{"Foo::Bar::Stix::$func"}(\%args);
}
Good answer: use a dispatch table:
my %call_func = (
'a' => \&Foo::Bar::Stix::a,
'b' => \&Foo::Bar::Stix::b,
'c' => \&Foo::Bar::Stix::c,
);
...
for $func (#funcs) {
$call_func{$func}->(\%args);
}
Slight change of syntax will give you what you want
Foo::Bar::Stix->$func(%args)
Though this will pass the package name as the first parameter.
You can use can
my #funcs = qw (a b c)
foreach $func (#funcs) {
Foo::Bar::Stix->can($func)->(%args)
}
You could access it through the special %Foo::Bar::Stix:: variable. This gives full access directly to the symbol table. You'll also notice that it works under strict mode.
#! /usr/bin/env perl
use strict;
use warnings;
{
package Foo::Bar::Stix;
sub a{ print "sub a\n" }
sub b{ print "sub b\n" }
sub c{ print "sub c\n" }
}
my #funcs = qw' a b c ';
my %args;
for my $func (#funcs) {
$Foo::Bar::Stix::{$func}->(%args); # <====
}
Another option:
my $symbol_table = $::{'Foo::'}{'Bar::'}{'Stix::'};
my %funcs = (
# we only want the CODE references
'a' => *{ $symbol_table->{'a'} }{'CODE'},
'b' => *{ $symbol_table->{'b'} }{'CODE'},
'c' => *{ $symbol_table->{'c'} }{'CODE'},
);
for my $func (#funcs) {
$funcs{$func}->(%args); # <====
}
If you are going to be doing that for a large number of subroutines, this is how I would load up the %funcs variable.
my %funcs;
BEGIN{
my $symbol_table = $::{'Foo::'}{'Bar::'}{'Stix::'};
for my $name (qw' a b c '){
$funcs{$name} = *{ $symbol_table->{$name} }{'CODE'};
}
}
I wouldn't do this unless you need the subroutines to have both a fully qualified name, and access to it through a hash variable.
If you only need access to the subroutines through a hash variable this is a better way to set it up.
my %funcs = (
'a' => sub{ print "sub a\n" },
'b' => sub{ print "sub b\n" },
'c' => sub{ print "sub c\n" },
);
Note: you could replace "my %funcs" with "our %funcs"
I have some files with below data.
sample File 1:
sitename1,2009-07-19,"A1",11975,17.23
sitename1,2009-07-19,"A2",11,0.02
sitename1,2009-07-20,"A1",2000,17.23
sitename1,2009-07-20,"A2",538,0.02
I want to map the values in column 4 with column 2 and 3 as shown below.
Output required.
Site,Type,2009-07-19,2009-07-20
sitename1,"A1",11975,2000
sitename1,"A2",11,538
Here is what I have tried so far:
#! /usr/bin/perl -w
use strict;
use warnings;
my $column_header=["Site,Type"];
my $position={};
my $last_position=0;
my $current_event=[];
my $events=[];
while (<STDIN>) {
my ($site,$date,$type,$value,$percent) = split /[,\n]/, $_;
my $event_key = $date;
if (not defined $position->{$event_key}) {
$last_position+=1;
$position->{$event_key}=$last_position;
push #$column_header,$event_key;
}
my $pos = $position->{$event_key};
if (defined $current_event->[$pos]) {
dumpEvent();
}
if (not defined $current_event->[0]) {
$current_event->[0]="$site,$type";
}
$current_event->[$pos]=$value;
}
dumpEvent();
my $order = [];
for (my $scan=0; $scan<scalar(#$column_header); $scan++) {
push #$order,$scan;
}
printLine($column_header);
map { printLine($_) } #$events;
sub printLine {
my $record=shift;
my #result=();
foreach my $offset (#$order) {
if (defined $record->[$offset]) {
push #result,$record->[$offset];
} else {
push #result,"";
}
}
print join(",",#result)."\n";
}
sub dumpEvent {
return unless defined $current_event->[0];
push #$events,$current_event;
$current_event=[];
}
The output i am getting is as below.
*Site,Type,2009-07-19,2009-07-20*
sitename1,"A1",11975,
sitename1,"A2",11,
sitename1,"A1",,14620
sitename1,"A2",,538
If I understand you correctly (and I have to admit I'm only guessing), you have several types of things at different dates and a value for each. Thus you need a data structure like this hash for each site:
$foo = {
site => 'sitename1',
type => 'A1',
dates => [
{
date => '2009-07-19',
value => 11975,
},
{
date => '2009-07-20',
value => 538,
},
],
};
Is that even close?
The folowing code produces the expected result and makes "some" sense. I don't know if it makes real sense.
my %dates;
my %SiteType;
while (<DATA>) {
chomp;
my ($site,$date,$type,$value,$percent) = split /,/;
$dates{$date} = '1';
push #{$SiteType{"$site,$type"}}, $value ;
};
print 'Site,Type,', join(',', sort keys %dates), "\n";
foreach ( sort keys %SiteType) {
print $_, ',', join(',', #{$SiteType{$_}}), "\n";
};