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