examples/InsideOutClass.pod

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