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