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.
Related
In perl, a class "Lamba" implements a method called "process".
use Lambda;
my $omega = Lambda->new();
$omega->process();
in the process method, how can we get the name of it's invocant?
package Lambda;
use strict;
sub new {
my $class = shift;
my $self = {};
bless ($self, $class);
return $self;
}
sub process {
my $self = shift;
my $invocant;
#
# ??? what is the variable name of my caller ???
#
# ie. how to set $invocant = 'omega';
#
return $self;
}
Update
I've just realised that you want the name of the variable that was used to call the process method. You can't do that without a source filter, because there may be several names all referring to the same object, like this
my $omega = Lambda->new;
my $aa = $omega;
my $bb = $omega;
$aa->process;
and there is quite sensibly no way to get hold of the name actually used to call the method
This is an X Y problem, and is comparable to asking how to use data strings to name a variable. Variable identifiers are purely for the consumption of the programmer, and if you think your program needs to know them then you have a design problem. If you explain exactly what it is that you want to achieve via this mechanism then I am sure we could help you better
Original solution
I've left this here in cased someone arrives at this page looking for a way to discover the name of the calling code
You can use the caller function
A call without parameters like caller() will return the package name, source file name, and line number where the current call was made
You get get more detailed information by adding a parameter that represents the depth on the call stack that you want to examine, so caller(0) will return information about the current subroutine, while the values from caller(1) will be about the calling subroutine
If we change your main code to use a subroutine to call the method, then we can write this
Lambda.pm
package Lambda;
use strict;
use warnings;
sub new {
bless {}, shift;
}
sub process {
my $self = shift;
#
# ??? what is the variable name of my caller ???
#
# ie. how to set $invocant = 'omega';
#
my $calling_sub = (caller(1))[3];
print "Called by $calling_sub\n";
return $self;
}
1;
main.pl
use strict;
use warnings 'all';
use Lambda;
mysub();
sub mysub {
my $omega = Lambda->new;
$omega->process;
}
output
Called by main::mysub
The caller function returns information about the calling subroutine/sourcecode line:
sub process {
my $self = shift;
print join(', ',caller(0)); # Some of these values will be undef!
}
The manual page shows this example:
($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash)
= caller($i);
Increase $i to walk further through the stacktrace (reverse list of callers):
my $i = 0;
while (my #ci = caller($i++)) {
print "$i. ".$ci[1].':'.$ci[2]."\n";
}
Starts with $i=0 and increases $i after passing it to the caller() function. Prints a stacktrace back to the line of the script starting the current process.
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
#! /usr/bin/perl
# this is the object tester
{package Hate;
sub status {
my $class = shift;
print "-- $_[0] $_[1] $_[2]\n";
print "$class exists and ", $class->stats($_[0]), "and ", $class->type($_[1]), "and ", $class->location($_[2]);
}
}
{package Grudge;
#ISA = "Hate";
sub stats{"$_[0]\n"}
sub type{"$_[0]\n"}
sub location{"$_[0]\n"}
}
Hate::status("Grudge", #ARGV);
i ran ./program one two three
this output is what i expected
Grudge exists and one
and two
and three
this is what i got
Grudge exists and Grudge
and Grudge
and Grudge
However when i use this script
#! /usr/bin/perl
# this is the object tester
{package Hate;
sub status {
my $class = shift;
print "-- $_[0] $_[1] $_[2]\n";
print "$class exists and ", $class->stats($_[0]), "and ", $class->type($_[1]), "and ", $class->location($_[2]);
}
}
{package Grudge;
#ISA = "Hate";
sub stats{"$_[1]\n"}
sub type{"$_[1]\n"}
sub location{"$_[1]\n"}
}
Hate::status("Grudge", #ARGV);
This worked.
In your first example, $class->stats($_[0]) is called as a method and is passed an object as the first argument, which needs to be shifted away as you did in Hate::status. That's why $_[1] works: because the first argument to the method is actually the second item in #_ (after $self).
Things become a lot more clearer, and manageable, if you unpack arguments out of #_ at the beginning of the function, e.g.
{
package Hate;
sub status {
my ($class, $stats, $type, $location) = #_;
print "-- $stats $type $location\n";
print "$class exists and ", $class->stats($stats), ...;
}
}
{
package Grudge;
our #ISA = qw(Hate);
sub stats { my ($self, $stats) = #_; $stats; }
sub type { my ($self, $type) = #_; $type; }
sub location { my ($self, $location) = #_; $location; }
}
Hate::status('Grudge', #ARGV);
As a side note, your use of objects is not typical - if you provided more code, we may be able to provide a more idiomatic Perl solution. For example, none of your objects have constructors, and at the moment the three Grudge methods appear to do the same thing. It's also not clear why Grudge is a subclass of Hate (as indicated by the #ISA).
If you really don't want Grudge to be passed its own name as an argument you can call its methods as functions via &{$class . '::stats'}() but you will have to disable strict subs. It's generally better to call methods as you are doing now.
I'm trying to add some functionality to our code base by using tied scalars.
We have a function which is specified to return scalars. I thought I could add some features to the system by tie-ing these scalars before returning them, but it looks like the FETCH method is called just before the return, which results in an untied scalar being returned.
Is there any way around this?
I really want to keep the subroutine's interface (returning scalars) intact if it's at all possible.
use strict;
use warnings;
main();
sub GetThing{
my $thing;
tie $thing, 'mything', #_;
return $thing;
}
sub main {
my %m;
$m{pre} = GetThing('Fred');
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
require Tie::Scalar;
my #ISA = qw(Tie::StdScalar);
sub TIESCALAR {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
sub FETCH {
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
}
Desired output:
1
ACCESS ALERT!
NAME: 'Fred'
2
ACCESS ALERT!
NAME: 'Fred'
3
I can get the desired output by returning a reference, and dereferencing on each access, but that ruins our established interface, and makes it more confusing for our users.
--Buck
As DVK said, tie applies to containers, so isn't useful for returned values.
For that, you use overloading. An example (not all the possible overloaded operations are supplied; see http://perldoc.perl.org/overload.html#Minimal-set-of-overloaded-operations):
use strict;
use warnings;
main();
sub GetThing{
my $thing;
$thing = "mything"->new(#_);
return $thing;
}
sub main {
my %m;
$m{pre} = GetThing('Fred');
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
use overload 'fallback' => 1, '""' => 'FETCH';
sub new {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
sub FETCH {
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
}
As mentioned in other answers, tie applies to containers, and not to values, so there is no way to assign a tied variable to another variable and retain the tied properties.
Since assignment is out, you need to pass the container into the GetThing routine. You can do this by reference as follows:
use strict;
use warnings;
main();
sub GetThing{
tie ${$_[1]}, 'mything', $_[0];
}
sub main {
my %m;
GetThing('Fred' => \$m{pre});
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
require Tie::Scalar;
my #ISA = qw(Tie::StdScalar);
sub TIESCALAR {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
sub FETCH {
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
}
which produces the correct output.
However, if you want to retain the assignment, you will need to use overloading, which applies to values (actually to objects, but they themselves are values). Without more detail on your intended purpose it is hard to give a complete answer, but this will meet your stated requirements:
use strict;
use warnings;
main();
sub GetThing{
return mything->new( shift );
}
sub main {
my %m;
$m{pre} = GetThing('Fred');
print "1\n";
print $m{pre};
print "2\n";
print $m{pre};
print "3\n";
}
package mything;
sub new {
my $class = shift;
bless {
name => shift || 'noname',
}, $class;
}
use overload '""' => sub { # '""' means to overload stringification
my $self = shift;
print "ACCESS ALERT!\n";
return " NAME: '$self->{name}'\n";
};
Both ties and overloads can get complicated, so read through all of the documentation if anything is not clear.
First, the exact method of doing what you are proposing seems technically impossible:
Tied variables have the tie attached to the variable itself, not to its value.
In Perl, subroutine's return values are returned by value, meaning you take the value passed to return, access it (in you case, accessing the tied variable and calling FETCH in the process) - and then copy that value! Which means that what the caller gets is a scalar VALUE, not a scalar variable (tied or untied).
Your confusion, in short, seems to stem from mixing together variables (locations in program's symbol table) and values stored in those variables.
Second, you were somewhat unclear as to what exactly you are trying to achieve, so it's hard to propose how to achieve what you want. But assuming, based on your description, that you wanted to call some method upon subroutine's return (possibly passing it the return value), you CAN do that.
To do so, you need to employ what fancy people call aspect programming. The politically (and technically) correct way of doing it in Perl is by using Moose.
However, you can DIY it, by basically replacing the original method with a wrapper method.
The exact mechanics of both Moose and DIY approaches can be seen in the first two answers to the following SO question, so I won't copy/paste them here, hope you don't mind:
Simulating aspects of static-typing in a duck-typed language
If you're feeling adventurous, you could also use the Scalar::Defer module which provides a general-purpose mechanism for a scalar variable to compute a value lazily, either once or on each access.
How do you either:
have a sub return a sub
or
execute text as code
in Perl?
Also, how do I have an anonymous function store state?
A sub returns a sub as a coderef:
# example 1: return a sub that is defined inline.
sub foo
{
return sub {
my $this = shift;
my #other_params = #_;
do_stuff();
return $some_value;
};
}
# example 2: return a sub that is defined elsewhere.
sub bar
{
return \&foo;
}
Arbitrary text can be executed with the eval function: see the documentation at perldoc -f eval:
eval q{print "hello world!\n"};
Note that this is very dangerous if you are evaluating anything extracted from user input, and is generally a poor practice anyway as you can generally define your code in a coderef as in the earlier examples above.
You can store state with a state variable (new in perl5.10), or with a variable scoped higher than the sub itself, as a closure:
use feature 'state';
sub baz
{
state $x;
return ++$x;
}
# create a new scope so that $y is not visible to other functions in this package
{
my $y;
sub quux
{
return ++$y;
}
}
Return a subroutine reference.
Here's a simple example that creates sub refs closed over a value:
my $add_5_to = add_x_to(5);
print $add_5_to->(7), "\n";
sub add_x_to {
my $x = shift;
return sub { my $value = shift; return $x + $value; };
}
You can also work with named subs like this:
sub op {
my $name = shift;
return $op eq 'add' ? \&add : sub {};
}
sub add {
my $l = shift;
my $r = shift;
return $l + $r;
}
You can use eval with an arbitrary string, but don't do it. The code is hard to read and it restarts compilation, which slows everything down. There are a small number of cases where string eval is the best tool for the job. Any time string eval seems like a good idea, you are almost certainly better off with another approach.
Almost anything you would like to do with string eval can be achieved with closures.
Returning subs is easy by using the sub keyword. The returned sub closes over the lexical variables it uses:
#!/usr/bin/perl
use strict; use warnings;
sub mk_count_from_to {
my ($from, $to) = #_;
return sub {
return if $from > $to;
return $from ++;
};
}
my $c = mk_count_from_to(-5, 5);
while ( defined( my $n = $c->() ) ) {
print "$n\n";
}
5.10 introduced state variables.
Executing text as Perl is accomplished using eval EXPR:
the return value of EXPR is parsed and executed as if it were a little Perl program. The value of the expression (which is itself determined within scalar context) is first parsed, and if there weren't any errors, executed in the lexical context of the current Perl program, so that any variable settings or subroutine and format definitions remain afterwards. Note that the value is parsed every time the eval executes
Executing arbitrary strings will open up huge gaping security holes.
You can create anonymous subroutines and access them via a reference; this reference can of course be assigned to a scalar:
my $subref = sub { ... code ... }
or returned from another subroutine
return sub { ... code ... }
If you need to store states, you can create closures with lexical variables defined in an outer scope like:
sub create_func {
my $state;
return sub { ... code that can refer to $state ... }
}
You can run code with eval