Default argument values in subroutines - perl

I don't know how to set default arguments for subroutines. Here is what I considered:
sub hello {
print #_ || "Hello world";
}
That works fine for if all you needed was one argument. How would you set default values for multiple arguments?
I was going to do this:
sub hello {
my $say = $_[0] || "Hello";
my $to = $_[1] || "World!";
print "$say $to";
}
But that's a lot of work... There must be an easier way; possibly a best practice?

I do it with named arguments like so:
sub hello {
my (%arg) = (
'foo' => 'default_foo',
'bar' => 'default_bar',
#_
);
}
I believe Params::Validate supports default values, but that's more trouble than I like to take.

I usually do something like:
sub hello {
my ($say,$to) = #_;
$say ||= "Hello";
$to ||= "World!";
print "$say $to\n";
}
Note that starting from perl 5.10, you can use the "//=" operator to test if the variable is defined, and not just non-zero. (Imagine the call hello("0","friend"), which using the above would yield "Hello friend", which might not be what you wanted. Using the //= operator it would yield "0 friend").

Also have a look at Method::Signatures. This uses Devel::Declare to provide some extra (needed!) sugar with the keywords method and func.
Below is your example using the new func:
use Method::Signatures;
func hello ($say='Hello', $to='World!') {
say "$say $to";
}
hello( 'Hello', 'you!' ); # => "Hello you!"
hello( 'Yo' ); # => "Yo World!"
hello(); # => "Hello World!"
/I3az/

If you see the documentation of Perl Best Practices: Default argument Values by Damian Conway then you will find some important points like:
Resolve any default argument values as soon as #_ is unpacked.
It suggest that if you have many default values to set up then the cleanest way would be factoring out the defaults into tables ie., a hash and then preinitializing the argument hash with that table.
Example:
#!/usr/bin/perl
use strict;
use warning;
my %myhash = (say => "Hello", to => "Stack Overflow");
sub hello {
my ($say, $to) = #_;
$say = $say ? $say : $myhash{say};
$to = $to ? $to : $myhash{to};
print "$say $to\n";
}
hello('Perl'); # output :Perl Stack Overflow
hello('','SO'); # output :Hello SO
hello('Perl','SO'); # output :Perl SO
hello(); # output :Hello Stack Overflow
For more detail and complete example refer Perl Best Practices.

Because Perl's mechanism for passing arguments to subroutines is a single list, arguments are positional. This makes it hard to provide default values. Some built-ins (e.g. substr) handle this by ordering arguments according to how likely they are to be used -- less frequently used arguments appear at the end and have useful defaults.
A cleaner way to do this is by using named arguments. Perl doesn't support named arguments per se, but you can emulate them with hashes:
use 5.010; # for //
sub hello {
my %arg = #_;
my $say = delete $arg{say} // 'Hello';
my $to = delete $arg{to} // 'World!';
print "$say $to\n";
}
hello(say => 'Hi', to => 'everyone'); # Hi everyone
hello(say => 'Hi'); # Hi world!
hello(to => 'neighbor Bob'); # Hello neighbor Bob
hello(); # Hello world!
Note: The defined-or operator // was added in Perl v5.10. It's more robust than using a logical or (||) as it won't default on the logically false values '' and 0.

I like this way the most: Since Perl 5.10 you can use // to check if a variable is defined or not and provide an alternative value in case it is not.
So, an easy example is:
my $DEFAULT_VALUE = 42;
sub f {
my ($p1, $p2) = #_;
$p1 //= 'DEFAULT';
$p2 // = $DEFAULT_VALUE;
}
Another option is using the shift instruction to get the params from #_:
sub f {
my $p1 = shift // 'DEFAULT';
}
Source: https://perlmaven.com/how-to-set-default-values-in-perl

There's the Attribute::Default module on CPAN. Probably cleaner than this, and avoids a couple of complexities (such as, what if you want to pass false to your subroutine?).
I've also seen people use my $var = exists #_[0] ? shift : "Default_Value";, but Perl's documentation notes that calling exists on arrays is deprecated, so I wouldn't really recommend it.
Snippet of Attribute::Default from the doc page:
sub vitals : Default({age => 14, sex => 'male'}) {
my %vitals = #_;
print "I'm $vitals{'sex'}, $vitals{'age'} years old, and am from $vitals{'location'}\n";
}
# Prints "I'm male, 14 years old, and am from Schenectady"
vitals(location => 'Schenectady');

The best way to address your problem have been discussed in the other answers.
One thing that strikes me though is that you state that:
sub hello {
print #_ || "Hello world";
}
And that works fine for if all you needed was one argument.
Have you actually tried that code? It will print the number of arguments or, when none provided, Hello World!
The reason for this is that the ||-operator takes precedence and forces the left-hand side in scalar context, thus reducing #_ to the number of arguments you provide, NOT the arguments itself!
have a look at perlop for more information on operators in Perl.
HTH,
Paul

For more sugar, see also Method::Signatures:
func add($this = 23, $that = 42) {
return $this + $that;
}

Related

How to call subroutine in perl using variable name [duplicate]

This question already has answers here:
How can I elegantly call a Perl subroutine whose name is held in a variable?
(12 answers)
Closed 6 years ago.
Let say I have one array that contains all subroutine name and I want to call all one by one.
foreach $sub (#arr){
print "Calling $sub\n";
#---How to call $sub?----
&$sub; ## will not work
}
Your code is correct in general, but you need to turn off strict 'refs' to make Perl allow you to use variable content as code refs.
use strict;
use warnings;
sub foo { print "foo" }
sub bar { print "bar" }
my #arr = qw/foo bar/;
foreach my $sub (#arr) {
no strict 'refs';
print "Calling $sub\n";
&$sub();
}
The output here is:
Calling foo
fooCalling bar
bar
I've also added parenthesis () after the call. That way we pass no arguments to %$sub. If we do not those, the #_ argument list of the current subroutine will be used.
However, you should probably not do this. Especially if #arr contains user input, this is a big problem. Your user can inject code. Consider this:
my #arr = qw/CORE::die/;
Now we get the following output:
Calling CORE::die
Died at /home/code/scratch.pl line 1492.
Oops. You don't want to do this. The die example is not very bad, but like this you could easily call code in some different package that wasn't intended.
It's probably better to make a dispatch table. There is a whole chapter about those in Higher Order Perl by Mark Jason Dominus, which you can download for free on his website.
It basically means you put all the subs into a hash as code references, and then call those in your loop. That way you can control which ones are allowed.
use strict;
use warnings;
sub baz { print "baz" }
my %dispatch = (
foo => sub { print "foo" },
bar => sub { print "bar" },
baz => \&baz,
);
my #arr = qw/foo bar baz wrong_entry/;
foreach my $sub ( #arr ) {
die "$sub is not allowed"
unless exists $dispatch{$sub};
$dispatch{$sub}->();
}
This outputs:
foobarbaz
wrong_entry is not allowed at /home/code/scratch.pl line 1494.
You want to do that using code references.
foreach my $sub (#arr)
{
$sub->();
}
where #arr contains scalars such as
my $rc = sub { print "Anonymous subroutine\n" };
or
sub func { print "Named sub\n" }
my $rc = \&func;
You can manipulate these scalars as you would any other, to form your array. However, it is more common and useful to use them as values in a hash, creating a dispatch table.
See perlref and perlsub, and (for example) this post and links in it for comments and details.

Check if a subroutine is being used as an lvalue or an rvalue in Perl

I'm writing some code where I am using a subroutine as both an lvalue and an rvalue to read and write database values. The problem is, I want it to react differently based on whether it is being used as an lvalue or an rvalue.
I want the subroutine to write to the database when it is used as an lvalue, and read from the database when it is used as an rvalue.
Example:
# Write some data
$database->record_name($subscript) = $value;
# Read some data
my $value = $database->record_name($subscript);
The only way I can think of the make this work is to find a way for the subroutine to recognize whether it is being used as an lvalue or an rvalue and react differently for each case.
Is there a way to do this?
Deciding how to behave on whether it was called as an lvalue or not is a bad idea since foo(record_name(...)) would call it as an lvalue.
Instead, you should decide how to behave on whether it is used as an lvalue or not.
You can do that by returning a magical value.
use Variable::Magic qw( cast wizard );
my $wiz = wizard(
data => sub { shift; \#_ },
get => sub { my ($ref, $args) = #_; $$ref = get_record_name(#$args); },
set => sub { my ($ref, $args) = #_; set_record_name(#$args, $$ref); },
);
sub record_name :lvalue {
cast(my $rv, $wiz, #_);
return $rv;
}
A little test:
use Data::Dumper;
sub get_record_name { print("get: #_\n"); return "val"; }
sub set_record_name { print("set: #_\n"); }
my $x = record_name("abc", "def"); # Called as rvalue
record_name("abc", "def") = "xyz"; # Called as lvalue. Used as lvalue.
my $y_ref = \record_name("abc", "def"); # Called as lvalue.
my $y = $$y_ref; # Used as rvalue.
$$y_ref = "xyz"; # Used as lvalue.
Output:
get: abc def
set: abc def xyz
get: abc def
set: abc def xyz
After seeing this, you've surely learned that you should abandon the idea of using an lvalue sub. It's possible to hide all that complexity (such as by using sentinel), but the complexity remains. The fanciness is not worth all the complexity. Use separate setters and getters or use an accessor whose role is based on the number of parameters passed to it ($s=acc(); vs acc($s)) instead.
For this situation you might like to try my Sentinel module.
It provides a function you can use in the accessor, to turn it into a more get/set style approach. E.g. you could
use Sentinel qw( sentinel );
sub get_record_name { ... }
sub set_record_name { ... }
sub record_name
{
sentinel get => \&get_record_name,
set => \&set_record_name,
obj => shift;
}
At this point, the following pairs of lines of code are equivalent
$name = $record->record_name;
$name = $record->get_record_name;
$record->record_name = $new_name;
$record->set_record_name( $new_name );
Of course, if you're not needing to provide the specific get_ and set_ prefixed versions of the methods as well, you could inline them as closures.
See the module docs also for further ideas.
In my opinion, lvalue subroutines in Perl were a dumb idea. Just support ->record_name($subscript, $value) as a setter and ->record_name($subscript) as a getter.
That said, you can use the Want module, like this
use Want;
sub record_name:lvalue {
if ( want('LVALUE') ) {
...
}
else {
...
}
}
though that will also treat this as an LVALUE:
foo( $database->record_name($subscript) );
If you want only assignment statements to be treated specially, use want('ASSIGN') instead.

Perl multiple sub param without comma

Is it possible with pert to achieve the following syntax?
sub a {
my ($first, $second) = #_;
print "$first $second";
}
sub b {
my ($param, $code) = #_;
my $res = $code->();
return "$param $res";
}
a 'param1' b 'param2' => sub { return "param3" };
#output would be "param1 param2 param3"
a is sub, which would get inside #_ 'param1' and whatever b (which would got 'param2' and a subref inside #_) returns. I like having no comma before 'b'. Is it possible?
I strongly recommend against this. What is your motivation to omit the comma?
Language X doesn't require a comma here.
Perl isn't X. There are a lot of features that X may have, but Perl doesn't. This also includes static typing, indentation-sensitive parsing, and Lisp-style macros. If you absolutely need X's features, maybe you should be using X.
I am writing a DSL in Perl where the comma would be annoying.
I am aware of this trend to write elaborate APIs that remotely look like ordinary text, and calling them a “DSL”. They are not; a DSL requires you to actually parse something. And if you're writing an API, it would better be idiomatic in the host language. Even if that involves stray commas and such.
I really want to do this for whatever reason, no matter how fragile the result.
In this specific case, I can write code to do as you wish. It uses the absurd and discouraged “dative“ form of method calls (also known as “indirect object notation”).
The param1 will be a class on which we call the a method. The argument list will be a call to b:
use feature 'say';
package param1 {
sub a {
my ($first, $second) = #_;
say "$first $second";
}
}
sub b {
my ($param, $code) = #_;
my $res = $code->();
return "$param $res";
}
a param1 b param2 => sub { "param3" }; # look, optional quotes for param1
Of course, that's merely syntactic sugar for 'param1'->a(b(param2 => sub { 'param3' })). And it requires you to know all values of param1 in advance – unless you create an object first that wraps the first arg:
use feature 'say';
package MyApi {
sub a {
my ($first, $second) = #_;
say "$$first $second";
}
}
sub b {
my ($param, $code) = #_;
my $res = $code->();
return "$param $res";
}
sub api($) { bless \shift() => 'MyApi' }
my $param1 = api 'param1';
a $param1 b param2 => sub { "param3" };
But that's silly.
I still want to do this, but without that fragile nonsense. I also do not care about how much effort I have to expend to make this work.
You can add keywords to the Perl parser that allow you to take over parsing. This requires you to have a certain amount of knowledge about Perl's parser API, and your code will not work on older Perls. Because you probably don't want to write your parser in C, you might want to look at something like Devel::Declare::Lexer, but these modules tend to be a bit iffy. Good luck to you!

When should I use subroutine attributes?

I don't grok Perl subroutine attributes at all.
I have never seen them in actual code and perldoc perlsub and the perldoc attributes fail to answer my questions:
What are attributes useful for?
What do they bring to the table that is not already present in Perl best practices?
Are there any CPAN modules (well-known or otherwise) that make use of attributes?
It would be great if someone could put together a detailed example of attributes being used the way they should be.
For those who are as clueless as me, attributes are the parameters after the colon in the attributes SYNOPSIS examples below:
sub foo : method ;
my ($x,#y,%z) : Bent = 1;
my $s = sub : method { ... };
use attributes (); # optional, to get subroutine declarations
my #attrlist = attributes::get(\&foo);
use attributes 'get'; # import the attributes::get subroutine
my #attrlist = get \&foo;
Attributes allow you annotate variables to perform auto-magic behind the scenes. A similar concept is java annotations. Here is a small example that might help. It uses Attribute::Handlers to create the loud attributes.
use Attribute::Handlers;
sub UNIVERSAL::loud : ATTR(CODE) {
my ( $pkg, $sym, $code ) = #_;
no warnings 'redefine';
*{$sym} = sub {
return uc $code->(#_);
};
}
sub foo : loud {
return "this is $_[0]";
}
say foo("a spoon");
say foo("a fork");
Whenever a sub is declared with the loud attribute the UNIVERSAL::loud callback triggers exposing meta-information on the sub. I redefined the function to actually call an anonymous sub, which in turn calls the original sub and passes it to uc
This outputs:
THIS IS A SPOON
THIS IS A FORK
Now let's looks a the variable example from the SYNOPSIS:
my ($x,#y,%z) : Bent = 1;
Breaking this down into small perl statement without taking into account attributes we have
my $x : Bent
$x = 1;
my #y : Bent
#y = 1;
my %Z : Bent
%z = 1;
We can now see that each variable has been attributed the Bent annotation in a concise way, while also assigning all variables the value 1. Here is a perhaps more interesting example:
use Attribute::Handlers;
use Tie::Toggle;
sub UNIVERSAL::Toggle : ATTR(SCALAR) {
my ($package, $symbol, $referent, $attr, $data, $phase) = #_;
my #data = ref $data eq 'ARRAY' ? #$data : $data;
tie $$referent, 'Tie::Toggle', #data;
}
my $x : Toggle;
say "x is ", $x;
say "x is ", $x;
say "x is ", $x;
Which outputs:
x is
x is 1
x is
You can use this to do logging, create test annotations, add type details to variables, syntactic sugar, do moose-ish role composition and many other cool things.
Also see this question: How do Perl method attributes work?.
What are attributes useful for?
It is a way to pass some additional information (the attribute)
about a variable or subroutine.
You can catch this information (the attribute) as a string ( at COMPILE TIME !)
and handle it however you like. You can generate additional code,
modify stashs ... . It is up to you.
What do they bring to the table that is not already present in Perl best practices?
Sometimes it makes life easier. See example below.
Some people use it. Do a : find . -name *.p[ml] | xargs grep 'use attributes;'
at your perl installation path to look at packages using attributes.
Catalyst extensively uses attributes to handle requests based on the given path.
Example :
Say you like to execute subroutines in a certain order. And you want to tell the
subroutine when it has to execute ( by a run number RUNNR ). Using attributes
the implementation could be :
#!/usr/bin/env perl
use strict;
use warnings;
use Runner; # immplements the attribute handling
# some subroutines to be scheduled :
# attibutes automatically filling #$Runner::schedule
sub func_a : RUNNR(2) {return "You called func_a !"};
sub func_b : RUNNR(1) {return "You called func_b !"};
sub func_c : RUNNR(3) {return "You called func_c !"};
# run the subroutines according to the their RUNNR
sub run {
# #$Runner::schedule holds the subroutine refs according
# to their RUNNR
foreach my $func (#$Runner::schedule) {
if ( defined $func ) {
print "Running : $func --> ", $func->(), "\n";
}
}
}
print "Starting ...\n\n";
run();
print "\nDone !\n";
The attribute handling is in package Runner using the MODIFY_CODE_ATTRIBUTES
hook.
package Runner;
use strict;
use warnings;
use attributes;
BEGIN {
use Exporter ();
our (#ISA, #EXPORT);
#ISA = qw(Exporter);
#EXPORT = qw(&MODIFY_CODE_ATTRIBUTES); # needed for use attributes;
}
# we have subroutines with attributes : <type> is CODE in MODIFY_<type>_ATTRIBUTES
# MODIFY_CODE_ATTRIBUTES is executed at COMPILE TIME ! try perl -c <prog_name> to prove it :-)
sub MODIFY_CODE_ATTRIBUTES {
# for each subroutine of a package we get
# the code ref to it and the attribute(s) as string
my ($pckg, $code_ref, #attr) = #_;
# whatever you like to do with the attributes of the sub ... do it
foreach my $attr (#attr) {
# here we parse the attribute string(s), extract the number and
# save the code ref of the subroutine
# into $Runner::schedule array ref according to the given number
# that is how we 'compile' the RUNNR of subroutines into
# a schedule
if ( $attr =~ /^RUNNR\((\d+)\)$/ ) {
$Runner::schedule->[$1] = $code_ref;
}
}
return(); # ERROR if returning a non empty list
}
1;
The output will be :
Starting ...
Running : CODE(0x129c288) --> You called func_b !
Running : CODE(0x129c2b8) --> You called func_a !
Running : CODE(0x12ed460) --> You called func_c !
Done !
If you really want to understand what attributes do and when what happens you
have to 'perldoc attributes', read it step by step and play with it. The interface
is cumbersome but in principle you hook in at compile time and handle
the information provided.
You can use attributes to tie a variable upon creation. See the silly module Tie::Hash::Cannabinol which lets you do:
use Tie::Hash::Cannabinol;
my %hash;
tie %hash, 'Tie::Hash::Cannabinol';
## or ##
my %hash : Stoned;
Edit: upon deeper examination, T::H::C (hehe) uses Attribute::Handlers too (as JRideout's answer already suggests) so perhaps that is the place to look.
Here's an example that I ran on perl 5.26.1 with Carp::Assert. Perl attributes seem to generate nice syntax for decorator pattern. Was sort of a pain to implement MODIFY_CODE_ATTRIBUTES though b.c. of the damn eval and Perl's auto reference counting.
use strict;
use Carp::Assert;
# return true if `$func` is callable, false otherwise
sub callable {
my ($func) = #_;
return defined(&$func);
}
# get the symbol table hash (stash) and the inverse of it the
# coderef table hash (crtash) where coderefs are keys and symbols are
# values. The return value is a pair of hashrefs ($stash, $crtash)
sub get_stash_and_crtash {
my $stash = eval("\\%" . __PACKAGE__ . "::");
my %coderef_to_sym;
while (my ($k, $v) = each(%$stash)) {
$coderef_to_sym{$v} = $k if (callable($v));
}
return ($stash, \%coderef_to_sym);
}
# return an eval string that inserts `$inner` as the first argument
# passed into the function call string `$outer`. For example, if
# `$inner` is "$foo" (the lvalue NAME, not the lvalue itself), and
# `$outer` is "bar(1)", then the resulting eval string will be
# "bar($foo, 1)"
sub insert_context {
my ($inner, $outer) = #_;
my $args_pat = qr/\((.*)\)$/;
$outer .= '()' if ($outer !~ /\)$/);
$outer =~ /$args_pat/;
$1 ?
$outer =~ s/$args_pat/($inner, $1)/ :
$outer =~ s/$args_pat/($inner)/;
return $outer;
}
# hook that gets called when appending attributes to functions.
# `$cls` is the package at the point of function declaration/definition,
# `$ref` is the coderef to the function being declared/defined,
# `#attrs` is a list to the attributes being added. Attributes are function
# call strings.
sub MODIFY_CODE_ATTRIBUTES {
my ($cls, $ref, #attrs) = #_;
assert($cls eq 'main');
assert(ref($ref) eq 'CODE');
for (#attrs) {
assert(/^appender_d\(.*\)$/ || $_ eq 'upper_d');
}
my #non_decorators = grep { !/^\w+_d\b/ } #attrs;
return #non_decorators if (#non_decorators);
my ($stash, $crtash) = get_stash_and_crtash();
my $sym = $crtash->{$ref};
$stash->{$sym} = sub {
my $ref = $ref;
my $curr = '$ref';
for my $attr (#attrs) {
$curr = insert_context($curr, $attr);
}
eval("${curr}->()");
};
return ();
}
sub appender_d {
my ($func, $chars) = #_;
return sub { $func->() . $chars };
}
sub upper_d {
my ($func) = #_;
return sub { uc($func->()) };
}
sub foo : upper_d appender_d('!') {
return "foo";
}
sub main {
print(foo());
}
main();

How can I execute Perl code specified on the command line?

I want something like..
all_objects.pl
my $sub = $ARGV[1];
...
#objs = get_all_objects();
for my $obj (#objs) {
// invoke subroutine $sub with param as $obj.
}
now if I say
all_objects.pl "print 'x '"
all_objects.pl "print '$_ '"
I should get
obj1 obj2 obj3 ...
i.e. the command line arg act as a subroutine in some way. Can this be achieved?
eval "" is bad. Use something like the following, if it fulfills your needs:
my ($sub) = #ARGV;
my %prepared = (
print => sub { print "$_[0]\n" },
woof => sub { $_[0]->woof },
meow => sub { $_[0]->meow },
);
#objs = get_all_objects();
for my $obj (#objs) {
$prepared{$sub}->($obj);
}
Update: For debugging purposes, Perl has a debugger: perldoc perldebug
Eval is evil unless you really know what you're doing (think of it as an unshielded thermonuclear nuke -- sure you could handle one if you had to, and it might even save the world, but you'd be better off leaving it as a last resort, and let the nuclear physicists deal with it.)
You could put your all_objects.pl code into a module, and then use the module on the command line:
put this into AllObjects.pm:
package AllObjects;
use strict;
use warnings;
sub get_all_objects
{
# code here...
}
1;
Now on the command line:
perl -I. -MAllObjects -wle'for my $obj (AllObjects::get_all_objects()) { print "object is $obj" }'
However, it's not really clear what you are trying to achieve with the overall design.
You can read more about perl command-line invokation at perldoc perlrun, and making modules at perldoc perlmod (as well as many posts here on Stack Overflow).