Next Higher-Order Perl 124 

Anonymous Subroutines as Objects

        sub new_object {
          my ($methods, $data, $parent) = @_;
          my ($target, $self);
          $self = sub {
            my $m = shift;
            if (ref $m) { ($m, $target) = @$m }
            else        {      $target  = $self } 
            if (exists $methods->{$m}) {
              return $methods->{$m}->(@_);
            } elsif (exists $data->{$m}) { # accessor method
              if (@_) { $data->{$m} = shift() }
              else    { return $data->{$m}    }
            } elsif (defined $parent) {
              return $parent->([$m, $target], @_);
            } else {    
              die "Unknown method called on object $target\n";
            }
          };
          return $self;
        }

Next Copyright © 2006 M. J. Dominus