Commit | Line | Data |
fcd84ca9 |
1 | |
c0e30cf5 |
2 | use lib '/Users/stevan/CPAN/Class-MOP/Class-MOP/lib'; |
3 | |
fcd84ca9 |
4 | package Moose; |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | our $VERSION = '0.01'; |
10 | |
cc65ead0 |
11 | use Scalar::Util 'blessed', 'reftype'; |
fcd84ca9 |
12 | use Carp 'confess'; |
bc1e29b5 |
13 | use Sub::Name 'subname'; |
fcd84ca9 |
14 | |
c0e30cf5 |
15 | use Moose::Meta::Class; |
16 | use Moose::Meta::Attribute; |
17 | |
fcd84ca9 |
18 | use Moose::Object; |
484ff7bf |
19 | use Moose::Util::TypeConstraints ':no_export'; |
a15dff8d |
20 | |
fcd84ca9 |
21 | sub import { |
22 | shift; |
23 | my $pkg = caller(); |
24 | |
a15dff8d |
25 | Moose::Util::TypeConstraints->import($pkg); |
26 | |
fcd84ca9 |
27 | my $meta; |
28 | if ($pkg->can('meta')) { |
29 | $meta = $pkg->meta(); |
30 | (blessed($meta) && $meta->isa('Class::MOP::Class')) |
31 | || confess "Whoops, not møøsey enough"; |
32 | } |
33 | else { |
c0e30cf5 |
34 | $meta = Moose::Meta::Class->initialize($pkg => ( |
35 | ':attribute_metaclass' => 'Moose::Meta::Attribute' |
bc1e29b5 |
36 | )); |
fcd84ca9 |
37 | } |
ad1ac1bd |
38 | |
bc1e29b5 |
39 | # NOTE: |
40 | # &alias_method will install the method, but it |
41 | # will not name it with |
42 | |
43 | # handle superclasses |
44 | $meta->alias_method('extends' => subname 'Moose::extends' => sub { $meta->superclasses(@_) }); |
45 | |
c0e30cf5 |
46 | # handle attributes |
29db16a9 |
47 | $meta->alias_method('has' => subname 'Moose::has' => sub { |
48 | my ($name, %options) = @_; |
49 | if (exists $options{is}) { |
cc65ead0 |
50 | if ($options{is} eq 'ro') { |
51 | $options{reader} = $name; |
52 | } |
53 | elsif ($options{is} eq 'rw') { |
54 | $options{accessor} = $name; |
55 | } |
29db16a9 |
56 | } |
cc65ead0 |
57 | if (exists $options{isa}) { |
58 | if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') { |
59 | $options{type_constraint} = $options{isa}; |
60 | } |
61 | else { |
62 | $options{type_constraint} = Moose::Util::TypeConstraints::subtype( |
63 | Object => Moose::Util::TypeConstraints::where { $_->isa($options{isa}) } |
64 | ); |
65 | } |
29db16a9 |
66 | } |
67 | $meta->add_attribute($name, %options) |
68 | }); |
3c7278fb |
69 | |
c0e30cf5 |
70 | # handle method modifers |
bc1e29b5 |
71 | $meta->alias_method('before' => subname 'Moose::before' => sub { |
e5ebe4ce |
72 | my $code = pop @_; |
73 | $meta->add_before_method_modifier($_, $code) for @_; |
74 | }); |
bc1e29b5 |
75 | $meta->alias_method('after' => subname 'Moose::after' => sub { |
e5ebe4ce |
76 | my $code = pop @_; |
77 | $meta->add_after_method_modifier($_, $code) for @_; |
78 | }); |
bc1e29b5 |
79 | $meta->alias_method('around' => subname 'Moose::around' => sub { |
c0e30cf5 |
80 | my $code = pop @_; |
81 | $meta->add_around_method_modifier($_, $code) for @_; |
82 | }); |
e5ebe4ce |
83 | |
c0e30cf5 |
84 | # make sure they inherit from Moose::Object |
fcd84ca9 |
85 | $meta->superclasses('Moose::Object') |
86 | unless $meta->superclasses(); |
ad1ac1bd |
87 | |
c0e30cf5 |
88 | # we recommend using these things |
89 | # so export them for them |
ad1ac1bd |
90 | $meta->alias_method('confess' => \&confess); |
91 | $meta->alias_method('blessed' => \&blessed); |
fcd84ca9 |
92 | } |
93 | |
94 | 1; |
95 | |
96 | __END__ |
97 | |
98 | =pod |
99 | |
100 | =head1 NAME |
101 | |
102 | Moose - |
103 | |
104 | =head1 SYNOPSIS |
09fdc1dc |
105 | |
fcd84ca9 |
106 | =head1 DESCRIPTION |
107 | |
108 | =head1 OTHER NAMES |
109 | |
3c7278fb |
110 | Makes Other Object Systems Envious |
111 | |
3c7278fb |
112 | Makes Object Orientation So Easy |
113 | |
fcd84ca9 |
114 | =head1 BUGS |
115 | |
116 | All complex software has bugs lurking in it, and this module is no |
117 | exception. If you find a bug please either email me, or add the bug |
118 | to cpan-RT. |
119 | |
120 | =head1 CODE COVERAGE |
121 | |
122 | I use L<Devel::Cover> to test the code coverage of my tests, below is the |
123 | L<Devel::Cover> report on this module's test suite. |
124 | |
125 | =head1 ACKNOWLEDGEMENTS |
126 | |
127 | =head1 AUTHOR |
128 | |
129 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
130 | |
131 | =head1 COPYRIGHT AND LICENSE |
132 | |
133 | Copyright 2006 by Infinity Interactive, Inc. |
134 | |
135 | L<http://www.iinteractive.com> |
136 | |
137 | This library is free software; you can redistribute it and/or modify |
138 | it under the same terms as Perl itself. |
139 | |
140 | =cut |