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