Can I reference a named subroutine with some arguments - perl

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

Perl. Access caller arguments (like shift, pop, etc)

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.

Perl: pass implicit variable to custom sub

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 = #_;
...
}

How can I do function partial application in Perl?

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 module's function as a reference to another module in Perl?

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);

How do you access function parameters in Perl?

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.