lib/Moose.pm

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