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