It's been a while, so apologies for my rusty question...
Given the current (working) code:
my #keywords = ( 'foo', 'bar', 'kan', 'moo', 'ban', 'noob' );
my #good = grep { /oo/ } #keywords;
my #bad = grep { !/oo/ } #keywords;
my %data = (
keywords => \#keywords,
good => \#good,
bad => \#bad
);
print Dumper(\%data);
The declarations are just transient variables to make sure the hash ends up with an array reference. Is there a way to consolidate the above to simply use the methods in the hash declaration?
I'm trying to arrive at something similar to the following (non-working code):
my #keywords = ( 'foo', 'bar', 'kan', 'moo', 'ban', 'noob' );
my %data = (
keywords => \#keywords,
good => grep { /oo/ } #keywords,
bad => grep { !/oo/ } #keywords
);
print Dumper(\%data);
Yes, simply use an anonymous array ref:
my %data = (
keywords => [#keywords],
good => [grep { /oo/ } #keywords],
bad => [grep { !/oo/ } #keywords],
);
print Dumper(\%data);
Related
I have a data structure which looks like this:
my %hoh = (
'T431567' => {
machin => '01',
bidule => '02',
truc => '03',
},
'T123456' => {
machin => '97',
bidule => '99',
truc => '69',
},
'T444444' => {
machin => '12',
bidule => '64',
truc => '78',
},
);
I want to search the various values of truc for a particular value and find the top-level attribute which corresponds to that entry. For example, looking for a value of 78, I want to find the result 'T444444', because $hoh{T444444}{truc} is 78.
How can I do this, please?
You can do this with grep:
my #keys = grep { $hoh{$_}{truc} == 78 } keys %hoh;
Note that this can return more than one key, if there are duplicate values in the hash. Also note that this is not particularly efficient, since it has to search the entire hash. In most cases it's probably fine, but if the hash can be very large and you may need to run lots of such queries against it, it may be more efficient to build a reverse index as suggested by Sobrique:
my %trucs;
foreach my $part (keys %hoh) {
my $val = $hoh{$part}{truc};
push #{ $trucs{$val} }, $part;
}
my #keys = #{ $trucs{78} };
or, more generally:
my %index;
foreach my $part (keys %hoh) {
my %data = %{ $hoh{$part} };
foreach my $key (keys %data) {
my $val = $data{$key};
push #{ $index{$key}{$val} }, $part;
}
}
my #keys = #{ $index{truc}{78} };
Can't with that data structure as is - There is no 'backwards' relationship from value to key without you creating it.
You've two options - run a search, or create an 'index'. Practically speaking, these are the same, just one saves the results.
my %index;
foreach my $key ( keys %hoh ) {
my $truc = $hoh{$key}{'truc'};
$index{$truc} = $key;
}
Note - won't do anything clever if the 'truc' numbers are duplicated - it'll overwrite. (Handling this is left as an exercise to the reader).
This solution is similar to those already posted, but it uses the each operator to process the original hash in fewer lines of code, and probably more quickly.
I have added the dump output only so that you can see the form of the structure that is built.
use strict;
use warnings;
my %hoh = (
T123456 => { bidule => '99', machin => '97', truc => '69' },
T431567 => { bidule => '02', machin => '01', truc => '03' },
T444444 => { bidule => '64', machin => '12', truc => '78' },
);
my %trucs;
while ( my ($key, $val) = each %hoh ) {
next unless defined( my $truc = $val->{truc} );
push #{ $trucs{$truc} }, $key ;
}
use Data::Dump;
dd \%trucs;
print "\n";
print "$_\n" for #{ $trucs{78} };
output
{ "03" => ["T431567"], "69" => ["T123456"], "78" => ["T444444"] }
T444444
If you can guarantee that the answer is unique, i.e. that there is never more than one element of the original hash that has a given value for the truc entry, or you are interested only in the last one found, then you can write this still more neatly
my %trucs;
while ( my ($key, $val) = each %hoh ) {
next unless defined( my $truc = $val->{truc} );
$trucs{$truc} = $key ;
}
print $trucs{78}, "\n";
output
T444444
Simplest of all, if there is always a truc entry in each second-level hash, and its values is guaranteed to be unique, then this will do the job
my %trucs = map { $hoh{$_}{truc} => $_ } keys %hoh;
print $trucs{78}, "\n";
with the output as above.
I have this
sub test
{
my ($arg1, $arg2) = #_; # Argument list
code
return ($variable1, $variable2);
}
So, when i call this by
test('text1','text2');
concatenates the two return values in one. How can i call only one at a time?
my $output_choice_1 = ( test('text1','text2') )[0];
my $output_choice_2 = ( test('text1','text2') )[1];
or both at once:
my ( $output_choice_1, $output_choice_2 ) = test('text1','text2');
Though sometimes it makes for clearer code to return a hashref:
sub test {
...
return { 'choice1' => $variable1, 'choice2' => $variable2 };
}
...
my $output_choice_1 = test('text1','text2')->{'choice1'};
Are you asking how to assign the two values returned by a sub to two different scalars?
my ($var1, $var2) = test('text1', 'text2');
I wasn't really happy with what I found in google so posting my solution here.
Returning an array from a sub.
Especially the syntax with the backslash caused me headaches.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub returnArrayWithHash {
(my $value, my %testHash) = #_;
return ( $value, \%testHash );
}
my %testHash = ( one => 'foo' , two => 'bar' );
my #result = returnArrayWithHash('someValue', %testHash);
print Dumper(\#result) . "\n";
Returns me
$VAR1 = [
'someValue',
{
'one' => 'foo',
'two' => 'bar'
}
];
my %book = (
'name' => 'abc',
'author' => 'monk',
'isbn' => '123-890',
'issn' => '#issn',
);
my %chapter = (
'title' => 'xyz',
'page' => '90',
);
How do I incorporate %book inside %chapter through reference so that when I write "$chapter{name}", it should print 'abc'?
You can copy the keys/values of the %book into the %chapter:
#chapter{keys %book} = values %book;
Or something like
%chapter = (%chapter, %book);
Now you can say $chapter{name}, but changes in %book are not reflected in %chapter.
You can include the %book via reference:
$chapter{book} = \%book;
Now you could say $chapter{book}{name}, and changes do get reflected.
To have an interface that allows you to say $chapter{name} and that does reflect changes, some advanced techniques would have to be used (this is fairly trivial with tie magic), but don't go there unless you really have to.
You could write a subroutine to check a list of hashes for a key. This program demonstrates:
use strict;
use warnings;
my %book = (
name => 'abc',
author => 'monk',
isbn => '123-890',
issn => '#issn',
);
my %chapter = (
title => 'xyz',
page => '90',
);
for my $key (qw/ name title bogus / ) {
print '>> ', access_hash($key, \%book, \%chapter), "\n";
}
sub access_hash {
my $key = shift;
for my $hash (#_) {
return $hash->{$key} if exists $hash->{$key};
}
undef;
}
output
Use of uninitialized value in print at E:\Perl\source\ht.pl line 17.
>> abc
>> xyz
>>
I like to capture all global variables from an external Perl script with Perl. Currently I am hanging around the type detection.
How to determine the correct data type ('', 'SCALAR', 'HASH', 'ARRAY', 'CODE')?
Parser script:
my %allVariables = ();
{
do "scriptToBeParsed.pl";
foreach my $sym ( keys %main:: ) {
# Get all normal variables and scalar/hash/array references:
if ( ref( *{"$sym"} ) =~ m/^(?:|SCALAR|HASH|ARRAY)$/ ) {
$allVariables{"$sym"} = *{"$sym"};
}
}
}
Script to be parsed:
$someVariable1 = 'Yes, I like to be captured';
$otherVariable2 = \'And I also want to be captured';
%anotherVariable3 = ( 'Capture' => 'me' );
#lameVariable4 = ( 'Capture', 'me' );
$fooVariable5 = { 'Capture' => 'me' };
$barVariable6 = [ 'Capture', 'me' ];
$subVariable7 = sub { return "Don't capture me!" };
sub dontCaptureMe { return "Don't capture me!" }
In my example ref( *{"$sym"} ) returns always 'GLOB' (of course).
Another approach would be to use the has-like access of the typeglob, which is explained in Chapter 8 of brian d foy's Mastering Perl on page 131f.
package test;
no strict;
no warnings;
$someVariable1 = 'Yes, I like to be captured';
$otherVariable2 = \'And I also want to be captured';
%anotherVariable3 = ( 'Capture' => 'me' );
#lameVariable4 = ( 'Capture', 'me' );
$fooVariable5 = { 'Capture' => 'me' };
$barVariable6 = [ 'Capture', 'me' ];
$subVariable7 = sub { return "Don't capture me!" };
sub dontCaptureMe { return "Don't capture me!" }
say $dontCaptureMe;
my %allVariables = ();
{
do "scriptToBecomeParsed.pl";
foreach my $sym ( keys %test:: ) {
for (qw( SCALAR HASH ARRAY CODE IO)) {
if (*{"$sym"}{$_}) {
$allVariables{$_}->{"$sym"} = *{"$sym"}{$_};
}
}
}
}
print Data::Dumper::Dumper \%allVariables;
This will produce the following output:
$VAR1 = {
'CODE' => {
'dontCaptureMe' => sub { "DUMMY" }
},
'ARRAY' => {
'lameVariable4' => [
'Capture',
'me'
]
},
'HASH' => {
'anotherVariable3' => {
'Capture' => 'me'
}
},
'SCALAR' => {
'someVariable1' => \'Yes, I like to be captured',
'__ANON__' => \undef,
'subVariable7' => \sub { "DUMMY" },
'dontCaptureMe' => \undef,
'otherVariable2' => \\'And I also want to be captured',
'BEGIN' => \undef,
'barVariable6' => \[
'Capture',
'me'
],
'anotherVariable3' => \undef,
'lameVariable4' => \undef,
'fooVariable5' => \{
'Capture' => 'me'
}
}
};
like you said
ref( *{"$sym"} ) returns always 'GLOB' (of course).
Because perl stores everything in the symbol table in a glob, it is impossible to tell which data type something is. This is because in perl it is perfectly valid to have an array, scalar, hash or whatever else with the same name... because of this, perl stores everything in globs to avoid collisions. What you could do is loop through all of the symbols in the symbol table and test each glob against all the possible things that it could be (the set isn't too large) and see which ones are set.
Alternatively, a more practical approach might be to just load the perl script as text and parse for $, %, #, sub, open (filehandle) to see what type everything is.
Puppy meta data gets read in from config file using (General::Config) and creates this hash of hashes
$puppy_hashes = {
puppy_blue => { name => 'charlie', age => 4 },
puppy_red => { name => 'sam', age => 9 },
puppy_yellow => { name => 'jerry', age => 2 },
puppy_green => { name => 'phil', age => 5 },
}
the MotherDogRobot package consumes the puppies hash to birth an array of puppy objects (lol)
package MotherDogRobot;
use Moose;
use Puppy;
use Data::Dumper;
#moose includes warn and strict
sub init_puppy{
my($self,%options) = #_;
my $puppy = Puppy->new( %options );
return ($puppy);
}
sub birth_puppies{
my($self,$puppy_hashes) = #_;
my #keys = keys %{$puppy_hashes};
my #puppies = map { $self->init_puppy( $puppy_hashes->{$_} ) } #keys;
return(#puppies);
}
sub show_me_new_puppies{
my($self,$puppy_hashes) #_;
print Dumper($self->birth_puppies($puppy_hashes));
}
Error odd number of arguments
passing %options to Puppy->new(%options)
no luck birthing puppies -- which means I can't put lasers on their heads =/
UPDATE
I think the problem is that I'm passing a Hash Ref to init_puppy() instead of an array or hash, so when I try to pass %options to the new constructor, it's not getting a proper ( key => value) pair -- hence the odd number of arguments error.
But from this standpoint I've been looking at this code too long I cant figure out how to dereference this properly.
btw this is my official day 22 of using Perl!
you're using empty variables as if they're not empty, that is, you're not doing anything at all
print "hi $_ " for my #foo;
This assumes that the incomplete snippet you've shown is what you're really using
update: Similarly in sub init_puppy, you never initialize my($self,%options)=#_;
#!/usr/bin/perl --
use strict;
use warnings;
Main( #ARGV );
exit( 0 );
sub Main {
my $puppy_hashes = {
puppy_blue => { name => 'charlie', age => 4 },
puppy_red => { name => 'sam', age => 9 },
puppy_yellow => { name => 'jerry', age => 2 },
puppy_green => { name => 'phil', age => 5 },
};
for my $puppy ( MotherDogRobot->birth_puppies($puppy_hashes) ) {
print join ' ', $puppy, $puppy->name, $puppy->age, $puppy->dump, "\n";
}
}
BEGIN {
package Puppy;
BEGIN { $INC{'Puppy.pm'} = __FILE__; }
use Any::Moose;
has 'name' => ( is => 'rw', isa => 'Str' );
has 'age' => ( is => 'rw', isa => 'Int' );
package MotherDogRobot;
BEGIN { $INC{'MotherDogRobot.pm'} = __FILE__; }
use Moose;
use Puppy;
sub init_puppy {
my ( $self, %options ) = #_;
my $puppy = Puppy->new(%options);
return ($puppy);
}
sub birth_puppies {
my ( $self, $puppy_hashes ) = #_;
my #puppies = map { $self->init_puppy( %{$_} ) } values %$puppy_hashes;
return (#puppies);
}
no Moose;
}
The standard Moose constructor will accept both
->new( %{ $puppy_hashes->{$_} } )
and
->new( $puppy_hashes->{$_} )
if $puppy_hashes contains what you say it does, and $_ is an existing key.
Furthermore, Moose will not give the error Error odd number of argments when you pass no arguments. (You're not assigning anything to %config.)
I can't tell which part of what you said is wrong, but what you said doesn't add up.