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