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