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