Return multiple variables perl - perl

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'
}
];

Related

How do I call a sub returned by reference by a Perl closure?

I'm trying to make subroutine closure working like an object.
However, I cannot call the returned subs references properly.
I receive Not a CODE reference at .\closure.pl line 22. error.
#!/usr/bin/perl
use strict;
use warnings;
sub number {
my ($value) = #_;
my $val = sub { $value };
my $inc = sub { ++$value };
my $dec = sub { --$value };
my %api = (
'val' => \$val,
'inc' => \$inc,
'dec' => \$dec,
);
return %api;
}
my %numb = number(42);
$numb{'inc'}->();
print $numb{'val'}->();
How to fix the code?
Code fixed
Yes, of course, an anonymous definition must return a reference. it means that it can be put directly in the %api. Perl doesn't complain and works like a charm :)
#!/usr/bin/perl
use strict;
use warnings;
sub number {
my ($value) = #_;
my %api = (
'val' => sub { $value },
'inc' => sub { ++$value },
'dec' => sub { --$value },
);
return \%api;
}
my $m = number(14);
my $n = number(41);
$m->{'dec'}->();
$n->{'inc'}->();
print $m->{'val'}->() . "\n"; # -> 13
print $n->{'val'}->() . "\n"; # -> 42
As discussed in perlref, the sub keyword without a name creates an anonymous subroutine and returns a reference to it. So you don't need to create another level of reference using the backslash; just pass the reference you already have as the value in the hash.

Perl OOP method returns array I cannot loop

Here is what my module looks like:
#!/usr/bin/perl
package Page;
use strict;
use warnings;
use base qw/DBObj/;
our %fields = (
id => undef,
title => '$',
content => '$'
);
sub get_field_names {
my #names = sort keys \%fields;
return \#names;
}
for my $field ( keys %fields ) {
my $slot = __PACKAGE__ ."::$field";
no strict "refs";
*$field = sub {
my $self = shift;
$self->{$slot} = shift if #_;
return $self->{$slot};
}
}
1;
Here the parent module where the strange behaviour occurs
#!/usr/bin/perl
package DBObj;
use strict;
use warnings;
use Data::Dumper;
use DBConn;
sub new {
my $me = shift;
my $class = ref $me || $me;
my $self = {
dbh => new DBConn->new(
dns => '/db.sql',
user => '',
pass => '',
)
};
return bless $self, $class;
}
sub save {
my $self = shift;
my #field_names = #{$self->get_field_names};
print Dumper #field_names;
foreach my $item ( reverse #field_names ) {
print $item;
}
}
sub fill {
my ( $self, $args ) = #_;
foreach my $key ( keys $args ) {
$self->$key( $args->{$key} );
}
}
1;
here is what I am experiencing. This snippet
my #field_names = $self->get_field_names;
print Dumper #field_names;
foreach my $item ( reverse #field_names ) {
print $item;
}
Data::Dumper shows
$VAR1 = [
'content',
'id',
'title'
];
But the foreach loop returns
ARRAY(0x7fc750a26470)
I have a Test::Simple test case where I perform the following test
ok( shift $page->get_field_names eq 'content', 'Page has field content');
so I can shift off an item from the array, but I cannot loop through it which is a puzzle to me.
And please; before you tell me that I shouldn't be doing this and that there is a ton of modules out there I should pick instead, I want to point out; I am doing this our of pure fun, I have been away from Perl for ~10 years and thought it would be fun to play around with it again.
You have made get_field_names return a reference to an array, but you are then putting that reference into an array variable.
Try:
my $field_names = $self->get_field_names;
print Dumper $field_names;
foreach my $item ( reverse #$field_names ) {
print $item;
}
get_field_names returns an arrayref, not an array. Either change its return type by removing the backslash from return \#names; or "cast" its return type to an array by writing:
my #field_names = #{$self->get_field_names};

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.

How can I loop through a list of functions in Perl?

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"

How can I use hashes as arguments to subroutines in Perl?

I have a function that is doing some calculations and then passes some properties into another subroutine like so:
sub get_result {
my $id = 1;
my %diet = ( result => 28,
verdict => 'EAT MORE FRUIT DUDE...'
);
my %iq = ( result => 193,
verdict => 'Professor Einstien'
);
print_result($id, %diet, %iq);
}
sub print_result {
my $id = shift;
my %d = #_;
my %i = #_;
print "IQ: $id\n";
print "DIET RESULT: $d{result}\n";
print "DIET VERDICT: $d{verdict}\n";
print "IQ RESULT: $i{result}\n";
print "IQ VERDICT: $i{verdict}\n";
}
My problem is that the results printed in (DIET RESULT, DIET VERDICT) and (IQ SCORE, IQ RESULT) are both the same. As if variable %d and %i are being populated with the same variables. Any ideas why this is?
If I try shifting all three variables like so:
my $id = shift;
my %d = shift;
my %i = shift;
I get the following error:
Odd number of elements in hash assignment
When you pass an array (or hash) to a subroutine, the subroutine will get a list of the values (or key values pairs). That's why you cannot pass two arrays (or two hashes), because the subroutine won't know where the first array ends and the second one starts.
To work around this problem, you should pass in references instead:
my %hash1 = ( foo => 'bar' );
my %hash2 = ( bar => 'baz' );
subroutine( \%hash1, \%hash2 );
sub subroutine {
my ( $hashref1, $hashref2 ) = #_;
print $hasref1->{foo}, $hashref2->{bar};
}
PS: Apart from the conceptual problem, your code also features this:
my %d = #_;
my %i = #_;
If %d and %i are both assigned the same value, it shouldn't come as a surprise when they are the same afterwards.
You might want to check out my book Intermediate Perl, about a third of which deals with references and how to work with them. This includes passing complex data structures into subroutines as well as other ways that references make your life easier. :)
some_sub( \%hash );
some_sub( { key => 'value' } );
some_sub( $hash_ref );
sub some_sub {
my( $hash_ref ) = #_;
...
}
When you pass in %diet and %iq, they both get flattened into the arg array, so in your print_result, %d contains all items in %diet and %iq.
To solve, use references of the %diet and %iq:
print_result($id, \%diet, \%iq);
Then in print_result:
my $id = shift;
my %d = %{+shift};
my %i = %{+shift};
use strict;
use warnings;
sub get_result {
...
print_result( $id, \%diet, \%iq );
# or
print_result( $id, {%diet}, {%iq} );
}
sub print_result{
my( $id, $diet_h, $iq_h ) = #_;
my %diet = %$diet_h;
my %iq = %$iq_h;
...
}
Or:
use strict;
use warnings;
sub print_result($\%\%);
sub get_result{
...
print_result($id, %diet, %iq);
}
sub print_result($\%\%){
my( $id, $diet_h, $iq_h ) = #_;
my %diet = %$diet_h;
my %iq = %$iq_h;
...
}