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