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