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