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