lib/Moose.pm

   1
   2 package Moose;
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.03';
   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             foreach my $super (@_) {
  64                 # see if this is already
  65                 # loaded in the symbol table
  66             next if _is_class_already_loaded($super);
  67             # otherwise require it ...
  68             ($super->require)
  69                     || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR;
  70             }
  71             $meta->superclasses(@_)
  72         });
  73
  74         # handle attributes
  75         $meta->alias_method('has' => subname 'Moose::has' => sub {
  76                 my ($name, %options) = @_;
  77                 if (exists $options{is}) {
  78                         if ($options{is} eq 'ro') {
  79                                 $options{reader} = $name;
  80                         }
  81                         elsif ($options{is} eq 'rw') {
  82                                 $options{accessor} = $name;
  83                         }
  84                 }
  85                 if (exists $options{isa}) {
  86                     # allow for anon-subtypes here ...
  87                     if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
  88                                 $options{type_constraint} = $options{isa};
  89                         }
  90                         else {
  91                             # otherwise assume it is a constraint
  92                             my $constraint = find_type_constraint($options{isa});
  93                             # if the constraing it not found ....
  94                             unless (defined $constraint) {
  95                                 # assume it is a foreign class, and make
  96                                 # an anon constraint for it
  97                                 $constraint = subtype Object => where { $_->isa($options{isa}) };
  98                             }
  99                 $options{type_constraint} = $constraint;
 100                         }
 101                 }
 102                 $meta->add_attribute($name, %options)
 103         });
 104
 105         # handle method modifers
 106         $meta->alias_method('before' => subname 'Moose::before' => sub {
 107                 my $code = pop @_;
 108                 $meta->add_before_method_modifier($_, $code) for @_;
 109         });
 110         $meta->alias_method('after'  => subname 'Moose::after' => sub {
 111                 my $code = pop @_;
 112                 $meta->add_after_method_modifier($_, $code) for @_;
 113         });
 114         $meta->alias_method('around' => subname 'Moose::around' => sub {
 115                 my $code = pop @_;
 116                 $meta->add_around_method_modifier($_, $code) for @_;
 117         });
 118
 119         $meta->alias_method('super' => subname 'Moose::super' => sub {});
 120         $meta->alias_method('override' => subname 'Moose::override' => sub {
 121             my ($name, $method) = @_;
 122             my $super = $meta->find_next_method_by_name($name);
 123             (defined $super)
 124                 || confess "You cannot override '$name' because it has no super method";
 125             $meta->add_method($name => sub {
 126                 my @args = @_;
 127             no strict   'refs';
 128             no warnings 'redefine';
 129             local *{$meta->name . '::super'} = sub { $super->(@args) };
 130                 return $method->(@args);
 131             });
 132         });
 133
 134         $meta->alias_method('inner' => subname 'Moose::inner' => sub {});
 135         $meta->alias_method('augment' => subname 'Moose::augment' => sub {
 136             my ($name, $method) = @_;
 137             my $super = $meta->find_next_method_by_name($name);
 138             (defined $super)
 139                 || confess "You cannot augment '$name' because it has no super method";
 140             $meta->add_method($name => sub {
 141                 my @args = @_;
 142             no strict   'refs';
 143             no warnings 'redefine';
 144             local *{$super->package_name . '::inner'} = sub { $method->(@args) };
 145                 return $super->(@args);
 146             });
 147         });
 148
 149         # make sure they inherit from Moose::Object
 150         $meta->superclasses('Moose::Object')
 151        unless $meta->superclasses();
 152
 153         # we recommend using these things
 154         # so export them for them
 155         $meta->alias_method('confess' => \&Carp::confess);
 156         $meta->alias_method('blessed' => \&Scalar::Util::blessed);
 157 }
 158
 159 sub _is_class_already_loaded {
 160         my $name = shift;
 161         no strict 'refs';
 162         return 1 if defined ${"${name}::VERSION"} || defined @{"${name}::ISA"};
 163         foreach (keys %{"${name}::"}) {
 164                 next if substr($_, -2, 2) eq '::';
 165                 return 1 if defined &{"${name}::$_"};
 166         }
 167     return 0;
 168 }
 169
 170 1;
 171
 172 __END__
 173
 174 =pod
 175
 176 =head1 NAME
 177
 178 Moose - Moose, it's the new Camel
 179
 180 =head1 SYNOPSIS
 181
 182   package Point;
 183   use Moose;
 184
 185   has 'x' => (isa => 'Int', is => 'rw');
 186   has 'y' => (isa => 'Int', is => 'rw');
 187
 188   sub clear {
 189       my $self = shift;
 190       $self->x(0);
 191       $self->y(0);
 192   }
 193
 194   package Point3D;
 195   use Moose;
 196
 197   extends 'Point';
 198
 199   has 'z' => (isa => 'Int');
 200
 201   after 'clear' => sub {
 202       my $self = shift;
 203       $self->{z} = 0;
 204   };
 205
 206 =head1 CAVEAT
 207
 208 This is a B<very> early release of this module, it still needs
 209 some fine tuning and B<lots> more documentation. I am adopting
 210 the I<release early and release often> approach with this module,
 211 so keep an eye on your favorite CPAN mirror!
 212
 213 =head1 DESCRIPTION
 214
 215 Moose is an extension of the Perl 5 object system.
 216
 217 =head2 Another object system!?!?
 218
 219 Yes, I know there has been an explosion recently of new ways to
 220 build object's in Perl 5, most of them based on inside-out objects,
 221 and other such things. Moose is different because it is not a new
 222 object system for Perl 5, but instead an extension of the existing
 223 object system.
 224
 225 Moose is built on top of L<Class::MOP>, which is a metaclass system
 226 for Perl 5. This means that Moose not only makes building normal
 227 Perl 5 objects better, but it also provides the power of metaclass
 228 programming.
 229
 230 =head2 What does Moose stand for??
 231
 232 Moose doesn't stand for one thing in particular, however, if you
 233 want, here are a few of my favorites, feel free to contribute
 234 more :)
 235
 236 =over 4
 237
 238 =item Make Other Object Systems Envious
 239
 240 =item Makes Object Orientation So Easy
 241
 242 =item Makes Object Orientation Spiffy- Er  (sorry ingy)
 243
 244 =item Most Other Object Systems Emasculate
 245
 246 =item My Overcraft Overfilled (with) Some Eels
 247
 248 =item Moose Often Ovulate Sorta Early
 249
 250 =item Many Overloaded Object Systems Exists
 251
 252 =item Moose Offers Often Super Extensions
 253
 254 =back
 255
 256 =head1 BUILDING CLASSES WITH MOOSE
 257
 258 Moose makes every attempt to provide as much convience during class
 259 construction/definition, but still stay out of your way if you want
 260 it to. Here are some of the features Moose provides:
 261
 262 Unless specified with C<extends>, any class which uses Moose will
 263 inherit from L<Moose::Object>.
 264
 265 Moose will also manage all attributes (including inherited ones) that
 266 are defined with C<has>. And assuming that you call C<new> which is
 267 inherited from L<Moose::Object>, then this includes properly initializing
 268 all instance slots, setting defaults where approprtiate and performing any
 269 type constraint checking or coercion.
 270
 271 =head1 EXPORTED FUNCTIONS
 272
 273 Moose will export a number of functions into the class's namespace, which
 274 can then be used to set up the class. These functions all work directly
 275 on the current class.
 276
 277 =over 4
 278
 279 =item B<meta>
 280
 281 This is a method which provides access to the current class's metaclass.
 282
 283 =item B<extends (@superclasses)>
 284
 285 This function will set the superclass(es) for the current class.
 286
 287 This approach is recommended instead of C<use base>, because C<use base>
 288 actually C<push>es onto the class's C<@ISA>, whereas C<extends> will
 289 replace it. This is important to ensure that classes which do not have
 290 superclasses properly inherit from L<Moose::Object>.
 291
 292 =item B<has ($name, %options)>
 293
 294 This will install an attribute of a given C<$name> into the current class.
 295 The list of C<%options> are the same as those provided by both
 296 L<Class::MOP::Attribute> and L<Moose::Meta::Attribute>, in addition to a
 297 few convience ones provided by Moose which are listed below:
 298
 299 =over 4
 300
 301 =item I<is =E<gt> 'rw'|'ro'>
 302
 303 The I<is> option accepts either I<rw> (for read/write) or I<ro> (for read
 304 only). These will create either a read/write accessor or a read-only
 305 accessor respectively, using the same name as the C<$name> of the attribute.
 306
 307 If you need more control over how your accessors are named, you can use the
 308 I<reader>, I<writer> and I<accessor> options inherited from L<Moose::Meta::Attribute>.
 309
 310 =item I<isa =E<gt> $type_name>
 311
 312 The I<isa> option uses Moose's type constraint facilities to set up runtime
 313 type checking for this attribute. Moose will perform the checks during class
 314 construction, and within any accessors. The C<$type_name> argument must be a
 315 string. The string can be either a class name, or a type defined using
 316 Moose's type defintion features.
 317
 318 =back
 319
 320 =item B<before $name|@names =E<gt> sub { ... }>
 321
 322 =item B<after $name|@names =E<gt> sub { ... }>
 323
 324 =item B<around $name|@names =E<gt> sub { ... }>
 325
 326 This three items are syntactic sugar for the before, after and around method
 327 modifier features that L<Class::MOP> provides. More information on these can
 328 be found in the L<Class::MOP> documentation for now.
 329
 330 =item B<confess>
 331
 332 This is the C<Carp::confess> function, and exported here beause I use it
 333 all the time. This feature may change in the future, so you have been warned.
 334
 335 =item B<blessed>
 336
 337 This is the C<Scalar::Uti::blessed> function, it is exported here beause I
 338 use it all the time. It is highly recommended that this is used instead of
 339 C<ref> anywhere you need to test for an object's class name.
 340
 341 =back
 342
 343 =head1 ACKNOWLEDGEMENTS
 344
 345 =over 4
 346
 347 =item I blame Sam Vilain for introducing me to the insanity that is meta-models.
 348
 349 =item I blame Audrey Tang for then encouraging my meta-model habit in #perl6.
 350
 351 =item Without Yuval "nothingmuch" Kogman this module would not be possible,
 352 and it certainly wouldn't have this name ;P
 353
 354 =item The basis of the TypeContraints module was Rob Kinyon's idea
 355 originally, I just ran with it.
 356
 357 =item Thanks to mst & chansen and the whole #moose poose for all the
 358 ideas/feature-requests/encouragement
 359
 360 =back
 361
 362 =head1 SEE ALSO
 363
 364 =over 4
 365
 366 =item L<Class::MOP> documentation
 367
 368 =item The #moose channel on irc.perl.org
 369
 370 =item L<http://forum2.org/moose/>
 371
 372 =back
 373
 374 =head1 BUGS
 375
 376 All complex software has bugs lurking in it, and this module is no
 377 exception. If you find a bug please either email me, or add the bug
 378 to cpan-RT.
 379
 380 =head1 AUTHOR
 381
 382 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 383
 384 =head1 COPYRIGHT AND LICENSE
 385
 386 Copyright 2006 by Infinity Interactive, Inc.
 387
 388 L<http://www.iinteractive.com>
 389
 390 This library is free software; you can redistribute it and/or modify
 391 it under the same terms as Perl itself.
 392
 393 =cut