Object::Prototype - Prototypal Object Model a la JavaScript


Object-Prototype documentation Contained in the Object-Prototype distribution.

Index


Code Index:

NAME

Top

Object::Prototype - Prototypal Object Model a la JavaScript

SYNOPSIS

Top

  use Object::Prototype;
  use What::Ever;
  my $classical = What::Ever->new();
  $classical->foo("bar");
  is $classical->foo, "bar";
  my $prototypal = Object::Prototype->new();
  $prototypal->foo # bar, of course;
  $prototypal->prototype( baz => sub { shift->foo . shift->bar });
  $prototypal->baz() # foobar
  $classical->baz()  # croaks

DESCRIPTION

Top

Object::Prototype implements JavaScript-like prototypal object system. If you are familiar with JavaScript's object system, you should have no problem using this module. If you are not, please read http://www.crockford.com/javascript/.

There is one advantage over JavaScript, however. As the example above, you can start with conventional, classical, perlish object as the prototype. To find how it is done, just see the source.

EXPORT

None.

METHODS

new($obj [, \%methods ])

Deeply clones $obj and make it a prototypal object. You can optionally add methods by passing a hashref like this;

  { method => sub { ... }, method2 => sub { ... } }

Which is a shorthand for

  my $p = Object::Prototype->new($obj);
  $p->prototype( method  => sub { ... } );
  $p->prototype( method2 => sub { ... } );

prototype($methname [ => \&code ]);

Accessor/Mutator of the object. You can implement the singleton method that way.

constructor()

Returns the constructor object. Consider this as prototypal SUPER.

  $p->prototype(method => sub{
    my $self   = shift;
    my $retval = $self->constructor->method(@_);
    # do whatever to $retval
    return $retval
  });

SEE ALSO

Top

Class::SingletonMethod, Class::Classless

http://www.crockford.com/javascript/

AUTHOR

Top

Dan Kogai, <dankogai@dan.co.jp>

COPYRIGHT AND LICENSE

Top


Object-Prototype documentation Contained in the Object-Prototype distribution.

package Object::Prototype;

# $Id: Prototype.pm,v 0.2 2007/04/07 01:57:59 dankogai Exp dankogai $
use 5.008001;
use strict;
use warnings;
use Carp;
use Scalar::Util qw(refaddr);
use Storable ();

our $VERSION = sprintf "%d.%02d", q$Revision: 0.2 $ =~ /(\d+)/g;
our $DEBUG = 0;
my %constructor_of;
my %prototype_of;

sub new($$;$) {
    my $class       = shift;
    my $constructor = shift;
    my $self        = Storable::dclone($constructor);
    my $id          = refaddr $self;
    $constructor_of{$id} = $constructor;
    $prototype_of{$id}   = {};
    bless $self => $class;
    for my $method ( keys %{ $_[0] } ) {
        $self->prototype( $method, $_[0]->{$method} );
    }
    return $self;
}

sub prototype($$;$) {
    my $self   = shift;
    my $id     = refaddr $self;
    my $method = shift;
    $prototype_of{$id}{$method} = shift if @_;
    return $prototype_of{$id}{$method};
}

sub constructor($) {
    my $self   = shift;
    my $id     = refaddr $self;
    return $constructor_of{$id}
}

sub DESTROY {
    my $id = refaddr shift;
    carp "DESTROY: $id" if $DEBUG;
    delete $constructor_of{$id};
    delete $prototype_of{$id};
}

sub AUTOLOAD {
    my $self   = shift;
    my $method = our $AUTOLOAD;
    $method =~ s/.*:://o;
    my $id = refaddr $self;
    warn "$id -> $method" if $DEBUG;
    my $code = $prototype_of{$id}{$method};
    return $self->$code(@_) if $code;
    while ( my $constructor = $constructor_of{$id} ) {
        warn "$constructor -> $method" if $DEBUG;
        $id = refaddr $constructor;
        $code = ref $constructor eq ref $self
          ? $prototype_of{$id}{$method}    # Prototypal
          : $constructor->can($method);    # Classical Perl Obj.
        return $self->$code(@_) if $code;
    }
    confess "unknown method : $method" if !$code;
}

1;
__END__
# Below is stub documentation for your module. You'd better edit it!