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