1: # This is designed to simulate END blocks using objects.  This 
   2: # is very useful when you want to do something when scope is
   3: # left.
   4: # 
   5: # To use it, pass either the new or the add routine one or 
   6: # more code refs.  When the object leaves scope, the subs will
   7: # play.  This is useful for closing files, removing temp 
   8: # files... all of the things you normally use END{} for
   9: # But, you can call "END" any time by simply undefing the 
  10: # object.
  11: #
  12: # # you can do things like this.
  13: # while(1){
  14: #   my $end = Pseudo::End->new( sub{ warn "Out of the loop" } );
  15: # 
  16: #   last if 0;
  17: #   $end->add( sub{ warn "Out of the loop2" } );
  18: #   last if 1;
  19: #   last if 0;
  20: # }
  21: #
  22: # Simple, but try it.  It is addictive.
  23: 
  24: package Pseudo::End;
  25: sub new {
  26:   my $type = shift;
  27:   my $s = bless [], ref($type) || $type;
  28:   foreach (@_){
  29:     unshift @$s, $_ if ref $_ eq 'CODE';
  30:   }
  31:   $s;
  32: }
  33: sub add {
  34:   my $s = shift;
  35:   foreach (@_){
  36:     unshift @$s, $_ if ref $_ eq 'CODE';
  37:   }
  38: }
  39: sub DESTROY {
  40:   my $s = shift;
  41:   &$_ foreach @$s;
  42: }
  43: 1;

Replies are listed 'Best First'.
Re: Pseudo End
by premchai21 (Curate) on Apr 24, 2001 at 22:44 UTC
[reply]
      For the record, I see ReleaseAction was checked in on April 22. We have been using our's since mid march (here is our cvs log) 
      RCS file: /ourrepositorypath/End.pm,v
Working file: End.pm
head: 1.3
branch:
locks: strict
access list:
symbolic names:
keyword substitution: kv
total revisions: 3;     selected revisions: 3
description:
----------------------------
revision 1.3
date: 2001/04/05 17:18:46;  author: pauls;  state: Exp;  lines: +8 -8
updated to store subs to execute inside of itself - the other way coul
+d have caused some weird results in mod perl\
 loops if an object never destroyed
----------------------------
revision 1.2
date: 2001/03/16 17:53:36;  author: pauls;  state: Exp;  lines: +21 -1
added perldoc
----------------------------
revision 1.1
date: 2001/03/16 17:46:30;  author: pauls;  state: Exp;
initial entry

      [download]
      Not that this matters or anything.
      my @a=qw(random brilliant braindead); print $a[rand(@a)];
[reply]
[d/l]
      Um.... Oh... Yeah. I see. Well, ReleaseAction. Nice piece of code.

      Rats. First attempt at posting craft and it's been done. Oh well. Maybe next time. As for a comparison, he allows a method call. I allow multiple subs. I should send tilly a patch or something.

      my @a=qw(random brilliant braindead); print $a[rand(@a)];
[reply]
        Store the release actions in an temporary array. When the array is freed, the actions will all fire. That is good enough for me.

        I am wondering whether it would be useful, though, to be able to add to the list of arguments. For instance: 

        while (1) {
  my $end = on_release {warn $_ for @_} "Out of the loop";
  # ...

  last if $cond;
  $end->add("Out of the loop 2");

  # ... etc
}

        [download]
        Yes? No? Maybe?

        (I am not convinced that it is worthwhile, but I could easily become so if someone has a good reason to use that.) </code> BTW I was using the germ of this code a few months ago, though it improved before placement on CPAN.

[reply]
[d/l]

Back to Craft