lib/Moose.pm

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