Commit | Line | Data |
c3398f5b |
1 | #!perl |
2 | package Mouse; |
3 | use strict; |
4 | use warnings; |
5 | |
6 | our $VERSION = '0.01'; |
7 | |
8 | use Sub::Exporter; |
9 | use Carp 'confess'; |
10 | use Scalar::Util 'blessed'; |
11 | |
12 | use Mouse::Attribute; |
13 | use Mouse::Class; |
14 | use Mouse::Object; |
15 | |
16 | do { |
17 | my $CALLER; |
18 | |
19 | my %exports = ( |
20 | meta => sub { |
21 | my $meta = Mouse::Class->initialize($CALLER); |
22 | return sub { $meta }; |
23 | }, |
24 | |
25 | extends => sub { |
26 | my $caller = $CALLER; |
27 | return sub { |
28 | $caller->meta->superclasses(@_); |
29 | }; |
30 | }, |
31 | |
32 | has => sub { |
33 | return sub { |
34 | my $package = caller; |
35 | my $names = shift; |
36 | $names = [$names] if !ref($names); |
37 | |
38 | for my $name (@$names) { |
39 | Mouse::Attribute->create($package, $name, @_); |
40 | } |
41 | }; |
42 | }, |
43 | |
44 | confess => sub { |
45 | return \&Carp::confess; |
46 | }, |
47 | |
48 | blessed => sub { |
49 | return \&Scalar::Util::blessed; |
50 | }, |
51 | ); |
52 | |
53 | my $exporter = Sub::Exporter::build_exporter({ |
54 | exports => \%exports, |
55 | groups => { default => [':all'] }, |
56 | }); |
57 | |
58 | sub import { |
59 | $CALLER = caller; |
60 | |
61 | strict->import; |
62 | warnings->import; |
63 | |
64 | no strict 'refs'; |
65 | @{ $CALLER . '::ISA' } = 'Mouse::Object'; |
66 | |
67 | goto $exporter; |
68 | } |
69 | |
70 | sub unimport { |
71 | my $caller = caller; |
72 | |
73 | no strict 'refs'; |
74 | for my $keyword (keys %exports) { |
75 | next if $keyword eq 'meta'; # we don't delete this one |
76 | delete ${ $caller . '::' }{$keyword}; |
77 | } |
78 | } |
79 | }; |
80 | |
81 | sub load_class { |
82 | my $class = shift; |
83 | |
84 | (my $file = "$class.pm") =~ s{::}{/}g; |
85 | |
86 | eval { CORE::require($file) }; |
87 | confess "Could not load class ($class) because : $@" |
88 | if $@ |
89 | && $@ !~ /^Can't locate .*? at /; |
90 | |
91 | return 1; |
92 | } |
93 | |
94 | 1; |
95 | |
96 | __END__ |
97 | |
98 | =head1 NAME |
99 | |
100 | Mouse - miniature Moose near the speed of light |
101 | |
102 | =head1 VERSION |
103 | |
104 | Version 0.01 released ??? |
105 | |
106 | =head1 SYNOPSIS |
107 | |
108 | package Point; |
109 | use Mouse; |
110 | |
111 | has x => ( |
112 | is => 'rw', |
113 | ); |
114 | |
115 | has y => ( |
116 | is => 'rw', |
117 | default => 0, |
118 | predicate => 'has_y', |
119 | clearer => 'clear_y', |
120 | ); |
121 | |
122 | =head1 DESCRIPTION |
123 | |
124 | Moose. |
125 | |
126 | =head1 INTERFACE |
127 | |
128 | =head2 meta -> Mouse::Class |
129 | |
130 | Returns this class' metaclass instance. |
131 | |
132 | =head2 extends superclasses |
133 | |
134 | Sets this class' superclasses. |
135 | |
136 | =head2 has (name|names) => parameters |
137 | |
138 | Adds an attribute (or if passed an arrayref of names, multiple attributes) to |
139 | this class. |
140 | |
141 | =head2 confess error -> BOOM |
142 | |
143 | L<Carp/confess> for your convenience. |
144 | |
145 | =head2 blessed value -> ClassName | undef |
146 | |
147 | L<Scalar::Util/blessed> for your convenience. |
148 | |
149 | =head1 MISC |
150 | |
151 | =head2 import |
152 | |
153 | Importing Mouse will set your class' superclass list to L<Mouse::Object>. |
154 | You may use L</extends> to replace the superclass list. |
155 | |
156 | =head2 unimport |
157 | |
158 | Please unimport Mouse so that if someone calls one of the keywords (such as |
159 | L</extends>) it will break loudly instead breaking subtly. |
160 | |
161 | =head1 FUNCTIONS |
162 | |
163 | =head2 load_class Class::Name |
164 | |
165 | This will load a given Class::Name> (or die if it's not loadable). |
166 | This function can be used in place of tricks like |
167 | C<eval "use $module"> or using C<require>. |
168 | |
169 | =head1 AUTHOR |
170 | |
171 | Shawn M Moore, C<< <sartak at gmail.com> >> |
172 | |
173 | =head1 BUGS |
174 | |
175 | No known bugs. |
176 | |
177 | Please report any bugs through RT: email |
178 | C<bug-mouse at rt.cpan.org>, or browse |
179 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>. |
180 | |
181 | =head1 COPYRIGHT AND LICENSE |
182 | |
183 | Copyright 2008 Shawn M Moore. |
184 | |
185 | This program is free software; you can redistribute it and/or modify it |
186 | under the same terms as Perl itself. |
187 | |
188 | =cut |
189 | |