[Mpls-pm] Closure Code Samples

[Joshua ben Jore]

On 10/13/05, Robert Fischer <rfischer at corradiation.net> wrote:
> Here are the closure code samples, as promised.
>
> If anyone has any questions about my talk last night, please feel free to
> drop me an email.

Robert,
Here's a bug:

In the following snippet, you either didn't have enough parentheses or
should have used || which has a higher precedence than or.
$prevShift = $prevShift or sub ($) { return shift }

Here's how that computes. That is, it does a no-op copy, tests that it
was true and clones a subroutine but returns it to a void context. So
this line is just a complicated looking no-op.
( $prevShift = $prevShift ) or sub ($) { return shift }

You could have written one of the following and gotten the behaviour
you actually wished for.
$prevShift ||= sub ($) { return shift }
$prevShift = $prevShift || sub ($) { return shift }
$prevShift = ( $prevShift or sub ($) { return shift } );

In your code, you use the magic numbers 215 and 221as parameters to
substr when date "parsing". What's that about?

You used prototypes on functions. This is nearly always a bug. I'd
just reference Tom Christiansen's "FMTEYEWTK about Prototypes in Perl"
which google just located at 
http://library.n0i.net/programming/perl/articles/fm_prototypes/. The
set of problems that it introduces is well known. If you're not aware
of them you should give that document a gander.

I tried swapping all of your parameter validation for Params::Validate
while this is just my opinion, it turned out to be oodles easier to
read.

Instead of:
  my $self = shift or carp "Method called as a subroutine";
  my $sub = shift or carp "No subroutine parameter provided";
  carp "Parameter is not a subroutine reference" unless(ref($sub) eq "CODE");
  carp "Too many parameters passed" if(scalar(@_));

I got:
  my ( $self, $sub )
    = validate_pos( @_,
                      { type => OBJECT,
                        isa => __PACKAGE__ },
		      { type => CODEREF } );

Lastly, Data::Dump::Streamer will dump closures. Here's what your
nested $valueShifter looked like in dumping. I'm not thrilled with the
separate declaration and assignment of the lexicals but at least its
all there. Maybe the reason for that was to allow the user of DDS to
remove the declarations and thus fiddle with the values ala s/^.+//;
$_="redeclare /most stuff/;$_"; my $whatever = ...; eval.

Interestingly, the B::Deparse part of this appears to have changed
your ($;$) prototype to ($).

my ($mag,$mag_eclipse_1,$mag_eclipse_2,$mag_eclipse_3,$mag_eclipse_4,$mag_eclipse_5,$prevShift,$prevShift_eclipse_1,$prevShift_eclipse_2,$prevShift_eclipse_3,$prevShift_eclipse_4,$prevShift_eclipse_5);
$mag = -6;
$mag_eclipse_1 = 15;
$mag_eclipse_2 = -1;
$mag_eclipse_3 = 9;
$mag_eclipse_4 = 5;
$mag_eclipse_5 = -2;
$prevShift = sub($) {
               BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
               use strict 'refs';
               return &$prevShift_eclipse_1($mag_eclipse_1 + int(shift @_));
             };
$prevShift_eclipse_1 = sub($) {
                         BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
                         use strict 'refs';
                         return &$prevShift_eclipse_2($mag_eclipse_2 +
int(shift @_));
                       };
$prevShift_eclipse_2 = sub($) {
                         BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
                         use strict 'refs';
                         return &$prevShift_eclipse_3($mag_eclipse_3 +
int(shift @_));
                       };
$prevShift_eclipse_3 = sub($) {
                         BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
                         use strict 'refs';
                         return &$prevShift_eclipse_4($mag_eclipse_4 +
int(shift @_));
                       };
$prevShift_eclipse_4 = sub($) {
                         BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
                         use strict 'refs';
                         return &$prevShift_eclipse_5($mag_eclipse_5 +
int(shift @_));
                       };
$prevShift_eclipse_5 = sub($) {
                         BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
                         use strict 'refs';
                         return shift @_;
                       };
$CODE1 = sub($) {
           BEGIN {${^WARNING_BITS} = "UUUUUUUUUUUU\001"}
           use strict 'refs';
           return &$prevShift($mag + int(shift @_));
         };

Josh