It becomes clear as what's going on, once we add some print outs at certain critical point (also see comments):

use Data::Dumper;

use strict;

sub prefix_later {
   my ($just_once,$and_later) = @_; #passed by calling part, see below
   my $ct=0;
   return sub {
      my (@args) = shift(); #this is just a trick ;-)
      print Dumper(\@args);
      print "ct = $ct\n"; #will not be reset to zero, becasue of closu
+re
      ((!$ct++) ? #only true for the first time
          sub {
             print "sub1\n";
             $just_once->(@args); #hi mom
          } : 
          sub { 
             print "sub2\n";    
             $and_later->(@args); #this was unneccessary:
             $just_once->(@args); #hi mom
          }
      )->();
   }
}

my $hi_mom = prefix_later( 
   sub { print "hi mom\n"; },#this is just once
   sub { print "this was unneccessary:\n"; } #this is and later
);

$hi_mom->() for (1..3);
[download]

Outputs:

#first round
$VAR1 = [
          undef
        ];
ct = 0
sub1
hi mom
#second round
$VAR1 = [
          undef
        ];
ct = 1
sub2
this was unneccessary:
hi mom
#third round
$VAR1 = [
          undef
        ];
ct = 2
sub2
this was unneccessary:
hi mom
[download]

Yep, good explanation. To add some further confusion (or perhaps to explain the shift trick), if I change around the last few lines and the functions will actually take arguments ...

my $hi_mom = prefix_later(
   sub { my $f = shift(); print "got: $f\n"; },
   sub { print "this was unneccessary:\n"; }
);

$hi_mom->("nerp") for (1..3);
[download]

Output:

got: nerp
this was unneccessary:
got: nerp
this was unneccessary:
got: nerp
[download]

#!/usr/bin/perl
use strict;

sub prefix_later {
   my ($just_once, $and_later) = @_;
   my $ct = 0;
   return sub {
      $and_later->(@_) if $ct++;
      $just_once->(@_);
   }
}

my $hi_mom = prefix_later(
   sub { print "You said: ", shift, "\n"; },
   sub { print "You've already said: ", shift, "!\n"; }
);

$hi_mom->("hi mom") for 1..3;
[download]

You said: hi mom
You've already said: hi mom!
You said: hi mom
You've already said: hi mom!
You said: hi mom
[download]

Yep, that is an good refactoring of prefix_later. The double closure, yeah, that's overkill, I did it just because I could. Code debate on a "I'm just screwing around" thread? :) Ok, I'll bite...

Why type more than you need to?

This philosophy is one I don't agree with, especially when developing code you are going to have to go back and tweak later. While I hate typing way too much (java boilerplate and convention is disgusting), I do type VERY VERY fast. Many of my habits are those of pseudo-defensive programming. Even when I'm not writing "throw away" code, I don't let go of those habits easily. Why? I don't write much throw away code ... I tend to work on stuff that sticks around.

For instance (and this is just me), I *always* name my subroutine parameters and never use "shift" directly. Why? I'm being defensive because I usually want named parameters later. Every time I've done a quick shift in the middle of a block of code, I've had to go back and change it later. With @args, I might want to later replace that @args with ($gorp,$slug,@args) = shift() for instance. It leaves a place in the code to do that, and I only have to edit one line to make that change.

But I think after that double closure you can grill me all you want :) It's like climbing Mt. Everest ... "Why? Because It's There".

Why type more than you need to?

This philosophy is one I don't agree with, especially when developing code you are going to have to go back and tweak later.

You're right. And I asked the wrong question; or at least an incomplete one. What I meant to ask was: why type more when you're not gaining anything? Your code is more complex, it's partially duplicated, and it's not very readable. I consider myself a strong Perl programmer (and I realize that assumption can be a dangerous one to start with :-), and I had to sit for a minute before I could figure out what it was that you'd done.

Every time I've done a quick shift in the middle of a block of code, I've had to go back and change it later. With @args, I might want to later replace that @args with ($gorp,$slug,@args) = shift() for instance. It leaves a place in the code to do that, and I only have to edit one line to make that change.

Are you sure you don't mean my (@args) = @_;? shift only ever returns one element, so using it in list context is pointless: ($gorp,$slug,@args) = shift() doesn't do anything to $slug or @args.

I don't mean to grill you. I just want to understand and give some (hopefully friendly) advice.

elusion : http://matt.diephouse.com

Update: my 200th node! :-)

And it made me think of this monster I just concocted to create an include() function for use in Text::Template templates (called from CGI::Application):

sub template {
    my ($self,$filename,@args) = @_;

    # create include subroutine in template package if none exists.

    if (!*Bug::Reporter::In::Template::include{CODE}) {
        *Bug::Reporter::In::Template::include = sub {
           $self->template(shift(),@args,@_);
        };
    }
    $self->load_tmpl($filename)->fill_in(
        PACKAGE => 'Bug::Reporter::In::Template',
        HASH => {
            application => $self,
            @args
        }
    );
}

# just to clarify: I'm overriding CGI::Application's load_tmpl():

sub load_tmpl {
    my ($self, $file) = @_;
    require Text::Template;
    return Text::Template->new(
        UNTAINT => 1,
        TYPE => 'FILE',
        SOURCE => $self->tmpl_path()."/$file",
    ) || die $Text::Template::ERROR;
}
[download]

