Have is_class_loaded use the old code from Moose's ClassName type check
[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
ba38bf08 10our $VERSION = '0.05';
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
ba38bf08 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
4300f56a 41sub generate_accessor_method {
ba38bf08 42 my $attr = (shift)->associated_attribute;
2d711cc8 43
49c93440 44 my $attr_name = $attr->name;
2d711cc8 45 my $meta_instance = $attr->associated_class->get_meta_instance;
46
4300f56a 47 sub {
48 if (scalar(@_) == 2) {
49c93440 49 $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
4300f56a 50 }
51 else {
49c93440 52 unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
2d711cc8 53 my $value = $attr->has_default ? $attr->default($_[0]) : undef;
49c93440 54 $meta_instance->set_slot_value($_[0], $attr_name, $value);
2d711cc8 55 }
56
49c93440 57 $meta_instance->get_slot_value($_[0], $attr_name);
4300f56a 58 }
59 };
60}
61
62sub generate_reader_method {
ba38bf08 63 my $attr = (shift)->associated_attribute;
2d711cc8 64
49c93440 65 my $attr_name = $attr->name;
2d711cc8 66 my $meta_instance = $attr->associated_class->get_meta_instance;
67
4300f56a 68 sub {
b9dfbf78 69 confess "Cannot assign a value to a read-only accessor" if @_ > 1;
2d711cc8 70
49c93440 71 unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
2d711cc8 72 my $value = $attr->has_default ? $attr->default($_[0]) : undef;
49c93440 73 $meta_instance->set_slot_value($_[0], $attr_name, $value);
2d711cc8 74 }
75
49c93440 76 $meta_instance->get_slot_value($_[0], $attr_name);
4300f56a 77 };
78}
79
0e76a376 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
4300f56a 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
1becdfcc 106 use metaclass (
107 ':attribute_metaclass' => 'LazyClass::Attribute',
108 ':instance_metaclass' => 'LazyClass::Instance',
677eb158 109 );
4300f56a 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
5659d76e 126 sub new {
4300f56a 127 my $class = shift;
5659d76e 128 $class->meta->new_object(@_);
4300f56a 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
1a09d9cc 148=head1 AUTHORS
4300f56a 149
150Stevan Little E<lt>stevan@iinteractive.comE<gt>
151
1a09d9cc 152Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
153
4300f56a 154=head1 COPYRIGHT AND LICENSE
155
69e3ab0a 156Copyright 2006-2008 by Infinity Interactive, Inc.
4300f56a 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
2d711cc8 163=cut