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