examples/InsideOutClass.pod

   1
   2
   3 package # hide the package from PAUSE
   4     InsideOutClass::Instance;
   5
   6 use strict;
   7 use warnings;
   8
   9 our $VERSION = '0.06';
  10
  11 use Carp         'confess';
  12 use Scalar::Util 'refaddr';
  13
  14 use base 'Class::MOP::Instance';
  15
  16 sub create_instance {
  17         my ( $self, $class ) = @_;
  18         my $x;
  19         bless \$x, $class || $self->{meta}->name;
  20 }
  21
  22 sub add_slot {
  23         my ( $self, $slot_name ) = @_;
  24         $self->{containers}{$slot_name} = do {
  25                 my $fqn = $self->{meta}->name . "::" . $slot_name;
  26                 no strict 'refs';
  27                 \%$fqn;
  28         };
  29         $self->SUPER::add_slot( $slot_name );
  30 }
  31
  32 sub get_slot_value {
  33         my ( $self, $instance, $slot_name ) = @_;
  34         confess "$self is no instance" unless ref $self;
  35         $self->{containers}{$slot_name}{refaddr $instance};
  36 }
  37
  38 sub set_slot_value {
  39         my ( $self, $instance, $slot_name, $value ) = @_;
  40         $self->{containers}{$slot_name}{refaddr $instance} = $value;
  41 }
  42
  43 sub initialize_slot { }
  44
  45 sub slot_initialized {
  46         my ( $self, $instance, $slot_name ) = @_;
  47         exists $self->{containers}{$slot_name}{refaddr $instance};
  48 }
  49
  50 ## &remove_slot is left as an exercise for the reader :)
  51
  52 1;
  53
  54 __END__
  55
  56 =pod
  57
  58 =head1 NAME
  59
  60 InsideOutClass - A set of example metaclasses which implement the Inside-Out technique
  61
  62 =head1 SYNOPSIS
  63
  64   package Foo;
  65
  66   use metaclass 'Class::MOP::Class' => (
  67      # tell our metaclass to use the
  68      # InsideOut attribute metclass
  69      # to construct all it's attributes
  70     ':instance_metaclass' => 'InsideOutClass::Instance'
  71   );
  72
  73   __PACKAGE__->meta->add_attribute('foo' => (
  74       reader => 'get_foo',
  75       writer => 'set_foo'
  76   ));
  77
  78   sub new  {
  79       my $class = shift;
  80       $class->meta->new_object(@_);
  81   }
  82
  83   # now you can just use the class as normal
  84
  85 =head1 DESCRIPTION
  86
  87 This is a set of example metaclasses which implement the Inside-Out
  88 class technique. What follows is a brief explaination of the code
  89 found in this module.
  90
  91 We must create a subclass of B<Class::MOP::Instance> and override
  92 the slot operations. This requires
  93 overloading C<get_slot_value>, C<set_slot_value>, C<slot_initialized>, and
  94 C<initialize_slot>, as well as their inline counterparts. Additionally we
  95 overload C<add_slot> in order to initialize the global hash containing the
  96 actual slot values.
  97
  98 And that is pretty much all. Of course I am ignoring need for
  99 inside-out objects to be C<DESTROY>-ed, and some other details as
 100 well (threading, etc), but this is an example. A real implementation is left as
 101 an exercise to the reader.
 102
 103 =head1 AUTHOR
 104
 105 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 106
 107 =head1 SEE ALSO
 108
 109 L<Tie::RefHash::Weak>
 110
 111 =head1 COPYRIGHT AND LICENSE
 112
 113 Copyright 2006 by Infinity Interactive, Inc.
 114
 115 L<http://www.iinteractive.com>
 116
 117 This library is free software; you can redistribute it and/or modify
 118 it under the same terms as Perl itself.
 119
 120 =cut