I have a subroutine taking multiple arguments and want to make a reference to it with one of the arguments set, so that the reference takes one argument less. Optimal case would be
my $subref = \&routine($arg1);
...
my $result = $subref->($arg2,$arg3);
In perlref there is an example with an anonymous subroutine like this, however I cannot get the equivalent with a named one working.
Below is a full fledged example of what I mean. While $func (ref to anonymous sub) and $func2 (ref to named sub, but without arguments) work. $func3 gives the error "Not a CODE reference[...]".
Have I missed something or is this actually impossible?
use strict;
use warnings;
sub args{
my $arg1 = (shift or "none");
my $arg2 = (shift or "none");
my $arg3 = (shift or "none");
my (undef, undef, undef, $function) = caller(0);
return "me: $function\narg1 = $arg1\narg2 = $arg2\narg3 = $arg3\n";
}
sub just_a_ref {
return \&args;
}
sub new_arg_anon {
my $arg = shift;
return sub{
my $arg1 = $arg;
my $arg2 = (shift or "none");
my $arg3 = (shift or "none");
my (undef, undef, undef, $function) = caller(0);
return "me: $function\narg1 = $arg1\narg2 = $arg2\narg3 = $arg3\n";
}
}
sub new_arg {
my $arg = shift;
return \&args($arg);
}
my $func = new_arg_anon("one");
print $func->("two","three"); #works fine
my $func2 = just_a_ref();
print $func2->("un", "deux", "trois"); #works fine
my $func3 = new_arg("eins");
print $func3->("zwei", "drei"); #Not a CODE reference
You have to create a new anonymous function that does exactly that. Call the target function with one argument set and passing the rest of the arguments to it. In your example the new_arg function should be:
sub new_arg {
my $arg = shift;
return sub {args($arg, #_)};
}
\&args($arg) is \( args($arg) ), that is, a reference to the return value of the function call args($arg), not a reference to the function args called with the argument $arg.
print $func3; # SCALAR(0x8000a1a50)
To make a reference to a function that executes the args subroutine with $arg as the first argument, use
sub new_arg {
my $arg = shift;
return sub { args($arg,#_) };
}
(look at that, just like Georg Mavridis's answer)
Related
In perl there is the shift function that can act on the #_(arguments of a function in scope of which it was called) if no arguments supplied.
Can I write a custom function in perl with the same behavior(some kind of my_shift)?
I tried this:
use Data::Dumper;
sub get_caller_args (;$) {
my $n = shift;
$n = defined $n? $n:1;
my $ret;
package DB {
my($t,$t1) = caller($n);
};
$ret = \#DB::args;
return $ret;
}
sub test ($#) {
my $self = shift;
print "Self: $self.\n";
print Dumper(get_caller_args()), "\n";
}
It kind of works, but
test(1,2,3)
outputs:
Self: 1.
$VAR1 = [
1,
2,
3
];
So it doesn't see changes made by shift (though it can see changes made by pop).
But I want it to act like this:
sub test {
my $self = shift;
print my_function;
}
Here the my_function called without arguments must act on the #_, in this case on the rest of the arguments, without the first as it was shifted(actually I need only to read arguments, not to do changes).
Ok, I found an answer:
use feature 'say';
sub my_shift {
say "Arguments before shift: ", #_;
shift;
say "Arguments after shift: ", #_;
}
sub test {
say "Arguments before my_shift: ", #_;
&my_shift;
say "Arguments after my_shift: ", #_;
}
The 'tricky' thing here is to call the my_shift with an ampersand(&) before the function name -- then the function gets arguments of the calling function as it's input.
However I'll not accept this self-answer, because I'm still interested if it possible to do this without that ampersand magic and what if i need to pass other arguments and access the calling function arguments at the same time, etc.
In Perl it is possible to implicitly pass the implicit variable to some built in functions, like this:
$_ = 'foo';
print; # prints foo
Is it possible to define such behavior for my sub? like this:
sub bar {
print $_[0];
}
$_ = 'foo';
&bar; # does not work
Thanks in advance.
$_[0] is first element of #_ array used to get values passed to subroutine. $_ is used as global implicit variable,
sub bar {
my ($arg) = (#_, $_);
print $arg;
}
local $_ = 'foo';
bar();
bar("explicit foo");
Single argument:
sub bar {
my $arg = #_ ? shift : $_;
...
}
Single argument (5.10+):
sub bar(_) {
my $arg = shift;
...
}
Multiple arguments:
sub bar {
my #args = #_ ? #_ : $_;
...
}
Multiple arguments (5.10+):
sub bar(_#) {
my #args = #_;
...
}
Is there any way to achieve partial application in Perl?
Suppose, I want to do something like:
sub each_file($arr, $op) {
$op->($_) for #{$arr};
...
}
sub each_line($op, $file) {
...
}
each_file($arr, each_line($op));
I want to partially apply each_line() to only $op, so it'll become a new function can be passed to $each_file, how do I express this in idiomatic Perl?
You can do this in Perl with two approaches combined:
A function which returns a function reference
Closures
Example:
sub each_file {
my ($arr, $line_fn) = #_;
$line_fn->($_) for #{$arr};
...
}
sub each_line {
my ($op, $file) = #_;
...
}
sub make_line_processor {
my ( $op ) = #_;
# This is closed over $op, which effectively becomes
# a constant for the returned function
my $fn = sub {
return each_line( $op, #_ );
};
return $fn;
}
# To call it:
each_file( $arr, make_line_processor($op) );
This can be an even more useful technique in cases where you don't want $op directly, but some expensive-to-fetch derivation of it. In which case you would calculate the derived value just once (in the make_line_processor function) and close over that instead.
# given some $op as implied by your code snippet
each_file($arr, sub { each_line($op, shift) });
# shift op will be applied when anonymous sub { … } is called
(Your code snippet doesn't make it entirely clear what you intend $op to be when you make the call to each_line. It's usually better to present small working programs.)
You can roll this functionality up into a class. Then you can overload the subroutine dereference operator to make it look like your class is really a code reference.
package Partial;
use overload '&{}' => \&call;
sub new {
my $class = shift;
my $code = shift;
bless {code => $code, args => \#_}, $class;
}
sub call {
my ($self) = #_;
return sub{ $self->{code}->(#{$self->{args}}, #_) }
}
You can then use it like this:
sub printArgs {
print join ", ", #_;
print "\n";
}
my $partial = Partial->new(\&printArgs, 'foo', 'bar');
$partial->('baz', 'bat');
# prints foo, bar, baz, bat
How can I pass a reference to a module's function as parameter in a function call of another module?
I tried the following (simple example):
This is the module that has a function (process_staff) that takes as a parameter a function reference (is_ok).
#!/usr/bin/perl
use strict;
use warnings;
package Objs::Processing;
sub new {
my ($class) = #_;
bless {} ;
}
sub process_staff {
my ($employee, $func) = #_;
if($func->is_ok($employee)) {
print "Is ok to process\n";
}
else {
print "Not ok to process\n";
}
}
1;
This is the module that implements the passed function (is_ok)
#!usr/bin/perl
use strict;
use warnings;
package Objs::Employee;
my $started;
sub new {
my ($class) = #_;
my $cur_time = localtime;
my $self = {
started => $cur_time,
};
print "Time: $cur_time \n";
bless $self;
}
sub get_started {
my ($class) = #_;
return $class->{started};
}
sub set_started {
my ($class, $value) = #_;
$class->{started} = $value;
}
sub is_ok {
my ($emp) = #_;
print "In is ok I received:\n";
use Data::Dumper;
print Dumper($emp);
return 1;
}
This is my test script that I run:
#!/usr/bin/perl
use strict;
use warnings;
use Objs::Manager;
use Objs::Processing;
my $emp = Objs::Manager->new('John Smith');
use Data::Dumper;
print Dumper($emp);
my $processor = Objs::Processing->new();
$processor->process_staff(\&$emp->is_ok); #error is here
I get a:
Not a CODE reference at testScript.pl line 14.
I also tried: $processor->process_staff(\&$emp->is_ok()); but also still does not work.
What am I doing wrong here
You appear to want to pass an object and a method to call on it; the easiest way to do that would be:
$processor->process_staff( sub { $emp->is_ok } );
where process_staff looks like:
sub process_staff {
my ($self, $func) = #_;
if ( $func->() ) {
...
or you can pass the reference and the object separately:
sub process_staff {
my ($self, $emp, $method) = #_;
if ( $emp->$method() ) {
...
$processor->process_staff( $emp, $emp->can('is_ok') );
I think this could work with:
$processor->process_staff(\&Objs::Employee::is_ok);
where you pass in the method ref.
and where you currently have
if( $func->is_ok($employee) ) {
you need
if( $func->( $employee ) ) {
This is because you cannot reference named methods simply from an object, by the syntax \&$obj->method.
However, in your example code it is not at all clear why you don't do this instead:
if( $employee->is_ok() ) {
in which case you would not need to reference the method to call in process_staff at all. There are also other ways to achieve the same method indirection that might give you better encapsulation in future.
In this expression:
$processor->process_staff(\&$emp->is_ok);
You are saying "call the method $emp->is_ok, take the return value, treat it as a CODE reference, dereference it, and return a reference to that. That doesn't work, since the return value from that sub is not a CODE reference.
To do what you want, you can use a reference to an anonymous sub to wrap the call to your object method:
$processor->process_staff( sub { $emp->is_ok } );
You can pass anonymous coderef which returns result from desired method,
$processor->process_staff(sub{ $emp->is_ok(#_) });
#_ can be dropped as is_ok method doesn't take any arguments.
It's not specifically what you asked for, but I think you simply need the following:
sub process_staff {
my ($self, $emp) = #_;
if ($emp->is_ok()) {
print "Is ok to process\n";
}
else {
print "Not ok to process\n";
}
}
$processor->process_staff($emp);
In C++ I would do something like this:
void some_func(const char *str, ...);
some_func("hi %s u r %d", "n00b", 420);
In PHP I would do like this:
function some_func()
{
$args = func_get_args();
}
some_func($holy, $moly, $guacomole);
How do I do that in Perl?
sub wut {
# What goes here?
}
You would do:
sub wut {
my #args = #_;
...
}
Perl automatically populates the special #_ variable when you call a function. You can access it in multiple ways:
directly, by simply using #_ or individual elements within it as $_[0], $_[1], and so on
by assigning it to another array, as shown above
by assigning it to a list of scalars (or possibly a hash, or another array, or combinations thereof):
sub wut {
my ( $arg1, $arg2, $arg3, #others ) = #_;
...
}
Note that in this form you need to put the array #others at the end, because if you put it in earlier, it'll slurp up all of the elements of #_. In other words, this won't work:
sub wut {
my ( $arg1, #others, $arg2 ) = #_;
...
}
You can also use shift to pull values off of #_:
sub wut {
my $arg1 = shift;
my $arg2 = shift;
my #others = #_;
...
}
Note that shift will automatically work on #_ if you don't supply it with an argument.
Edit: You can also use named arguments by using a hash or a hash reference. For example, if you called wut() like:
wut($arg1, { option1 => 'hello', option2 => 'goodbye' });
...you could then do something like:
sub wut {
my $arg1 = shift;
my $opts = shift;
my $option1 = $opts->{option1} || "default";
my $option2 = $opts->{option2} || "default2";
...
}
This would be a good way to introduce named parameters into your functions, so that you can add parameters later and you don't have to worry about the order in which they're passed.