1package # hide the package from PAUSE
2    LazyClass::Attribute;
3
4use strict;
5use warnings;
6
7use Carp 'confess';
8
9our $VERSION = '0.05';
10
11use parent 'Class::MOP::Attribute';
12
13sub initialize_instance_slot {
14    my ($self, $meta_instance, $instance, $params) = @_;
15
16    # if the attr has an init_arg, use that, otherwise,
17    # use the attributes name itself as the init_arg
18    my $init_arg = $self->init_arg();
19
20    if ( exists $params->{$init_arg} ) {
21        my $val = $params->{$init_arg};
22        $meta_instance->set_slot_value($instance, $self->name, $val);
23    }
24}
25
26sub accessor_metaclass { 'LazyClass::Method::Accessor' }
27
28package # hide the package from PAUSE
29    LazyClass::Method::Accessor;
30
31use strict;
32use warnings;
33
34use Carp 'confess';
35
36our $VERSION = '0.01';
37
38use parent 'Class::MOP::Method::Accessor';
39
40sub _generate_accessor_method {
41    my $attr = (shift)->associated_attribute;
42
43    my $attr_name = $attr->name;
44    my $meta_instance = $attr->associated_class->get_meta_instance;
45
46    sub {
47        if (scalar(@_) == 2) {
48            $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
49        }
50        else {
51            unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
52                my $value = $attr->has_default ? $attr->default($_[0]) : undef;
53                $meta_instance->set_slot_value($_[0], $attr_name, $value);
54            }
55
56            $meta_instance->get_slot_value($_[0], $attr_name);
57        }
58    };
59}
60
61sub _generate_reader_method {
62    my $attr = (shift)->associated_attribute;
63
64    my $attr_name = $attr->name;
65    my $meta_instance = $attr->associated_class->get_meta_instance;
66
67    sub {
68        confess "Cannot assign a value to a read-only accessor" if @_ > 1;
69
70        unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
71            my $value = $attr->has_default ? $attr->default($_[0]) : undef;
72            $meta_instance->set_slot_value($_[0], $attr_name, $value);
73        }
74
75        $meta_instance->get_slot_value($_[0], $attr_name);
76    };
77}
78
79package # hide the package from PAUSE
80    LazyClass::Instance;
81
82use strict;
83use warnings;
84
85our $VERSION = '0.01';
86
87use parent 'Class::MOP::Instance';
88
89sub initialize_all_slots {}
90
911;
92
93__END__
94
95=pod
96
97=head1 NAME
98
99LazyClass - An example metaclass with lazy initialization
100
101=head1 SYNOPSIS
102
103  package BinaryTree;
104
105  use metaclass (
106      ':attribute_metaclass' => 'LazyClass::Attribute',
107      ':instance_metaclass'  => 'LazyClass::Instance',
108  );
109
110  BinaryTree->meta->add_attribute('node' => (
111      accessor => 'node',
112      init_arg => ':node'
113  ));
114
115  BinaryTree->meta->add_attribute('left' => (
116      reader  => 'left',
117      default => sub { BinaryTree->new() }
118  ));
119
120  BinaryTree->meta->add_attribute('right' => (
121      reader  => 'right',
122      default => sub { BinaryTree->new() }
123  ));
124
125  sub new  {
126      my $class = shift;
127      $class->meta->new_object(@_);
128  }
129
130  # ... later in code
131
132  my $btree = BinaryTree->new();
133  # ... $btree is an empty hash, no keys are initialized yet
134
135=head1 DESCRIPTION
136
137This is an example metclass in which all attributes are created
138lazily. This means that no entries are made in the instance HASH
139until the last possible moment.
140
141The example above of a binary tree is a good use for such a
142metaclass because it allows the class to be space efficient
143without complicating the programing of it. This would also be
144ideal for a class which has a large amount of attributes,
145several of which are optional.
146
147=head1 AUTHORS
148
149Stevan Little E<lt>stevan@iinteractive.comE<gt>
150
151Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
152
153=cut
154