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