Class::Unique - Create a unique subclass for every instance


Class-Unique documentation Contained in the Class-Unique distribution.

Index


Code Index:

NAME

Top

Class::Unique - Create a unique subclass for every instance

VERSION

Top

Version 0.04

SYNOPSIS

Top

  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;

DESCRIPTION

Top

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.

METHODS

Top

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 );




AUTHOR

Top

Mike Friedman, <friedo at friedo dot com>

THANKS

Top

Thanks to Stevan Little for submitting some unit tests.

BUGS

Top

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 & LICENSE

Top


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;