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