use Perl

use strict;
use warnings;

use PadWalker 'peek_sub';
use List::Util 'first';

## Map named arguments to variables of those names.
sub getargs {
  my %args = do { package DB; () = caller 1; @DB::args };
  my $vals = peek_sub \&{(caller 1)[3]};
  my %res  = map { $_ => $args{substr($_, 1)} }
             grep exists $args{substr($_, 1)}, keys %$vals;
  my %map  = map {
    my $orig_arg  = \$_;
    my($ref_name) = first { $orig_arg == $vals->{$_} } keys %$vals;
    $ref_name => $orig_arg;
  } @_;

  ${ $map{$_} } = $res{$_}
    for keys %res;

  return \%res;
}

## Basic test of getargs();
sub foo {
  getargs my($this, $that, $theother);
  print "this is: $this\nthat is: $that\nand the other is: $theother\n";
}

## Have these pairs mapped to variables of the same name.
foo this     => "an argument",
    that     => "used to refer to things",
    theother => "is something else altogether";

This will output:

this is: an argument
that is: used to refer to things
and the other is: is something else altogether

So, as you can see, given a list of pairs the variable names matching the keys will be automagically assigned to the corresponding values.

I'd had it in the back of my mind that this could be achieved fairly simply, as demonstrated above, but as you can see it's not the most robust of methods. I'll CPAN-ify it if anyone wants a rather more sensible version of the code, and I'm sure documentation and tests wouldn't go amiss too.

use Switch::Perlish 'C';

my $food = shift;
switch $food, sub {
  case 'pizza';
  case 'burger';
  case 'fried-chicken';
  case 'tub-o-lard', sub {
    print "Your food is probably delicious\n";
    stop;
  };
  case 'celery';
  case 'rice-cracker';
  case 'plaster';
  case 'grass', sub {
    print "Your food is probably bland\n";
    stop;
  };
  default sub {
    print "Your food is without compare\n";
  };
};

You can also match mutliple things in the normal style using an anonymous array. i.e

case [qw/ pizza burger fried-chicken tub-o-lard /], sub { ... }

Different keystrokes for different folks ...

use Switch::Perlish;

my $num = $ARGV[0];

switch $num, sub {
  case undef,
    sub { die "Usage: $0 NUM\n" };
  case [0 .. 10],
    sub { print "Your number was between 0 and 10" };
  case [11 .. 100],
    sub { print "Your number was between 11 and 100" };
  case [101 .. 1000],
    sub { print "Your number was between 101 and 1000" };
  default
    sub { print "Your number was less than 0 or greater than 1000" };
};

broquaint out

$foo = "a string";
print "${";
foo} or is it?

__output__

a string or is it?

broquaint out

Now it's just a matter of time before I write the big .... closure tutorial (cue. lightning and a distant rumble of thunder).

broquaint out

And I did figure out how to use extract_quotelike() in the end, and may CPAN-ify it some time in the future as it is awful handy if your source munging.

broquaint out

In other news I posted Sub::Lexical on Perl Monks and realised there aren't as many bugs as I initially thought (although I imagine there are few a still nasties lurking). My main annoyance at the moment is that function calls are being 'interpolated' within strings so I need to figure out a way of applying extract_quotelike from Mr Conway's Text::Quotelike or do some more funky regex (I don't think P::RD will be necessary here, I think ...).

Oh and I have my name on CPAN, in the albeit indirect way that demerphq finally put up Data::BFDump and Text::Quote for all the public to examine and scrutinise (you can thank me for a bunch of tests there, and even more that aren't ;-).

broquaint out

There are however a couple caveats that I hope to overcome before it's possible release. The most grating one has to be not being able to have what looks like a function call in a string as the regex doesn't deal with such trickery yet. And because of the hack to avoid name collision you can't do symbolic dereferencing of the sub (which if you're doing, then probably won't notice in your delirious state of madness ;-)

See isn't that better? Now you can sleep easily at night/day knowing that this wonderous module is being developed. You can now finally reach that inner calm you've always been searching for. Your whites will be whiter and your brights will be brighter!

broquaint out

shell> perl -MScalar::Util=blessed -e 'print blessed(qr/^\s*$/), $/'
Regexp

Huh. I imagine a good dig at the perl source might explain how and why this is (something to do with the /o flag apparently).

I also had it driven into me (once more) as to why pdcawley glows with evil light when he demonstrated how to do tail call optimization in perl for his upcoming Scheme interpreter. If this is productive coding (which it most certainly is) then I fear to see what he could do when wields his power with the intent of doing "evil things" ...

broquaint out