lib/Moose.pm

   1
   2 use lib '/Users/stevan/Projects/CPAN/Class-MOP/Class-MOP/lib';
   3
   4 package Moose;
   5
   6 use strict;
   7 use warnings;
   8
   9 our $VERSION = '0.02';
  10
  11 use Scalar::Util 'blessed', 'reftype';
  12 use Carp         'confess';
  13 use Sub::Name    'subname';
  14
  15 use UNIVERSAL::require;
  16
  17 use Class::MOP;
  18
  19 use Moose::Meta::Class;
  20 use Moose::Meta::Attribute;
  21
  22 use Moose::Object;
  23 use Moose::Util::TypeConstraints ':no_export';
  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     Moose::Util::TypeConstraints::subtype($pkg
  36         => Moose::Util::TypeConstraints::as Object
  37         => Moose::Util::TypeConstraints::where { $_->isa($pkg) }
  38         );
  39
  40         my $meta;
  41         if ($pkg->can('meta')) {
  42                 $meta = $pkg->meta();
  43                 (blessed($meta) && $meta->isa('Class::MOP::Class'))
  44                         || confess "Whoops, not møøsey enough";
  45         }
  46         else {
  47                 $meta = Moose::Meta::Class->initialize($pkg => (
  48                         ':attribute_metaclass' => 'Moose::Meta::Attribute'
  49                 ));
  50                 $meta->add_method('meta' => sub {
  51                         # re-initialize so it inherits properly
  52                         Moose::Meta::Class->initialize($pkg => (
  53                                 ':attribute_metaclass' => 'Moose::Meta::Attribute'
  54                         ));
  55                 })
  56         }
  57
  58         # NOTE:
  59         # &alias_method will install the method, but it
  60         # will not name it with
  61
  62         # handle superclasses
  63         $meta->alias_method('extends' => subname 'Moose::extends' => sub {
  64             $_->require for @_;
  65             $meta->superclasses(@_)
  66         });
  67
  68         # handle attributes
  69         $meta->alias_method('has' => subname 'Moose::has' => sub {
  70                 my ($name, %options) = @_;
  71                 if (exists $options{is}) {
  72                         if ($options{is} eq 'ro') {
  73                                 $options{reader} = $name;
  74                         }
  75                         elsif ($options{is} eq 'rw') {
  76                                 $options{accessor} = $name;
  77                         }
  78                 }
  79                 if (exists $options{isa}) {
  80                     # allow for anon-subtypes here ...
  81                     if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
  82                                 $options{type_constraint} = $options{isa};
  83                         }
  84                         else {
  85                             # otherwise assume it is a constraint
  86                             my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
  87                             # if the constraing it not found ....
  88                             unless (defined $constraint) {
  89                                 # assume it is a foreign class, and make
  90                                 # an anon constraint for it
  91                                 $constraint = Moose::Util::TypeConstraints::subtype(
  92                                     Object => Moose::Util::TypeConstraints::where { $_->isa($constraint) }
  93                         );
  94                             }
  95                 $options{type_constraint} = $constraint;
  96                         }
  97                 }
  98                 if (exists $options{coerce} && $options{coerce} && $options{isa}) {
  99                     my $coercion = Moose::Util::TypeConstraints::find_type_coercion($options{isa});
 100                     (defined $coercion)
 101                         || confess "Cannot find coercion for type " . $options{isa};
 102                     $options{coerce} = $coercion;
 103                 }
 104                 $meta->add_attribute($name, %options)
 105         });
 106
 107         # handle method modifers
 108         $meta->alias_method('before' => subname 'Moose::before' => sub {
 109                 my $code = pop @_;
 110                 $meta->add_before_method_modifier($_, $code) for @_;
 111         });
 112         $meta->alias_method('after'  => subname 'Moose::after' => sub {
 113                 my $code = pop @_;
 114                 $meta->add_after_method_modifier($_, $code) for @_;
 115         });
 116         $meta->alias_method('around' => subname 'Moose::around' => sub {
 117                 my $code = pop @_;
 118                 $meta->add_around_method_modifier($_, $code) for @_;
 119         });
 120
 121         # make sure they inherit from Moose::Object
 122         $meta->superclasses('Moose::Object')
 123        unless $meta->superclasses();
 124
 125         # we recommend using these things
 126         # so export them for them
 127         $meta->alias_method('confess' => \&Carp::confess);
 128         $meta->alias_method('blessed' => \&Scalar::Util::blessed);
 129 }
 130
 131 1;
 132
 133 __END__
 134
 135 =pod
 136
 137 =head1 NAME
 138
 139 Moose - Moose, it's the new Camel
 140
 141 =head1 SYNOPSIS
 142
 143   package Point;
 144   use Moose;
 145
 146   has 'x' => (isa => 'Int', is => 'rw');
 147   has 'y' => (isa => 'Int', is => 'rw');
 148
 149   sub clear {
 150       my $self = shift;
 151       $self->x(0);
 152       $self->y(0);
 153   }
 154
 155   package Point3D;
 156   use Moose;
 157
 158   extends 'Point';
 159
 160   has 'z' => (isa => 'Int');
 161
 162   after 'clear' => sub {
 163       my $self = shift;
 164       $self->{z} = 0;
 165   };
 166
 167 =head1 CAVEAT
 168
 169 This is a B<very> early release of this module, it still needs
 170 some fine tuning and B<lots> more documentation. I am adopting
 171 the I<release early and release often> approach with this module,
 172 so keep an eye on your favorite CPAN mirror!
 173
 174 =head1 DESCRIPTION
 175
 176 Moose is an extension of the Perl 5 object system.
 177
 178 =head2 Another object system!?!?
 179
 180 Yes, I know there has been an explosion recently of new ways to
 181 build object's in Perl 5, most of them based on inside-out objects,
 182 and other such things. Moose is different because it is not a new
 183 object system for Perl 5, but instead an extension of the existing
 184 object system.
 185
 186 Moose is built on top of L<Class::MOP>, which is a metaclass system
 187 for Perl 5. This means that Moose not only makes building normal
 188 Perl 5 objects better, but it also provides the power of metaclass
 189 programming.
 190
 191 =head2 What does Moose stand for??
 192
 193 Moose doesn't stand for one thing in particular, however, if you
 194 want, here are a few of my favorites, feel free to contribute
 195 more :)
 196
 197 =over 4
 198
 199 =item Make Other Object Systems Envious
 200
 201 =item Makes Object Orientation So Easy
 202
 203 =item Makes Object Orientation Spiffy- Er  (sorry ingy)
 204
 205 =item Most Other Object Systems Emasculate
 206
 207 =item My Overcraft Overfilled (with) Some Eels
 208
 209 =item Moose Often Ovulate Sorta Early
 210
 211 =item Many Overloaded Object Systems Exists
 212
 213 =item Moose Offers Often Super Extensions
 214
 215 =back
 216
 217 =head1 ACKNOWLEDGEMENTS
 218
 219 =over 4
 220
 221 =item I blame Sam Vilain for giving me my first hit of meta-model crack.
 222
 223 =item I blame Audrey Tang for encouraging that meta-crack habit in #perl6.
 224
 225 =item Without the love and encouragement of Yuval "nothingmuch" Kogman,
 226 this module would not be possible (and it wouldn't have a name).
 227
 228 =item The basis of the TypeContraints module was Rob Kinyon's idea
 229 originally, I just ran with it.
 230
 231 =back
 232
 233 =head1 SEE ALSO
 234
 235 =over 4
 236
 237 =item L<http://forum2.org/moose/>
 238
 239 =back
 240
 241 =head1 BUGS
 242
 243 All complex software has bugs lurking in it, and this module is no
 244 exception. If you find a bug please either email me, or add the bug
 245 to cpan-RT.
 246
 247 =head1 AUTHOR
 248
 249 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 250
 251 =head1 COPYRIGHT AND LICENSE
 252
 253 Copyright 2006 by Infinity Interactive, Inc.
 254
 255 L<http://www.iinteractive.com>
 256
 257 This library is free software; you can redistribute it and/or modify
 258 it under the same terms as Perl itself.
 259
 260 =cut