2 package # hide the package from PAUSE
10 our $VERSION = '0.02';
12 use Scalar::Util 'refaddr';
14 use base 'Class::MOP::Class';
16 sub construct_instance {
17 my ($class, %params) = @_;
18 # create a scalar ref to use as
19 # the inside-out instance
20 my $instance = \(my $var);
21 foreach my $attr (map { $_->{attribute} } $class->compute_all_applicable_attributes()) {
22 # if the attr has an init_arg, use that, otherwise,
23 # use the attributes name itself as the init_arg
24 my $init_arg = $attr->has_init_arg() ? $attr->init_arg() : $attr->name;
25 # try to fetch the init arg from the %params ...
27 $val = $params{$init_arg} if exists $params{$init_arg};
28 # if nothing was in the %params, we can use the
29 # attribute's default value (if it has one)
30 $val ||= $attr->default($instance) if $attr->has_default();
31 # now add this to the instance structure
32 $class->get_package_variable('%' . $attr->name)->{ refaddr($instance) } = $val;
37 sub attribute_metaclass { 'InsideOutClass::Attribute' }
39 package # hide the package from PAUSE
40 InsideOutClass::Attribute;
45 use Class::MOP 'meta';
47 our $VERSION = '0.03';
49 use Scalar::Util 'refaddr';
51 use base 'Class::MOP::Attribute';
53 sub generate_accessor_method {
54 my ($self, $attr_name) = @_;
55 $attr_name = ($self->associated_class->name . '::' . $attr_name);
57 $' . $attr_name . '{ refaddr($_[0]) } = $_[1] if scalar(@_) == 2;
58 $' . $attr_name . '{ refaddr($_[0]) };
62 sub generate_reader_method {
63 my ($self, $attr_name) = @_;
65 $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) };
69 sub generate_writer_method {
70 my ($self, $attr_name) = @_;
72 $' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) } = $_[1];
76 sub generate_predicate_method {
77 my ($self, $attr_name) = @_;
79 defined($' . ($self->associated_class->name . '::' . $attr_name) . '{ refaddr($_[0]) }) ? 1 : 0;
83 ## &remove_attribute is left as an exercise for the reader :)
93 InsideOutClass - A set of example metaclasses which implement the Inside-Out technique
99 sub meta { InsideOutClass->initialize($_[0]) }
101 __PACKAGE__->meta->add_attribute('foo' => (
108 bless $class->meta->construct_instance(@_) => $class;
111 # now you can just use the class as normal
115 This is a set of example metaclasses which implement the Inside-Out
116 class technique. What follows is a brief explaination of the code
117 found in this module.
119 First step is to subclass B<Class::MOP::Class> and override the
120 C<construct_instance> method. The default C<construct_instance>
121 will create a HASH reference using the parameters and attribute
122 default values. Since inside-out objects don't use HASH refs, and
123 use package variables instead, we need to write code to handle
126 The next step is to create the subclass of B<Class::MOP::Attribute>
127 and override the method generation code. This requires overloading
128 C<generate_accessor_method>, C<generate_reader_method>,
129 C<generate_writer_method> and C<generate_predicate_method>. All
130 other aspects are taken care of with the existing B<Class::MOP::Attribute>
133 And that is pretty much all. Of course I am ignoring need for
134 inside-out objects to be C<DESTROY>-ed, and some other details as
135 well, but this is an example. A real implementation is left as an
136 exercise to the reader.
140 Stevan Little E<lt>stevan@iinteractive.comE<gt>
142 =head1 COPYRIGHT AND LICENSE
144 Copyright 2006 by Infinity Interactive, Inc.
146 L<http://www.iinteractive.com>
148 This library is free software; you can redistribute it and/or modify
149 it under the same terms as Perl itself.