| Class-Unique documentation | Contained in the Class-Unique distribution. |
Class::Unique - Create a unique subclass for every instance
Version 0.04
package MyClass;
use base 'Class::Unique';
sub foo { print "foo!\n"; }
sub bar { print "bar!\n"; }
...
use MyClass;
my $obj1 = MyClass->new;
my $obj2 = MyClass->new;
my $new_foo = sub { print "new foo!\n"; };
$obj2->install( foo => $new_foo );
$obj1->foo; $obj1->bar;
$obj2->foo; $obj2->bar;
Class::Unique is a base class which provides a constructor and some utility routines for creating objects which instantiate into a unique subclass.
If MyClass is a subclass
of Class::Unique, and inherrits Class::Unique's constructor, then every object returned
by MyClass->new will be blessed into a dynamically created subclass of MyClass. This
allows you to modify package data on a per-instance basis.
Class::Prototyped provides similar functionality; use this module if you want per-instance subclasses but you don't need a full prototype-based OO framework.
The following methods are inherrited.
new()Constructor. Returns a hash ref blessed into a new dynamically created package. If you need
to override the constructor, make sure you get your object by using SUPER::new instead
of blessing it yourself.
package MyClass;
use base 'Class::Unique';
sub new {
my $class = shift;
my $self = $class->SUPER::new( @_ );
# fiddle with $self here....
return $self;
}
install()Install a new symbol into an object's namespace. This can be used to dynamically override an inherrited subroutine, e.g.:
my $code_ref = sub { print "wahoo!\n" };
$obj->install( exclaim => $code_ref );
$obj->exclaim;
This is really just a shortcut for doing:
my $pkg = ref $obj;
no strict 'refs';
*{ $pkg . '::subname' } = $code_ref;
You can also use install to add other package symbols:
my @data = ( 1, 2, 3, 4 ); $obj->install( data => \@data );
Mike Friedman, <friedo at friedo dot com>
Thanks to Stevan Little for submitting some unit tests.
Please report any bugs or feature requests to
bug-class-unique@rt.cpan.org, or through the web interface at
http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class-Unique.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
Copyright 2005 Mike Friedman, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Class-Unique documentation | Contained in the Class-Unique distribution. |
package Class::Unique; use strict; use warnings; use Scalar::Util 'refaddr'; use Carp 'croak'; our $VERSION = '0.04'; my $PKG = "Class::Unique pkg"; sub new { my $class = shift; my $obj = { }; my $unique_class = $class . '::' . refaddr $obj; { no strict 'refs'; @{ $unique_class . '::ISA' } = ( $class ); } # so we don't have to rely on ref() $obj->{$PKG} = $unique_class; return bless $obj, $unique_class; } sub install { my $self = shift; my %args = @_; foreach my $s( keys %args ) { no strict 'refs'; *{ $self->{$PKG} . '::' . $s } = $args{$s}; } } 1;