X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=examples%2FInsideOutClass.pod;h=02139737ab4a553bd3cb3e87cef633c8942741a0;hb=2d711cc8f03b6d8cbfe53f9628883ff33582ed03;hp=1139f929555357800d246a6b7ee191899997801a;hpb=a977cf65eb3de88266b8f4b98936b43b8fbc03dd;p=gitmo%2FClass-MOP.git

diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod
index 1139f92..0213973 100644
--- a/examples/InsideOutClass.pod
+++ b/examples/InsideOutClass.pod
@@ -1,82 +1,53 @@
 
-package # hide the package from PAUSE
-    InsideOutClass;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.04';
-
-use Scalar::Util 'refaddr';
-
-use base 'Class::MOP::Class';
-
-sub construct_instance {
-    my ($class, %params) = @_;
-    # create a scalar ref to use as 
-    # the inside-out instance
-    my $instance = \(my $var);
-    foreach my $attr ($class->compute_all_applicable_attributes()) {
-        # if the attr has an init_arg, use that, otherwise,
-        # use the attributes name itself as the init_arg
-        my $init_arg = $attr->init_arg();
-        # try to fetch the init arg from the %params ...
-        my $val;        
-        $val = $params{$init_arg} if exists $params{$init_arg};
-        # if nothing was in the %params, we can use the 
-        # attribute's default value (if it has one)
-        if (!defined $val && $attr->has_default) {
-            $val = $attr->default($instance); 
-        }
-        # now add this to the instance structure
-        $class->get_package_variable('%' . $attr->name)->{ refaddr($instance) } = $val;
-    }    
-    return $instance;
-}
 
 package # hide the package from PAUSE
-    InsideOutClass::Attribute;
+    InsideOutClass::Instance;
 
 use strict;
 use warnings;
 
-our $VERSION = '0.04';
+our $VERSION = '0.06';
 
+use Carp         'confess';
 use Scalar::Util 'refaddr';
 
-use base 'Class::MOP::Attribute';
+use base 'Class::MOP::Instance';
+
+sub create_instance {
+	my ( $self, $class ) = @_;
+	my $x;
+	bless \$x, $class || $self->{meta}->name;
+}
 
-sub generate_accessor_method {
-    my ($self, $attr_name) = @_;
-    $attr_name = ($self->associated_class->name . '::' . $attr_name);
-    eval 'sub {
-        $' . $attr_name . '{ refaddr($_[0]) } = $_[1] if scalar(@_) == 2;
-        $' . $attr_name . '{ refaddr($_[0]) };
-    }';
+sub add_slot {
+	my ( $self, $slot_name ) = @_;
+	$self->{containers}{$slot_name} = do {
+		my $fqn = $self->{meta}->name . "::" . $slot_name;
+		no strict 'refs';
+		\%$fqn;
+	};
+	$self->SUPER::add_slot( $slot_name );
 }
 
-sub generate_reader_method {
-    my ($self, $attr_name) = @_;     
-    eval 'sub {
-        $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) };
-    }';   
+sub get_slot_value {
+	my ( $self, $instance, $slot_name ) = @_;
+	confess "$self is no instance" unless ref $self;
+	$self->{containers}{$slot_name}{refaddr $instance};
 }
 
-sub generate_writer_method {
-    my ($self, $attr_name) = @_; 
-    eval 'sub {
-        $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) } = $_[1];
-    }';
+sub set_slot_value {
+	my ( $self, $instance, $slot_name, $value ) = @_;
+	$self->{containers}{$slot_name}{refaddr $instance} = $value;
 }
 
-sub generate_predicate_method {
-    my ($self, $attr_name) = @_; 
-    eval 'sub {
-        defined($' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) }) ? 1 : 0;
-    }';
+sub initialize_slot { }
+
+sub slot_initialized {
+	my ( $self, $instance, $slot_name ) = @_;
+	exists $self->{containers}{$slot_name}{refaddr $instance};
 }
 
-## &remove_attribute is left as an exercise for the reader :)
+## &remove_slot is left as an exercise for the reader :)
 
 1;
 
@@ -92,11 +63,11 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec
 
   package Foo;
   
-  use metaclass 'InsideOutClass' => (
+  use metaclass 'Class::MOP::Class' => (
      # tell our metaclass to use the 
      # InsideOut attribute metclass 
      # to construct all it's attributes
-    ':attribute_metaclass' => 'InsideOutClass::Attribute'
+    ':instance_metaclass' => 'InsideOutClass::Instance'
   );
   
   __PACKAGE__->meta->add_attribute('foo' => (
@@ -117,29 +88,26 @@ This is a set of example metaclasses which implement the Inside-Out
 class technique. What follows is a brief explaination of the code 
 found in this module.
 
-First step is to subclass B<Class::MOP::Class> and override the 
-C<construct_instance> method. The default C<construct_instance> 
-will create a HASH reference using the parameters and attribute 
-default values. Since inside-out objects don't use HASH refs, and 
-use package variables instead, we need to write code to handle 
-this difference. 
-
-The next step is to create the subclass of B<Class::MOP::Attribute> 
-and override the method generation code. This requires overloading 
-C<generate_accessor_method>, C<generate_reader_method>, 
-C<generate_writer_method> and C<generate_predicate_method>. All 
-other aspects are taken care of with the existing B<Class::MOP::Attribute> 
-infastructure.
+We must create a subclass of B<Class::MOP::Instance> and override 
+the slot operations. This requires 
+overloading C<get_slot_value>, C<set_slot_value>, C<slot_initialized>, and
+C<initialize_slot>, as well as their inline counterparts. Additionally we
+overload C<add_slot> in order to initialize the global hash containing the
+actual slot values.
 
 And that is pretty much all. Of course I am ignoring need for 
 inside-out objects to be C<DESTROY>-ed, and some other details as 
-well, but this is an example. A real implementation is left as an 
-exercise to the reader.
+well (threading, etc), but this is an example. A real implementation is left as
+an exercise to the reader.
 
 =head1 AUTHOR
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+=head1 SEE ALSO
+
+L<Tie::RefHash::Weak>
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006 by Infinity Interactive, Inc.