2 package # hide the package from PAUSE
10 use Scalar::Util 'refaddr';
12 use base 'Class::MOP::Class';
14 sub construct_instance {
15 my ($class, %params) = @_;
16 # create a scalar ref to use as
17 # the inside-out instance
18 my $instance = \(my $var);
19 foreach my $attr ($class->compute_all_applicable_attributes()) {
20 # if the attr has an init_arg, use that, otherwise,
21 # use the attributes name itself as the init_arg
22 my $init_arg = $attr->init_arg();
23 # try to fetch the init arg from the %params ...
25 $val = $params{$init_arg} if exists $params{$init_arg};
26 # if nothing was in the %params, we can use the
27 # attribute's default value (if it has one)
28 if (!defined $val && $attr->has_default) {
29 $val = $attr->default($instance);
31 # now add this to the instance structure
32 $class->get_package_variable('%' . $attr->name)->{ refaddr($instance) } = $val;
37 package # hide the package from PAUSE
38 InsideOutClass::Attribute;
43 our $VERSION = '0.04';
46 use Scalar::Util 'refaddr';
48 use base 'Class::MOP::Attribute';
50 sub generate_accessor_method {
51 my ($self, $attr_name) = @_;
52 $attr_name = ($self->associated_class->name . '::' . $attr_name);
54 $' . $attr_name . '{ refaddr($_[0]) } = $_[1] if scalar(@_) == 2;
55 $' . $attr_name . '{ refaddr($_[0]) };
59 sub generate_reader_method {
60 my ($self, $attr_name) = @_;
62 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
63 $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) };
67 sub generate_writer_method {
68 my ($self, $attr_name) = @_;
70 $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) } = $_[1];
74 sub generate_predicate_method {
75 my ($self, $attr_name) = @_;
77 defined($' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) }) ? 1 : 0;
81 ## &remove_attribute is left as an exercise for the reader :)
91 InsideOutClass - A set of example metaclasses which implement the Inside-Out technique
97 use metaclass 'InsideOutClass' => (
98 # tell our metaclass to use the
99 # InsideOut attribute metclass
100 # to construct all it's attributes
101 ':attribute_metaclass' => 'InsideOutClass::Attribute'
104 __PACKAGE__->meta->add_attribute('foo' => (
111 $class->meta->new_object(@_);
114 # now you can just use the class as normal
118 This is a set of example metaclasses which implement the Inside-Out
119 class technique. What follows is a brief explaination of the code
120 found in this module.
122 First step is to subclass B<Class::MOP::Class> and override the
123 C<construct_instance> method. The default C<construct_instance>
124 will create a HASH reference using the parameters and attribute
125 default values. Since inside-out objects don't use HASH refs, and
126 use package variables instead, we need to write code to handle
129 The next step is to create the subclass of B<Class::MOP::Attribute>
130 and override the method generation code. This requires overloading
131 C<generate_accessor_method>, C<generate_reader_method>,
132 C<generate_writer_method> and C<generate_predicate_method>. All
133 other aspects are taken care of with the existing B<Class::MOP::Attribute>
136 And that is pretty much all. Of course I am ignoring need for
137 inside-out objects to be C<DESTROY>-ed, and some other details as
138 well, but this is an example. A real implementation is left as an
139 exercise to the reader.
143 Stevan Little E<lt>stevan@iinteractive.comE<gt>
145 =head1 COPYRIGHT AND LICENSE
147 Copyright 2006 by Infinity Interactive, Inc.
149 L<http://www.iinteractive.com>
151 This library is free software; you can redistribute it and/or modify
152 it under the same terms as Perl itself.