Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Intelligently shortcutting $_-or-params, non-destructive-or-in-place function maker

by Aristotle (Chancellor)
on Jul 09, 2006 at 10:13 UTC ( [id://559986]=CUFP: print w/replies, xml ) Need Help??

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 # ... }
sub shortcutted(&) { my $sub = shift; sub { my @byval; my $nondestructive = defined wantarray; $sub->( $nondestructive ? ( @byval = @_ ? @_ : $_ ) : ( @_ ? @_ : $_ ) ); return $nondestructive ? @byval[ 0 .. $#byval ] : (); }; }
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 } }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://559986]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (3)
As of 2024-03-19 11:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found