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 = #_;
...
}
Related
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)
I'm writing a subroutine that takes a number of arguments. Most of those arguments are the standard pass-by-value sort, where changes made to them within the subroutine don't matter outside of it. But one of them is an object (blessed reference) that I'd like to make changes to that are available outside of the subroutine, if it's passed in. If it's not passed in, I would like to instantiate it and treat it the same way as if it were passed in (but returning it in the end).
For example:
my $foo = Private::Foo->new();
# $foo->{'something'} eq 'old value'
Private::Foo->do_things('abc', 'xyz', $foo);
# $foo->{'something'} eq 'new value'
my $foo2 = Private::Foo->do_things('def');
# $foo2->{'something'} eq 'old value'
package Private::Foo;
# ...
sub do_things {
my ($self, $arg1, $arg2, $foo) = #_;
unless (defined $foo) {
$foo = Private::Foo->new();
}
if ($arg1 eq 'abc') {
$foo->{'something'} = 'new value';
return;
}
return $foo;
}
I'd like to do this with as clean of syntax as possible, and I'm fine using any features available in Perl v5.22 and higher. (I've tried to figure out how to do this using refaliasing, but it isn't very clean.)
What am I missing?
First of all, subroutine arguments are always passed by reference.
$ perl -e'sub f { $_[0] = "def"; } my $x = "abc"; f($x); CORE::say $x;'
def
More importantly, your code does exactly what you asked already.
$ perl -e'
{
package Private::Foo;
sub new { my $class = shift; bless({ something => "old_value" }, $class) }
sub do_things {
my ($self, $arg1, $arg2, $foo) = #_;
unless (defined $foo) {
$foo = Private::Foo->new();
}
if ($arg1 eq "abc") {
$foo->{something} = "new value";
return;
}
return $foo;
}
}
use feature qw( say );
my $foo = Private::Foo->new();
Private::Foo->do_things("abc", "xyz", $foo);
say $foo->{something};
my $foo2 = Private::Foo->do_things("def");
say $foo2->{something};
'
new value
old_value
That said, you could clean up your method some:
sub do_things {
my ($class, $arg1, $arg2, $foo) = #_;
$foo //= $class->new();
if ($arg1 eq 'abc') {
$foo->{something} = 'new value';
}
return $foo;
}
It would be even better if you cleaned up your calling convention.
Private::Foo->do_something($arg1, $arg2, $foo);
my $foo2 = Private::Foo->do_something($arg1, $arg2);
makes far less sense than
$foo->do_something($arg1, $arg2);
( my $foo2 = Private::Foo->new )->do_something($arg1, $arg2);
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
If I have the following code
sub a {
my $id = shift;
# does something
print &a_section($texta);
print &a_section($textb);
sub a_section {
my $text = shift;
# combines the $id and the $text to create and return some result.
}
}
Assuming a_section is called only by a, will I run into a memory leak, variable dependability, or other problem?
I am exploring this as an alternative so I can avoid the necessity of passing $id to a_section.
First, it's not a private sub. It's fully visible from the outside. Two, you will have problems.
$ perl -wE'
sub outer {
my ($x) = #_;
sub inner { say $x; }
inner();
}
outer(123);
outer(456);
'
Variable "$x" will not stay shared at -e line 4.
123
123 <--- XXX Not 456!!!!
You could do:
sub a {
my $id = shift;
local *a_section = sub {
my $text = shift;
# combines the $id and the $text to create and return some result.
};
print a_section($texta);
print a_section($textb);
}
(You can call the inner sub recursively using a_section(...).)
or:
sub a {
my $id = shift;
my $a_section = sub {
my $text = shift;
# combines the $id and the $text to create and return some result.
};
print $a_section->($texta);
print $a_section->($textb);
}
(Use __SUB__->(...) if you want to call the inner sub recursively to avoid memory leak, available in Perl 5.16+.)
In a Perl object, I'm trying to add a new field into $self from within a File::Find wanted() sub.
use File::Find;
sub _searchForXMLDocument {
my ($self) = #_;
if($_ =~ /[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
}
sub runIt{
my ($self) = #_;
find (\&_searchForXMLDocument, $self->{_path});
print $self->{_xmlDocumentPath};
}
_searchForXMLDocument() searches for an XML Document within $self->{_path} and is supposed to append that XML path to $self->{_xmlDocumentPath} but when I try to print it, it remains uninitialized. How do I add the field in $self?
Use of uninitialized value in print at /home/scott/workspace/CCGet/XMLProcessor.pm line 51.
You aren't calling _searchForXMLDocument() in an OO manner, so your $self object isn't being passed to it. This should do the trick now. Use a closure for your method and you have access to $self;
sub runIt{
my ($self) = #_;
my $closure = sub {
if($_ !~ m/[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
};
find(\&$closure, $self->{_path});
print $self->{_xmlDocumentPath};
}
The first argument to find() needs to carry two pieces of information: the test condition, and the object you're working with. The way to do this is with a closure. The sub { ... } creates a code ref, like you get from \&_searchForXMLDocument, but the closure has access to lexical variables in the enclosing scope, so the current object ($self) is associated with the closure.
sub _searchForXMLDocument {
my ($self) = #_;
if($_ =~ /[.]+\.xml/) {
$self->{_xmlDocumentPath} = $_;
}
}
sub runIt{
my ($self) = #_;
find (sub { $self->_searchForXMLDocument (#_) }, $self->{_path});
print $self->{_xmlDocumentPath};
}
I think you're looking for something like this:
package XMLDocThing;
use strict;
use warnings;
use English qw<$EVAL_ERROR>;
use File::Find qw<find>;
...
use constant MY_BREAK = do { \my $v = 133; };
sub find_XML_document {
my $self = shift;
eval {
find( sub {
return unless m/[.]+\.xml/;
$self->{_xmlDocumentPath} = $_;
die MY_BREAK;
}
, $self->{_path}
);
};
if ( my $error = $EVAL_ERROR ) {
die Carp::longmess( $EVAL_ERROR ) unless $error == MY_BREAK;
}
}
...
# meanwhile, in some other package...
$xmldocthing->find_XML_document;
You pass a closure to find and it can access $self from the containing scope. File::Find::find has no capacity to pass in baggage like objects.