Let's just hope no-one will run this across multiple threads (though Text::Template will probably break on that anyway).

update2: now that I think about it, it's probably a lot better to just call {$app->template('filename')} in the template.

Hmm, I did go the long way to do it, didn't I? :)
Thanks for the idea.

sub foo {
   print "hi mom\n";
   my $ptr = \&foo;
   *foo=sub {
       print "that was unneccessary:";
       $ptr->();
   };
}

foo();
foo();
[download]

Hmm, more Perl voodoo. I like it.

Using your subroutine, try running

foo();
foo();
foo();
foo();
[download]

or for the really dangerous,

foo() for (1..1000);
[download]

Hmm, hmmm, I'm not listening :)

Or, for that matter, Specializing Functions with Currying.

I've been meaning to write a node on generalized-currying and/or arg-swizzling. I should do that.

--
Yours in pedantry,
F o x t r o t U n i f o r m
"Lines of code don't matter as long as I'm not writing them." -- merlyn

Or May Thy Closures Be Blessed (one of my favorite uses of closures).

--
elusion : http://matt.diephouse.com

my ($just_once,$and_later) = @_;

Why is it called $just_once if it executes every time?

If you use it more than once, it whines and complains :) just_once does it keep the original form before it no longer works as advertised.

I used to have it running warn() for the second function.

If you use it more than once, it whines and complains ... I used to have it running warn() for the second function.

Oh, I see. If you use the sub more than once, you get a custom complaint, which is defined by the second coderef.

That seems a bit odd to me. I would probably make it only execute the first one once, and then have a standard warning thereafter. If it was necessary to have a custom message, I'd pass it in as a string argument, not another coderef. But perhaps your approach makes more sense for what you're doing.

Or maybe you're just doing this to have fun with closures, in which case I'm putting entirely too much thought into the whole thing. :-)

I like the FP style, but would a double-closure be an application of the factory design pattern; and if so, would a generalized closure generator be an implemented abstract factory?

would a double-closure be an application of the factory design pattern

I am sorry to pick nits, but this is something that seems to be confused a lot. I wouldn't really call this a double closure. It's just a closure that uses anonymous subroutines. The inner subroutines are not stored anywhere, so they don't have a chance to close around their lexical environment.

Nope, they close very briefly around @args, as wrong as that is, they do. Whether they are used once or twice or thrice is indifferent to the fact that @args is lexically picked up.

maybe it's a factory factory.

The observant will note the doubly nested closure

It's me again! I'm sure you'd rather not hear any more comments from revdiablo, but I'd like to point out something I observed in another post in this thread.

This is not a double closure, it's just a single closure that uses anonymous subroutines. The inner subroutines do not close around anything, because they are not stored anywhere. They are created and destroyed each time they are used. They never get a chance to create a closure.

Update: I guess this really depends on your definition of "closure". As I said in a reply to our good friend AnonyMonk, I don't generally use the hyper-technical definition that a closure is "anything that closes around a lexical", because that's true of any subroutine that is in a lexical environment. Which, if you're using lexicals in Perl, is all of them.

I prefer to think of closures as subroutines that actually use that lexical environment for more than one invocation. I think this captures the meaning most people think of, as well as a meaning that is actually useful for something.

About closures.

I don't generally use the hyper-technical definition that a closure is "anything that closes around a lexical", because that's true of any subroutine that is in a lexical environment.

I'm not sure how to interpret you, but it seems we view things differently. Either way a clarification probably would serve well. My definition of a closure in Perl is a subroutine that (deeply) binds a lexical variable. Whether it's called once or twice or a thousand times isn't relevant.

{ my $foo; sub foo { 1 } }      # not a closure
{ my $foo; sub foo { $foo } }   # a closure
[download]

It's not about being "hyper-technical", it's about getting at the essence of what a closure is. That the bound variables doesn't go out of scope doesn't make it less of a closure, but its closureness doesn't get used. I understand that this is your point and I can almost sympathize with it, but just almost. It would be very confusing if a subroutine first wasn't a closure, but then became one when it was returned or assigned to variable with a broader scope.

Your point is supported by that we don't usually call &foo in

my $GLOBAL = 1;

sub foo {
    ... ; 
    ... $GLOBAL ... ;
    ... ;
}
[download]

a closure. However, it is a closure and it's not wrong calling it one.

ihb

See perltoc if you don't know which perldoc to read!
Read argumentation in its context!

First off, I want to thank you for actually engaging in a conversation, rather than simply writing me off as whiney and pedantic. I posted about something that I wanted to discuss, not just whine about. :-)

That it doesn't go out of scope doesn't make it less of a closure, but its closureness doesn't get used.

Indeed, that's true. I suppose I shouldn't try to fight against the technical definition. Rather than saying it's not a closure, I should have said it's not very useful to talk about its closure-ness.

However, it is a closure and it's not wrong calling it one.

Ok, fair enough. I officially change my position on the matter. Again, thank you for responding. I hope our friend SpanishInquisition is not too upset about the matter to read what I've written here, so he won't think I'm a completely horrible person.