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