I often want to write short utility functions that do things like running a simple but frequently needed substitution on strings or the like. For these functions, I often want shortcutting behaviour: operate on $_ if not given a parameter, and operate destructively in-place if not asked to return values.
Writing functions that work like this is a real pain in the neck: there are multiple cases to be considered, you have to be careful to preserve the aliasing nature of @_ and $_, etc. It‘s way too much work to keep doing it over and over.
So here’s a function maker that lets you build such functions, carefully written to rely entirely on aliasing, rather than jumping through any reference-taking hoops. It expects to be given a reference to a function which always operates destructively on its parameters (ie modifies the elements of @_), and from this builds a function that will default to $_ as its input and will either return modified copies or modify its operands in-place.
Eg.:
BEGIN { *basename = shortcutted { s!.*/!! for @_ }; }
for( '/path/to/foo', '/some/path/to/bar' ) {
print "Munging " . basename . "\n";
open my $fh, '<', $_ or die $!;
# note how $_ still contains the full pathname
# ...
}
The code:
sub shortcutted(&) {
my $sub = shift;
sub {
my @byval;
my $nondestructive = defined wantarray;
$sub->( $nondestructive
? ( @byval = @_ ? @_ : $_ )
: ( @_ ? @_ : $_ )
);
return $nondestructive ? @byval[ 0 .. $#byval ] : ();
};
}
Tests:
use Test::More;
sub original() { 'original' }
sub modified() { 'modified' }
my $test = shortcutted { $_ = modified for @_ };
plan tests => my $num_tests;
{
local $_ = original;
$test->();
is( $_, modified, 'in-place on $_' );
BEGIN { $num_tests += 1 }
}
{
local $_ = original;
my $res = $test->();
is( $_, original, 'nondestructive from $_' );
is( $res, modified, '...returned correctly' );
BEGIN { $num_tests += 2 }
}
{
my $num = 10;
my @original = ( original ) x $num;
my @modified = ( modified ) x $num;
$test->( my @data = @original );
is_deeply( \@data, \@modified, 'in-place on params' );
BEGIN { $num_tests += 1 }
}
{
my $num = 10;
my @original = ( original ) x $num;
my @modified = ( modified ) x $num;
my @res = $test->( my @data = @original );
is_deeply( \@data, \@original, 'non-destructive from params' );
is_deeply( \@res, \@modified, '...returned correctly' );
BEGIN { $num_tests += 2 }
}
sub basename:Shortcut { s!.*/!! for @_ }
for ( '/path/to/foo', '/some/path/to/bar' ) {
print "Munging " . basename . "\n";
open my $fh, '<', $_ or die $!;
# note how $_ still contains the full pathname
#...
}
-Dom
Re:Lovely!
chromatic on 2006-07-09T20:40:17
I wish I'd thought of that. Very clever!
Re:Lovely!
Aristotle on 2006-07-09T23:12:12
Nice. I guess it’s worthy of being put on CPAN, after all. I’ll steal the attribute idea as that makes it much easier to use with named subs, but I still want the subref interface available for building anonymous ones.
Now I just need to think of a good name –
shortcuttedis fine for an off-the-cuff function, but it doesn’t meet my standards for something on CPAN…Re:Lovely!
Dom2 on 2006-07-10T13:39:29
Feel free to steal the code as you see fit.As to still wanting to do Subrefs, I think that you should be able to use Attributes with them as well. But I have no idea how, I'll need to play with that.
-Dom