Another Perl-beginner question, but strangely enough, I found no tutorial to explain me this simple problem.
I wanted, as an exercise, to write a function map that takes a function and an array, returning an array. In functional languages, this is used quite often and I heard about the sub references and how to use them.
sub map {
my $f = shift;
my #r = ();
foreach (#_) {
push(#r, &f($_));
}
return #r;
}
sub square {
my $r = shift;
return $r*$r;
}
print map(\&shift, 1, 2, 3, 4, 5);
But, for some reason, I only get the word CODE and a hex-number as an output, five times. I have then changed the call of f in map, to $$f($_) and $f->($_) but all of it had the same result.
What do I do wrong here?
perl have a builin map function. let's call it map2
use &$f to dereference $f
use join to print an array properly
sub map2 {
my $f = shift;
my #r = ();
foreach (#_) {
push(#r, &$f($_));
}
return #r;
}
sub square {
my $r = shift;
return $r*$r;
}
print join ",", map2(\&square, 1, 2, 3, 4, 5);
$ perl 1.pl
1,4,9,16,25
As mentioned in comments, Perl has a built in map function that you should use.
my #squares = map {$_ ** 2} 1 .. 5;
Rather than passing an argument, Perl's built in map sets $_ to each element, which allows you to write your square function succinctly as either {$_ * $_} or {$_ ** 2}
But Perl also gives you the ability to make custom map-like functions with a similar syntax. For example, say you wanted to write a version of map that maps over pairs of values:
sub pair_map (&#) { # the (&#) prototype here tells perl that the sub
my $code = shift; # takes a code block, and then a list, just like `map`
my #ret;
while (#_) {
push #ret, $code->(splice #_, 0, 2);
}
#ret
}
my #pairs = pair_map {\#_} 1 .. 10;
pair_map {print "$_[0]: $_[1]\n"} %hash;
But since Perl has been around a while, most utility functions have probably been written already. A search of CPAN will turn up many map-like functions that do various things.
I found that I frequently need to map over lists with various step sizes, so I wrote the mapn function in List::Gen. This is a fully developed solution, so it includes an optimization when called in void context, and falls back to Perl's own map when n == 1:
sub mapn (&$#) {
my ($sub, $n, #ret) = splice #_, 0, 2;
croak '$_[1] must be >= 1' unless $n >= 1;
return map $sub->($_) => #_ if $n == 1;
my $want = defined wantarray;
while (#_) {
local *_ = \$_[0];
if ($want) {push #ret =>
$sub->(splice #_, 0, $n)}
else {$sub->(splice #_, 0, $n)}
}
#ret
}
Both pair_map and mapn utilize an advanced feature of Perl subroutines called prototypes. These prototypes are not argument validation tools (like in many other languages). Rather, they tell perl to interpret calls to the functions in a special way (similar to the way some other builtin functions are used). In this case, the & portion of the prototype tells perl that the first argument to these functions can be written as a bare block, just like a normal map call.
Related
I have been using perl for some time now.
I want to know how I can run the following operation in perl:
subtract(40)(20)
To get the result:
20
I think I would have to look at custom parsing techniques for Perl.
This is what I am looking at right now:
Devel::Declare
Devel::CallParser
and
http://www.perl.com/pub/2012/10/an-overview-of-lexing-and-parsing.html
Now, I am not sure what to look for or what to do.
Any help on HOW to go about this, WHAT to read would be appreciated. Please be clear.
Thank you.
I recommend trying Parse::Keyword. Parse::Keyword is really great for parsing custom syntax, as it lets you call back various parts of the Perl parser, such as parse_listexpr, parse_block, parse_fullstmt, etc (see perlapi).
It has a drawback in that if you use those to parse expressions that close over variables, these are handled badly, but this can be worked around with PadWalker.
Parse::Keyword (including PadWalker trickery) is what Kavorka uses; and that does some pretty complex stuff! Early versions of p5-mop-redux used it too.
Anyway, here's a demonstration of how your weird function could be parsed...
use v5.14;
use strict;
use warnings;
# This is the package where we define the functions...
BEGIN {
package Math::Weird;
# Set up parsing for the functions
use Parse::Keyword {
add => \&_parser,
subtract => \&_parser,
multiply => \&_parser,
divide => \&_parser,
};
# This package is an exporter of course
use parent 'Exporter::Tiny';
our #EXPORT = qw( add subtract multiply divide );
# We'll need these things from PadWalker
use PadWalker qw( closed_over set_closed_over peek_my );
sub add {
my #numbers = _grab_args(#_);
my $sum = 0;
$sum += $_ for #numbers;
return $sum;
}
sub subtract {
my #numbers = _grab_args(#_);
my $diff = shift #numbers;
$diff -= $_ for #numbers;
return $diff;
}
sub multiply {
my #numbers = _grab_args(#_);
my $product = 1;
$product *= $_ for #numbers;
return $product;
}
sub divide {
my #numbers = _grab_args(#_);
my $quotient = shift #numbers;
$quotient /= $_ for #numbers;
return $quotient;
}
sub _parser {
lex_read_space;
my #args;
while (lex_peek eq '(')
{
# read "("
lex_read(1);
lex_read_space;
# read a term within the parentheses
push #args, parse_termexpr;
lex_read_space;
# read ")"
lex_peek eq ')' or die;
lex_read(1);
lex_read_space;
}
return sub { #args };
}
# In an ideal world _grab_args would be implemented like
# this:
#
# sub _grab_args { map scalar(&$_), #_ }
#
# But because of issues with Parse::Keyword, we need
# something slightly more complex...
#
sub _grab_args {
my $caller_vars = peek_my(2);
map {
my $code = $_;
my $closed_over = closed_over($code);
$closed_over->{$_} = $caller_vars->{$_} for keys %$closed_over;
set_closed_over($code, $closed_over);
scalar $code->();
} #_;
}
# We've defined a package inline. Mark it as loaded, so
# that we can `use` it below.
$INC{'Math/Weird.pm'} = __FILE__;
};
use Math::Weird qw( add subtract multiply );
say add(2)(3); # says 5
say subtract(40)(20); # says 20
say multiply( add(2)(3) )( subtract(40)(20) ); # says 100
If you can live with the additions of a sigil and an arrow, you could curry subtract as in
my $subtract = sub {
my($x) = #_;
sub { my($y) = #_; $x - $y };
};
Call it as in
my $result = $subtract->(40)(20);
If the arrow is acceptable but not the sigil, recast subtract as
sub subtract {
my($x) = #_;
sub { my($y) = #_; $x - $y };
};
Invocation in this case looks like
my $result = subtract(40)->(20);
Please don't tack on broken syntax extensions on your program to solve a solved problem.
What you want are closures, and a technique sometimes called currying.
Currying is the job of transforming a function that takes multiple arguments into a function that is invoked multiple times with one argument each. For example, consider
sub subtract {
my ($x, $y) = #_;
return $x - $y;
}
Now we can create a subroutine that already provides the first argument:
sub subtract1 { subtract(40, #_) }
Invoking subtract1(20) now evaluates to 20.
We can use anonymous subroutines instead, which makes this more flexible:
my $subtract = sub { subtract(40, #_) };
$subtract->(20);
We don't need that variable:
sub { subtract(40, #_) }->(20); # equivalent to subtract(40, 20)
We can write subtract in a way that does this directly:
sub subtract_curried {
my $x = shift;
# don't return the result, but a subroutine that calculates the result
return sub {
my $y = shift;
return $x - $y;
};
}
Now: subtract_curried(40)->(20) – notice the arrow in between, as we are dealing with a code reference (another name for anonymous subroutine, or closures).
This style of writing functions is much more common in functional languages like Haskell or OCaml where the syntax for this is prettier. It allows very flexible combinations of functions. If you are interested in this kind of programming in Perl, you might want to read Higher-Order Perl.
#Heartache: Please forget this challenge as it makes no sense for the parser and the user.
You can think of using fn[x][y] or fn{x}{y} which are valid syntax variants - i.e. you can stack [] and {} but not lists,
or fn(x,y) or fn(x)->(y) which do look nice, are also valid and meaningful syntax variants.
But fn(x)(y) will not know in which context the second list should be used.
For fn(x)(y) the common interpretation would be fn(x); (y) => (y). It returns the 2nd list after evaluating the first call.
You may create the source code filter:
package BracketFilter;
use Filter::Util::Call;
sub import {
filter_add(sub {
my $status;
s/\)\(/, /g if ($status = filter_read()) > 0;
return $status ;
});
}
1;
And use it:
#!/usr/bin/perl
use BracketFilter;
subtract(40)(20);
sub subtract {
return $_[0] - $_[1];
}
Is map function in Perl written in Perl? I just can not figure out how to implement it. Here is my attempt:
use Data::Dumper;
sub Map {
my ($function, $sequence) = #_;
my #result;
foreach my $item (#$sequence) {
my $_ = $item;
push #result, $function->($item);
}
return #result
}
my #sample = qw(1 2 3 4 5);
print Dumper Map(sub { $_ * $_ }, \#sample);
print Dumper map({ $_ * $_ } #sample);
$_ in $function is undefined as it should be, but how map overcomes this?
map has some special syntax, so you can't entirely implement it in pure-perl, but this would come pretty close to it (as long as you're using the block form of map):
sub Map(&#) {
my ($function, #sequence) = #_;
my #result;
foreach my $item (#sequence) {
local $_ = $item;
push #result, $function->($item);
}
return #result
}
use Data::Dumper;
my #sample = qw(1 2 3 4 5);
print Dumper Map { $_ * $_ } #sample;
print Dumper map { $_ * $_ } #sample;
$_ being undefined is overcome by using local $_ instead of my $_. Actually you almost never want to use my $_ (even though you do want to use it on almost all other variables).
Adding the (&#) prototype allows you not to specify sub in front of the block. Again, you almost never want to use prototypes but this is a valid use of them.
While the accepted answer implements a map-like function, it does NOT do it in the way perl would. An important part of for, foreach, map, and grep is that the $_ they provide to you is always an alias to the values in the argument list. This means that calling something like s/a/b/ in any of those constructs will modify the elements they were called with. This allows you to write things like:
my ($x, $y) = qw(foo bar);
$_ .= '!' for $x, $y;
say "$x $y"; # foo! bar!
map {s/$/!!!/} $x, $y;
say "$x $y"; # foo!!!! bar!!!!
Since in your question, you have asked for Map to use array references rather than arrays, here is a version that works on array refs that is as close to the builtin map as you can get in pure Perl.
use 5.010;
use warnings;
use strict;
sub Map (&\#) {
my ($code, $array) = splice #_;
my #return;
push #return, &$code for #$array;
#return
}
my #sample = qw(1 2 3 4 5);
say join ', ' => Map { $_ * $_ } #sample; # 1, 4, 9, 16, 25
say join ', ' => map { $_ * $_ } #sample; # 1, 4, 9, 16, 25
In Map, the (&\#) prototype tells perl that the Map bareword will be parsed with different rules than a usual subroutine. The & indicates that the first argument will either be a bare block Map {...} NEXT or it will be a literal code reference Map \&somesub, NEXT. Note the comma between the arguments in the latter version. The \# prototype indicates that the next argument will start with # and will be passed in as an array reference.
Finally, the splice #_ line empties #_ rather than just copying the values out. This is so that the &$code line will see an empty #_ rather than the args Map received. The reason for &$code is that it is the fastest way to call a subroutine, and is as close to the multicall calling style that map uses as you can get without using C. This calling style is perfectly suited for this usage, since the argument to the block is in $_, which does not require any stack manipulation.
In the code above, I cheat a little bit and let for do the work of localizing $_. This is good for performance, but to see how it works, here is that line rewritten:
for my $i (0 .. $#$array) { # for each index
local *_ = \$$array[$i]; # install alias into $_
push #return, &$code;
}
My Object::Iterate module is an example of what you are trying to do.
I've always been somewhat confused about the purpose and usage of anonymous subs in perl. I understand the concept, but looking for examples and explanations on the value of this practice.
To be clear:
sub foo { ... } # <--- named sub
sub { ... } # <--- anonymous sub
For example:
$ perl -e 'print sub { 1 }'
CODE(0xa4ab6c)
Tells me that sub returns a scalar value. So, I can do:
$ perl -e '$a = sub { 1 }; print $a'
For the same output as above. This of course holds true for all scalar values, so you can load arrays or hashes with anonymous subs.
The question is, how do I use these subs? Why would I want to use them?
And for a gold star, is there any problem which can only be resolved with an anonymous sub?
Anonymous subroutines can be used for all sorts of things.
Callbacks for event handling systems:
my $obj = Some::Obj->new;
$obj->on_event(sub {...});
Iterators:
sub stream {my $args = \#_; sub {shift #$args}}
my $s = stream 1, 2, 3;
say $s->(); # 1
say $s->(); # 2
Higher Order Functions:
sub apply (&#) {
my $code = shift;
$code->() for my #ret = #_;
#ret
}
my #clean = apply {s/\W+/_/g} 'some string', 'another string.';
say $clean[0]; # 'some_string'
Creating aliased arrays:
my $alias = sub {\#_}->(my $x, my $y);
$alias[0]++;
$alias[1] = 5;
say "$x $y"; # '1 5''
Dynamic programming with closures (such as creating a bunch of subroutines that only differ by a small amount):
for my $name (qw(list of names)) {
no strict 'refs';
*$name = sub {... something_with($name) ...};
}
There is no situation where an anonymous subroutine can do anything that a named subroutine can not. The my $ref = sub {...} constructor is equivalent to the following:
sub throw_away_name {...}
my $ref = \&throw_away_name;
without having to bother with deciding on a unique 'throw_away_name' for each sub.
The equivalence also goes the other way, with sub name {...} being equivalent to:
BEGIN {*name = sub {...}}
So other than the name, the code reference created by either method is the same.
To call a subroutine reference, you can use any of the following:
$code->(); # calls with no args
$code->(1, 2, 3); # calls with args (1, 2, 3)
&$code(); # calls with no args
&$code; # calls with whatever #_ currently is
You can even use code references as methods on blessed or unblessed scalars:
my $list = sub {#{ $_[0] }};
say for [1 .. 10]->$list # which prints 1 .. 10
You can use it to create iterators.
use strict;
use warnings;
use 5.012;
sub fib_it {
my ($m, $n) = (0, 0);
return sub {
my $val = ( $m + $n );
$val = 1 unless $val;
($m, $n) = ($n, $val);
return $val;
}
}
my $fibber = fib_it;
say $fibber->() for (1..3); ### 1 1 2
my $fibber2 = fib_it;
say $fibber2->() for (1..5); ### 1 1 2 3 5
say $fibber->() for (1..3); #### 3 5 8
Anonymous subroutines can be used to create closures.
Closure is a notion out of the Lisp world that says if you define an anonymous function in a particular lexical context, it pretends to run in that context even when it's called outside the context.
perlref
What's a closure?
Here's something similar you might have seen before:
#new_list = map { $_ + 1 } #old_list;
And also:
#sorted = sort { $a <=> $b } #unsorted;
Neither of those are anonymous subs, but their behavior can be imitated in your functions with anonymous subs. They don't need the sub keyword because the functions are (essentially) prototyped to have their first argument be a subroutine, and Perl recognizes that as a special case where sub can be left off. (The functions also set the requisite variables to meaningful values before calling the subroutines you provided in order to simplify argument passing, but that's not related.)
You can write your own map-like function:
sub mapgrep (&#) { # make changes and also filter based on defined-ness
my ($func, #list) = #_;
my #new;
for my $i (#list) {
my $j = $func->($i);
push #new, $j if defined $j;
}
}
The magic to make it work with $_ is a bit much to write here - the above version only works for subs that take arguments.
Well I wrote a SAX parser for perl that is event driven. You can pass anonymous subs to the begin/end events on an element.
my $str = "<xml><row><data></data></row></xml>":
my $parser = SAXParser->new();
$parser->when('row')->begin(sub {
my ($element) = #_;
push(#rows, $row);
});
$parser->when('row')->end(sub {
## do something like serialize it or whatever
});
$parser->parse($str);
They are generally used when you want to pass a sub to another bit of code. Often this is a case of "When X happens (in third party code) do Y".
For example. When defining an attribute in Moose, you can specify the default value of that attribute using a sub. Given a class which has, as part of its definition:
has 'size' => (
is => 'ro',
default =>
sub { ( 'small', 'medium', 'large' )[ int( rand 3 ) ] },
predicate => 'has_size',
);
Whenever an instance of that class is created without an explicit size being passed, the sub will be called and the return value will be the size for that object.
If we switch to another language to give a different example, you'll find a similar concept in JavaScript.
var b = document.getElementById('my_button').
b.addEventListener('click', function (e) { alert('clicked!'); });
In your example, you haven't actually called created subroutine. Call is performed with either &$a or $a->() syntax. What you've done is that you stored a reference to subroutine in $a, then stringifyed it and printed result. Compare:
my $a = sub {1};
my $b = sub {1};
print join("\n", $a, $a->(), $b, $b->());
These are subs for the lazy programmer. You can use them for local throw-away functions and can save some typing. Instead of
sub x { ... }
my $function_ptr = \&x;
you can now use
my $function_ptr = sub { ... };
The anonymous functions are also private, and can only be accessed through the $function_ptr, so they don't have an entry in the symbol table.
I have implemented a simple iterator in perl. I normally work with C#, and use iterators and functional programming quite frequently. So I thought it would be simple to get some basics working in perl.
Problem is, I'm getting some poor performance, I don't expect be any faster than for or foreach, but I thought someone could give me some insight in how to speed it up.
Here is the guts of my package:
package Iterator;
use strict;
#Constructor for Iterator type
sub new {
my $type = $_[0];
my $this = {};
#set default values
$this->{Array} = #_[1];
$this->{Index} = 0;
$this->{Sub} = sub {
my #array = #{$this->{Array}};
return $#array >= $this->{Index} ? $array[$this->{Index}++] : undef;
};
#return self
bless($this, $type);
return $this;
}
#Iterates next
sub Next {
return $_[0]->{Sub}->();
}
Allows you to do this:
my $iterator = Iterator->new(\#array);
while (defined(my $current = $iterator->Next())) {
print $current, "\n";
}
Not flashy... yet.
Also enables some functional code like this:
my $sum = 0;
Iterator
->new(\#array)
->Where(sub { $_[0] % 2 == 0 })
->ForEach(sub { $sum += $_[0] });
Which would sum up all the even values of an array.
My bottleneck is the iteration code:
$this->{Sub} = sub {
my #array = #{$this->{Array}};
return $#array >= $this->{Index} ? $array[$this->{Index}++] : undef;
};
Any pointers to speed this up?
A bit late to the game here, but since you are concerned about performance, one of the largest bottlenecks in iterator type code is that the fields of your hash based object need to be dereferenced on each access. One way to combat this is to use closures in which the fields are closed over variables, avoiding unneeded dereferencing.
In my module List::Gen which contains a fairly performant implementation of lazy lists, I wrote the utility function curse which makes closure based objects behave like normal Perl objects.
Here is a short example of your iterator class written with curse. In a simple benchmark summing 1000 numbers, this method is twice as fast as yours, even after fixing all of the inefficiencies noted in the other answers.
{package Iterator;
use List::Gen 'curse';
sub new {
my ($class, $array) = #_;
my $index = 0;
curse {
next => sub {$$array[$index++]},
index => sub :lvalue {$index},
} => $class
}
sub reset {shift->index = 0}
}
If you are really pushing for more speed, since the next method does not need to be passed anything, you could even write:
my $next = $iterator->can('next');
while (defined (my $x = $next->()) {...}
Which will give you a 30% to 40% speed boost over a normal method call.
You can read the source of List::Gen for more advanced usage of curse
You might find it useful to read a bit of Higher Order Perl.
this line:
my #array = #{$this->{Array}};
duplicates the array into #array, and I don't think you want to. Just do $#{$this->{Array}} to find the endpoint of your array.
A much more efficient version:
package Iterator;
use strict;
#Constructor for Iterator type
sub new {
my $type = shift;
my $array = shift;
my $this = {};
$this->{array} = $array;
$this->{index} = 0;
bless($this, $type);
return $this;
}
#Iterates next
sub Next {
my $this = shift;
return $this->{array}->[$this->{index}++];
}
Summing even numbers is easier done using grep and List::Util:
use List::Util 'sum';
say sum grep { not $_ % 2 } (1 .. 10); // 30
It seems very likely to me that that the code suggested by your question is over-engineering. Unless you can come up with a decent example that cannot be easily solved using the traditional Perl primitives.
Have a look at List::Util and List::MoreUtils for utilities that may help you with this.
You can even use perl5i for a more modern looking syntax.
Example:
use perl5i::2;
my #nums = (0..100);
my $sumEven = #nums->grep(sub { $_ % 2 == 0 })->reduce(sub { $a+$b });
say $sumEven;
There is already an array iterator in CPAN, so you can look at its approach if you have not done it yet.
By the way in your code you have:
#set default values
$this->{Array} = #_[1];
I assume you want to say $_[1]. With #_[1] you are requesting an array slice of one element. At the end the result is the same but the semantics isn't. The curious thing is that I was expecting to have an array of one element if I do #_[1] or an error but tested in the debugger and you obtain the scalar (at least in perl 5.10). Perl 6 will go for this behaviour anyway and will not change sigil for accessing elements in arrays or hashes so you are coding 'advanced' Perl ;-)
Don't unload the stored array. You're copying every element of an array from where it is pointed at by $this->{Array} to the local list #array when you do this:
my #array = #{$this->{Array}};
Also if you know that you are going to stop when you hit undef, then you don't have to even check bounds.
$this->{Sub} = sub { return $this->{Array}[++$this->{Index}]; }
Is all you need. When {Index} gets out of range, it will return undef.
In addition, you can write your expression in Perl like:
$sum += $_ foreach grep { $_ % 2 == 0 } #array;
A much simpler Perl iterator:
my #array = (1, 2, 3, 4);
while (my $i = shift #array)
{
print $i . "\n";
}
What syntax, if any, is able to take a reference of a builtin like shift?
$shift_ref = $your_magic_syntax_here;
The same way you could to a user defined sub:
sub test { ... }
$test_ref = \&test;
I've tried the following, which all don't work:
\&shift
\&CORE::shift
\&{'shift'}
\&{'CORE::shift'}
Your answer can include XS if needed, but I'd prefer not.
Clarification: I am looking for a general purpose solution that can obtain a fully functional code reference from any builtin. This coderef could then be passed to any higher order function, just like a reference to a user defined sub. It seems to be the consensus so far that this is not possible, anyone care to disagree?
No, you can't. What is the underlying problem you are trying to solve? There may be some way to do whatever that is.
Re the added part of the question "Your answer can include XS if needed, but I'd prefer not.",
calling builtins from XS is really hard, since the builtins are set up to assume they are running as part of a compiled optree and have some global variables set. Usually it's much easier to call some underlying function that the builtin itself uses, though there isn't always such a function, so you see things like:
buffer = sv_2mortal(newSVpvf("(caller(%d))[3]", (int) frame));
caller = eval_pv(SvPV_nolen(buffer), 1);
(doing a string eval from XS rather than go through the hoops required to directly call pp_caller).
I was playing around with general purpose solutions to this one, and came up with the following dirty hack using eval. It basically uses the prototype to pull apart #_ and then call the builtin. This has only been lightly tested, and uses the string form of eval, so some may say its already broken :-)
use 5.10.0;
use strict;
use warnings;
sub builtin {
my ($sub, $my, $id) = ($_[0], '');
my $proto = prototype $sub //
prototype "CORE::$sub" //
$_[1] //
($sub =~ /map|grep/ ? '&#' : '#;_');
for ($proto =~ /(\\?.)/g) { $id++;
if (/(?|(\$|&)|.(.))/) {
$my .= "my \$_$id = shift;";
$sub .= " $1\$_$id,";
} elsif (/([#%])/) {
$my .= "my $1_$id = splice \#_, 0, \#_;";
$sub .= " $1_$id,";
} elsif (/_/) {
$my .= "my \$_$id = \#_ ? shift : \$_;";
$sub .= " \$_$id,"
}
}
eval "sub ($proto) {$my $sub}"
or die "prototype ($proto) failed for '$_[0]', ".
"try passing a prototype string as \$_[1]"
}
my $shift = builtin 'shift';
my #a = 1..10;
say $shift->(\#a);
say "#a";
my $uc = builtin 'uc';
local $_ = 'goodbye';
say $uc->('hello '), &$uc;
my $time = builtin 'time';
say &$time;
my $map = builtin 'map';
my $reverse = builtin 'reverse';
say $map->(sub{"$_, "}, $reverse->(#a));
my %h = (a=>1, b=>2);
my $keys = builtin 'keys';
say $keys->(\%h);
# which prints
# 1
# 2 3 4 5 6 7 8 9 10
# HELLO GOODBYE
# 1256088298
# 10, 9, 8, 7, 6, 5, 4, 3, 2,
# ab
Revised with below and refactored.
You could do this if you patched the internal method first (which would give you the coderef of your patch):
use strict;
use warnings;
BEGIN {
*CORE::GLOBAL::die = sub { warn "patched die: '$_[0]'"; exit 3 };
}
print "ref to patched die: " . \&CORE::GLOBAL::die . "\n";
die "ack, I am slain";
gives the output:
ref to patched die: CODE(0x1801060)
patched die: 'ack, I am slain' at patch.pl line 5.
BTW: I would appreciate if anyone can explain why the override needs to be done as *CORE::GLOBAL::die rather than *CORE::die. I can't find any references for this. Additionally, why must the override be done in a BEGIN block? The die() call is done at runtime, so why can't the override be done at runtime just prior?
You can wrap shift with something that you can reference, but you have to use a prototype to use it, since shift is special.
sub my_shift (\#) { my $ll = shift; return shift #$ll }
The problem is that the prototype system can't magically figure out that when it calls some random ref-to-sub in a scalar, that it needs to take the reference before calling the subroutine.
my #list = (1,2,3,4);
sub my_shift (\#) { my $ll = shift; return shift #$ll }
my $a = shift #list;
my $my_shift_ref = \&my_shift;
my $b = (&{$my_shift_ref} (\#list) ); # see below
print "a=$a, b=$b\n";
for (my $i = 0; $i <= $#list; ++$i) { print "\$list[$i] = ",$list[$i],"\n"; }
If this is called as just #list, perl barfs, because it can't automagically make references the way shift does.
See also: [http://www.perl.com/language/misc/fmproto.html][Tom Christensen's article].
Of course, for builtins that aren't special like shift, you can always do
sub my_fork { return fork; }
and then &my_fork all you want.
As I understand you want to have coderef that will be called on some data, and it might point to some your function or to builtin.
If I'm right, just put the builtin in closure:
#!/usr/bin/perl -w
use strict;
my $coderef = \&test;
$coderef->( "Test %u\n", 1 );
$coderef = sub { printf #_ };
$coderef->( "Test %u\n", 2 );
exit;
sub test {
print join(' ', map { "[$_]" } #_) . "\n";
}
Doing it with shift is also possible, but remember that shift without explicit array to work on, works on different arrays based on where it was called.
If you want to see what it takes to fake it in production quality code, look at the code for autodie. The meat is in Fatal. Helps if you're a mad pirate Jedi Australian.
The only way I can get it to work is to make a reference to sub{shift}.
perl -e '#a=(1..3); $f=sub{shift}; print($f->(#a), "\n");'
This is functionally equivalent to:
perl -e '#a=(1..3); print(shift(#a), "\n");'
Which could be just perl -e 'print 1, "\n"' but then we wouldn't be talking about a builtin.
For your information I'm surprised that one cannot reference a builtin, and now that it's been made clear to me I can't help but think of it as a deficiency in Perl.
Update Eric correctly points out that $f=sub{shift}; $f->(#a) leaves #a unchanged. It should be more like:
perl -e '#a=(1..3); $f=sub{shift #{+shift}}; print($f->(\#a), "\n");
Thanks Eric.