707a2fe885940909ae2c1ae931cc5561b9de44ca
[gitmo/Moose.git] / lib / Moose.pm
1
2 use lib '/Users/stevan/Projects/CPAN/Class-MOP/Class-MOP/lib';
3
4 package Moose;
5
6 use strict;
7 use warnings;
8
9 our $VERSION = '0.05';
10
11 use Scalar::Util 'blessed', 'reftype';
12 use Carp         'confess';
13 use Sub::Name    'subname';
14
15 use UNIVERSAL::require;
16 use Sub::Exporter;
17
18 use Class::MOP;
19
20 use Moose::Meta::Class;
21 use Moose::Meta::TypeConstraint;
22 use Moose::Meta::TypeCoercion;
23 use Moose::Meta::Attribute;
24 use Moose::Meta::Instance;
25
26 use Moose::Object;
27 use Moose::Util::TypeConstraints;
28
29 {
30     my $CALLER;
31
32     sub _init_meta {
33         my $class = $CALLER;
34
35         # make a subtype for each Moose class
36         subtype $class
37             => as 'Object'
38             => where { $_->isa($class) }
39         unless find_type_constraint($class);
40
41         my $meta;
42         if ($class->can('meta')) {
43             # NOTE:
44             # this is the case where the metaclass pragma 
45             # was used before the 'use Moose' statement to 
46             # override a specific class
47             $meta = $class->meta();
48             (blessed($meta) && $meta->isa('Moose::Meta::Class'))
49                 || confess "Whoops, not møøsey enough";
50         }
51         else {
52             # NOTE:
53             # this is broken currently, we actually need 
54             # to allow the possiblity of an inherited 
55             # meta, which will not be visible until the 
56             # user 'extends' first. This needs to have 
57             # more intelligence to it 
58             $meta = Moose::Meta::Class->initialize($class);
59             $meta->add_method('meta' => sub {
60                 # re-initialize so it inherits properly
61                 Moose::Meta::Class->initialize(blessed($_[0]) || $_[0]);
62             })
63         }
64
65         # make sure they inherit from Moose::Object
66         $meta->superclasses('Moose::Object')
67            unless $meta->superclasses();
68     }
69
70     my %exports = (
71         extends => sub {
72             my $class = $CALLER;
73             return subname 'Moose::extends' => sub {
74                 _load_all_classes(@_);
75                 my $meta = $class->meta;
76                 foreach my $super (@_) {
77                     # don't bother if it does not have a meta.
78                     next unless $super->can('meta');
79                     # if it's meta is a vanilla Moose, 
80                     # then we can safely ignore it.
81                     next if blessed($super->meta) eq 'Moose::Meta::Class';
82                     # but if we have anything else, 
83                     # we need to check it out ...
84                     unless (# see if of our metaclass is incompatible
85                             $meta->isa(blessed($super->meta)) &&
86                             # see if our instance metaclass is incompatible
87                             $meta->instance_metaclass->isa($super->meta->instance_metaclass) &&
88                             # ... and if we are just a vanilla Moose
89                             $meta->isa('Moose::Meta::Class')) {
90                         # re-initialize the meta ...
91                         my $super_meta = $super->meta;
92                         $meta = $super_meta->reinitialize($class => (
93                             ':attribute_metaclass' => $super_meta->attribute_metaclass,                            
94                             ':method_metaclass'    => $super_meta->method_metaclass,
95                             ':instance_metaclass'  => $super_meta->instance_metaclass,
96                         ));
97                     }
98                 }
99                 $meta->superclasses(@_);
100             };
101         },
102         with => sub {
103             my $class = $CALLER;
104             return subname 'Moose::with' => sub {
105                 my ($role) = @_;
106                 _load_all_classes($role);
107                 $role->meta->apply($class->meta);
108             };
109         },
110         has => sub {
111             my $class = $CALLER;
112             return subname 'Moose::has' => sub {
113                 my ($name, %options) = @_;
114                 my $meta = $class->meta;
115                 if ($name =~ /^\+(.*)/) {
116                     my $inherited_attr = $meta->find_attribute_by_name($1);
117                     (defined $inherited_attr)
118                         || confess "Could not find an attribute by the name of '$1' to inherit from";
119                     my $new_attr = $inherited_attr->clone_and_inherit_options(%options);
120                     $meta->add_attribute($new_attr);
121                 }
122                 else {
123                     if ($options{metaclass}) {
124                         _load_all_classes($options{metaclass});
125                         $meta->add_attribute($options{metaclass}->new($name, %options));
126                     }
127                     else {
128                         $meta->add_attribute($name, %options);
129                     }
130                 }
131             };
132         },
133         before => sub {
134             my $class = $CALLER;
135             return subname 'Moose::before' => sub {
136                 my $code = pop @_;
137                 my $meta = $class->meta;
138                 $meta->add_before_method_modifier($_, $code) for @_;
139             };
140         },
141         after => sub {
142             my $class = $CALLER;
143             return subname 'Moose::after' => sub {
144                 my $code = pop @_;
145                 my $meta = $class->meta;
146                 $meta->add_after_method_modifier($_, $code) for @_;
147             };
148         },
149         around => sub {
150             my $class = $CALLER;            
151             return subname 'Moose::around' => sub {
152                 my $code = pop @_;
153                 my $meta = $class->meta;
154                 $meta->add_around_method_modifier($_, $code) for @_;
155             };
156         },
157         super => sub {
158             return subname 'Moose::super' => sub {};
159         },
160         override => sub {
161             my $class = $CALLER;
162             return subname 'Moose::override' => sub {
163                 my ($name, $method) = @_;
164                 $class->meta->add_override_method_modifier($name => $method);
165             };
166         },
167         inner => sub {
168             return subname 'Moose::inner' => sub {};
169         },
170         augment => sub {
171             my $class = $CALLER;
172             return subname 'Moose::augment' => sub {
173                 my ($name, $method) = @_;
174                 $class->meta->add_augment_method_modifier($name => $method);
175             };
176         },
177         confess => sub {
178             return \&Carp::confess;
179         },
180         blessed => sub {
181             return \&Scalar::Util::blessed;
182         },
183         all_methods => sub {
184             subname 'Moose::all_methods' => sub () {
185                 sub {
186                     my ($class, $delegate_class) = @_;
187                     $delegate_class->compute_all_applicable_methods();
188                 }
189             }
190         }
191     );
192
193     my $exporter = Sub::Exporter::build_exporter({ 
194         exports => \%exports,
195         groups  => {
196             default => [':all']
197         }
198     });
199     
200     sub import {     
201         $CALLER = caller();
202
203         # we should never export to main
204         return if $CALLER eq 'main';
205     
206         _init_meta();
207         
208         goto $exporter;
209     }
210 }
211
212 ## Utility functions
213
214 sub _load_all_classes {
215     foreach my $super (@_) {
216         # see if this is already 
217         # loaded in the symbol table
218         next if _is_class_already_loaded($super);
219         # otherwise require it ...
220         ($super->require)
221             || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR;
222     }    
223 }
224
225 sub _is_class_already_loaded {
226         my $name = shift;
227         no strict 'refs';
228         return 1 if defined ${"${name}::VERSION"} || defined @{"${name}::ISA"};
229         foreach (keys %{"${name}::"}) {
230                 next if substr($_, -2, 2) eq '::';
231                 return 1 if defined &{"${name}::$_"};
232         }
233     return 0;
234 }
235
236 1;
237
238 __END__
239
240 =pod
241
242 =head1 NAME
243
244 Moose - Moose, it's the new Camel
245
246 =head1 SYNOPSIS
247
248   package Point;
249   use Moose;
250         
251   has 'x' => (isa => 'Int', is => 'rw');
252   has 'y' => (isa => 'Int', is => 'rw');
253   
254   sub clear {
255       my $self = shift;
256       $self->x(0);
257       $self->y(0);    
258   }
259   
260   package Point3D;
261   use Moose;
262   
263   extends 'Point';
264   
265   has 'z' => (isa => 'Int');
266   
267   after 'clear' => sub {
268       my $self = shift;
269       $self->{z} = 0;
270   };
271   
272 =head1 CAVEAT
273
274 This is an early release of this module, it still needs 
275 some fine tuning and B<lots> more documentation. I am adopting 
276 the I<release early and release often> approach with this module, 
277 so keep an eye on your favorite CPAN mirror!
278
279 =head1 DESCRIPTION
280
281 Moose is an extension of the Perl 5 object system. 
282
283 =head2 Another object system!?!?
284
285 Yes, I know there has been an explosion recently of new ways to 
286 build object's in Perl 5, most of them based on inside-out objects, 
287 and other such things. Moose is different because it is not a new 
288 object system for Perl 5, but instead an extension of the existing 
289 object system.
290
291 Moose is built on top of L<Class::MOP>, which is a metaclass system 
292 for Perl 5. This means that Moose not only makes building normal 
293 Perl 5 objects better, but it also provides the power of metaclass 
294 programming.
295
296 =head2 What does Moose stand for??
297
298 Moose doesn't stand for one thing in particular, however, if you 
299 want, here are a few of my favorites, feel free to contribute 
300 more :)
301
302 =over 4
303
304 =item Make Other Object Systems Envious
305
306 =item Makes Object Orientation So Easy
307
308 =item Makes Object Orientation Spiffy- Er  (sorry ingy)
309
310 =item Most Other Object Systems Emasculate
311
312 =item My Overcraft Overfilled (with) Some Eels
313
314 =item Moose Often Ovulate Sorta Early
315
316 =item Many Overloaded Object Systems Exists 
317
318 =item Moose Offers Often Super Extensions
319
320 =item Meta Object Orientation Syntax Extensions
321
322 =back
323
324 =head1 BUILDING CLASSES WITH MOOSE
325
326 Moose makes every attempt to provide as much convience during class 
327 construction/definition, but still stay out of your way if you want 
328 it to. Here are some of the features Moose provides:
329
330 Unless specified with C<extends>, any class which uses Moose will 
331 inherit from L<Moose::Object>.
332
333 Moose will also manage all attributes (including inherited ones) that 
334 are defined with C<has>. And assuming that you call C<new> which is 
335 inherited from L<Moose::Object>, then this includes properly initializing 
336 all instance slots, setting defaults where approprtiate and performing any 
337 type constraint checking or coercion. 
338
339 For more details, see the ever expanding L<Moose::Cookbook>.
340
341 =head1 EXPORTED FUNCTIONS
342
343 Moose will export a number of functions into the class's namespace, which 
344 can then be used to set up the class. These functions all work directly 
345 on the current class.
346
347 =over 4
348
349 =item B<meta>
350
351 This is a method which provides access to the current class's metaclass.
352
353 =item B<extends (@superclasses)>
354
355 This function will set the superclass(es) for the current class.
356
357 This approach is recommended instead of C<use base>, because C<use base> 
358 actually C<push>es onto the class's C<@ISA>, whereas C<extends> will 
359 replace it. This is important to ensure that classes which do not have 
360 superclasses properly inherit from L<Moose::Object>.
361
362 =item B<with ($role)>
363
364 This will apply a given C<$role> to the local class. Role support is 
365 currently very experimental, see L<Moose::Role> for more details.
366
367 =item B<has ($name, %options)>
368
369 This will install an attribute of a given C<$name> into the current class. 
370 The list of C<%options> are the same as those provided by both 
371 L<Class::MOP::Attribute> and L<Moose::Meta::Attribute>, in addition to a 
372 few convience ones provided by Moose which are listed below:
373
374 =over 4
375
376 =item I<is =E<gt> 'rw'|'ro'>
377
378 The I<is> option accepts either I<rw> (for read/write) or I<ro> (for read 
379 only). These will create either a read/write accessor or a read-only 
380 accessor respectively, using the same name as the C<$name> of the attribute.
381
382 If you need more control over how your accessors are named, you can use the 
383 I<reader>, I<writer> and I<accessor> options inherited from L<Moose::Meta::Attribute>.
384
385 =item I<isa =E<gt> $type_name>
386
387 The I<isa> option uses Moose's type constraint facilities to set up runtime 
388 type checking for this attribute. Moose will perform the checks during class 
389 construction, and within any accessors. The C<$type_name> argument must be a 
390 string. The string can be either a class name, or a type defined using 
391 Moose's type defintion features.
392
393 =item I<coerce =E<gt> (1|0)>
394
395 This will attempt to use coercion with the supplied type constraint to change 
396 the value passed into any accessors of constructors. You B<must> have supplied 
397 a type constraint in order for this to work. See L<Moose::Cookbook::Recipe5>
398 for an example usage.
399
400 =item I<does =E<gt> $role_name>
401
402 This will accept the name of a role which the value stored in this attribute 
403 is expected to have consumed.
404
405 =item I<required =E<gt> (1|0)>
406
407 This marks the attribute as being required. This means a value must be supplied 
408 during class construction, and the attribute can never be set to C<undef> with 
409 an accessor. 
410
411 =item I<weak_ref =E<gt> (1|0)>
412
413 This will tell the class to strore the value of this attribute as a weakened 
414 reference. If an attribute is a weakened reference, it can B<not> also be coerced. 
415
416 =item I<lazy =E<gt> (1|0)>
417
418 This will tell the class to not create this slot until absolutely nessecary. 
419 If an attribute is marked as lazy it B<must> have a default supplied.
420
421 =item I<trigger =E<gt> $code>
422
423 The trigger option is a CODE reference which will be called after the value of 
424 the attribute is set. The CODE ref will be passed the instance itself, the 
425 updated value and the attribute meta-object (this is for more advanced fiddling
426 and can typically be ignored in most cases). You can B<not> have a trigger on 
427 a read-only attribute.
428
429 =back
430
431 =item B<before $name|@names =E<gt> sub { ... }>
432
433 =item B<after $name|@names =E<gt> sub { ... }>
434
435 =item B<around $name|@names =E<gt> sub { ... }>
436
437 This three items are syntactic sugar for the before, after and around method 
438 modifier features that L<Class::MOP> provides. More information on these can 
439 be found in the L<Class::MOP> documentation for now. 
440
441 =item B<super>
442
443 The keyword C<super> is a noop when called outside of an C<override> method. In 
444 the context of an C<override> method, it will call the next most appropriate 
445 superclass method with the same arguments as the original method.
446
447 =item B<override ($name, &sub)>
448
449 An C<override> method, is a way of explictly saying "I am overriding this 
450 method from my superclass". You can call C<super> within this method, and 
451 it will work as expected. The same thing I<can> be accomplished with a normal 
452 method call and the C<SUPER::> pseudo-package, it is really your choice. 
453
454 =item B<inner>
455
456 The keyword C<inner>, much like C<super>, is a no-op outside of the context of 
457 an C<augment> method. You can think of C<inner> as being the inverse of 
458 C<super>, the details of how C<inner> and C<augment> work is best described in 
459 the L<Moose::Cookbook>.
460
461 =item B<augment ($name, &sub)>
462
463 An C<augment> method, is a way of explictly saying "I am augmenting this 
464 method from my superclass". Once again, the details of how C<inner> and 
465 C<augment> work is best described in the L<Moose::Cookbook>.
466
467 =item B<confess>
468
469 This is the C<Carp::confess> function, and exported here beause I use it 
470 all the time. This feature may change in the future, so you have been warned. 
471
472 =item B<blessed>
473
474 This is the C<Scalar::Uti::blessed> function, it is exported here beause I 
475 use it all the time. It is highly recommended that this is used instead of 
476 C<ref> anywhere you need to test for an object's class name.
477
478 =back
479
480 =head1 CAVEATS
481
482 =over 4
483
484 =item *
485
486 It should be noted that C<super> and C<inner> can B<not> be used in the same 
487 method. However, they can be combined together with the same class hierarchy, 
488 see F<t/014_override_augment_inner_super.t> for an example. 
489
490 The reason that this is so is because C<super> is only valid within a method 
491 with the C<override> modifier, and C<inner> will never be valid within an 
492 C<override> method. In fact, C<augment> will skip over any C<override> methods 
493 when searching for it's appropriate C<inner>. 
494
495 This might seem like a restriction, but I am of the opinion that keeping these 
496 two features seperate (but interoperable) actually makes them easy to use since 
497 their behavior is then easier to predict. Time will tell if I am right or not.
498
499 =back
500
501 =head1 ACKNOWLEDGEMENTS
502
503 =over 4
504
505 =item I blame Sam Vilain for introducing me to the insanity that is meta-models.
506
507 =item I blame Audrey Tang for then encouraging my meta-model habit in #perl6.
508
509 =item Without Yuval "nothingmuch" Kogman this module would not be possible, 
510 and it certainly wouldn't have this name ;P
511
512 =item The basis of the TypeContraints module was Rob Kinyon's idea 
513 originally, I just ran with it.
514
515 =item Thanks to mst & chansen and the whole #moose poose for all the 
516 ideas/feature-requests/encouragement
517
518 =back
519
520 =head1 SEE ALSO
521
522 =over 4
523
524 =item L<Class::MOP> documentation
525
526 =item The #moose channel on irc.perl.org
527
528 =item L<http://forum2.org/moose/>
529
530 =item L<http://www.cs.utah.edu/plt/publications/oopsla04-gff.pdf>
531
532 This paper (suggested by lbr on #moose) was what lead to the implementation 
533 of the C<super>/C<overrride> and C<inner>/C<augment> features. If you really 
534 want to understand this feature, I suggest you read this.
535
536 =back
537
538 =head1 BUGS
539
540 All complex software has bugs lurking in it, and this module is no 
541 exception. If you find a bug please either email me, or add the bug
542 to cpan-RT.
543
544 =head1 AUTHOR
545
546 Stevan Little E<lt>stevan@iinteractive.comE<gt>
547
548 =head1 COPYRIGHT AND LICENSE
549
550 Copyright 2006 by Infinity Interactive, Inc.
551
552 L<http://www.iinteractive.com>
553
554 This library is free software; you can redistribute it and/or modify
555 it under the same terms as Perl itself. 
556
557 =cut