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