Commit | Line | Data |
24869f62 |
1 | |
2 | package Class::MOP::Instance; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Carp 'confess'; |
8 | use Scalar::Util 'blessed', 'reftype', 'weaken'; |
9 | |
10 | our $VERSION = '0.01'; |
11 | |
12 | sub meta { |
13 | require Class::MOP::Class; |
14 | Class::MOP::Class->initialize(blessed($_[0]) || $_[0]); |
15 | } |
16 | |
17 | sub new { |
49c93440 |
18 | my ($class, $meta) = @_; |
19 | my $slots = $class->_compute_slot_list_from_class($meta); |
24869f62 |
20 | bless { |
49c93440 |
21 | meta => $meta, |
22 | slots => $slots, |
24869f62 |
23 | } => $class; |
24 | } |
25 | |
49c93440 |
26 | # private for now ... |
27 | sub _compute_slot_list_from_class { |
28 | my ($self, $meta) = @_; |
29 | return [ |
30 | map { |
31 | $_->name |
32 | } $meta->compute_all_applicable_attributes() |
33 | ]; |
2d711cc8 |
34 | } |
35 | |
49c93440 |
36 | sub create_instance { |
37 | my $self = shift; |
38 | $self->bless_instance_structure({}); |
2d711cc8 |
39 | } |
40 | |
49c93440 |
41 | sub bless_instance_structure { |
42 | my ($self, $instance_structure) = @_; |
43 | bless $instance_structure, $self->{meta}->name; |
2d711cc8 |
44 | } |
45 | |
46 | # operations on meta instance |
47 | |
eb49acde |
48 | sub get_all_slots { |
49 | my $self = shift; |
49c93440 |
50 | return @{$self->{slots}}; |
839ea973 |
51 | } |
52 | |
2d711cc8 |
53 | # operations on created instances |
54 | |
839ea973 |
55 | sub get_slot_value { |
2bab2be6 |
56 | my ($self, $instance, $slot_name) = @_; |
57 | return $instance->{$slot_name}; |
839ea973 |
58 | } |
59 | |
2bab2be6 |
60 | sub set_slot_value { |
61 | my ($self, $instance, $slot_name, $value) = @_; |
62 | $instance->{$slot_name} = $value; |
63 | } |
64 | |
2d711cc8 |
65 | sub initialize_slot { |
49c93440 |
66 | my ($self, $instance, $slot_name) = @_; |
67 | $instance->{$slot_name} = undef; |
2d711cc8 |
68 | } |
69 | |
49c93440 |
70 | sub is_slot_initialized { |
71 | my ($self, $instance, $slot_name, $value) = @_; |
2d711cc8 |
72 | exists $instance->{$slot_name} ? 1 : 0; |
2bab2be6 |
73 | } |
839ea973 |
74 | |
2d711cc8 |
75 | # inlinable operation snippets |
76 | |
77 | sub inline_get_slot_value { |
49c93440 |
78 | my ($self, $instance_var_name, $slot_name) = @_; |
79 | return ($instance_var_name . '->{\'' . $slot_name . '\'}'); |
2d711cc8 |
80 | } |
81 | |
82 | sub inline_set_slot_value { |
49c93440 |
83 | my ($self, $instance_var_name, $slot_name, $value_name) = @_; |
84 | return ($self->inline_get_slot_value($instance_var_name, $slot_name) . ' = ' . $value_name); |
2d711cc8 |
85 | } |
86 | |
87 | sub inline_initialize_slot { |
49c93440 |
88 | my ($self, $instance_var_name, $slot_name) = @_; |
89 | $self->inline_set_slot_value($instance_var_name, $slot_name, 'undef'); |
2d711cc8 |
90 | } |
91 | |
49c93440 |
92 | sub inline_is_slot_initialized { |
93 | my ($self, $instance_var_name, $slot_name) = @_; |
94 | return ('exists ' . $self->inline_get_slot_value($instance_var_name, $slot_name) . ' ? 1 : 0'); |
2d711cc8 |
95 | } |
24869f62 |
96 | |
97 | 1; |
98 | |
99 | __END__ |
100 | |
101 | =pod |
102 | |
103 | =head1 NAME |
104 | |
105 | Class::MOP::Instance - Instance Meta Object |
106 | |
107 | =head1 SYNOPSIS |
108 | |
109 | =head1 DESCRIPTION |
110 | |
111 | =head1 METHODS |
112 | |
113 | =over 4 |
114 | |
115 | =item B<new> |
116 | |
58287a97 |
117 | =item B<bless_instance_structure> |
118 | |
49c93440 |
119 | =item B<compute_layout_from_class> |
120 | |
58287a97 |
121 | =item B<create_instance> |
122 | |
49c93440 |
123 | =item B<get_all_slots> |
839ea973 |
124 | |
125 | =item B<get_slot_value> |
126 | |
49c93440 |
127 | =item B<set_slot_value> |
58287a97 |
128 | |
129 | =item B<initialize_slot> |
130 | |
49c93440 |
131 | =item B<is_slot_initialized> |
58287a97 |
132 | |
49c93440 |
133 | =item B<inline_get_slot_value> |
58287a97 |
134 | |
135 | =item B<inline_set_slot_value> |
136 | |
49c93440 |
137 | =item B<inline_initialize_slot> |
76985bf2 |
138 | |
49c93440 |
139 | =item B<inline_is_slot_initialized> |
76985bf2 |
140 | |
24869f62 |
141 | =back |
142 | |
143 | =head2 Introspection |
144 | |
145 | =over 4 |
146 | |
147 | =item B<meta> |
148 | |
149 | This will return a B<Class::MOP::Class> instance which is related |
150 | to this class. |
151 | |
152 | =back |
153 | |
154 | =head1 AUTHOR |
155 | |
156 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
157 | |
158 | =head1 COPYRIGHT AND LICENSE |
159 | |
160 | Copyright 2006 by Infinity Interactive, Inc. |
161 | |
162 | L<http://www.iinteractive.com> |
163 | |
164 | This library is free software; you can redistribute it and/or modify |
165 | it under the same terms as Perl itself. |
166 | |
84ef30d1 |
167 | =cut |