Commit | Line | Data |
677eb158 |
1 | |
2 | package metaclass; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Carp 'confess'; |
8 | |
9 | our $VERSION = '0.01'; |
10 | |
11 | use Class::MOP; |
12 | |
13 | sub import { |
14 | shift; |
15 | my $metaclass = shift; |
16 | my %options = @_; |
17 | my $package = caller(); |
18 | |
19 | ($metaclass->isa('Class::MOP::Class')) |
20 | || confess 'The metaclass must be derived from Class::MOP::Class'; |
21 | |
22 | # create a meta object so we can install &meta |
23 | my $meta = $metaclass->initialize($package => %options); |
24 | $meta->add_method('meta' => sub { |
25 | # we must re-initialize so that it |
26 | # works as expected in subclasses, |
27 | # since metaclass instances are |
28 | # singletons, this is not really a |
29 | # big deal anyway. |
30 | $metaclass->initialize($_[0] => %options) |
31 | }); |
32 | } |
33 | |
34 | 1; |
35 | |
36 | __END__ |
37 | |
38 | =pod |
39 | |
40 | =head1 NAME |
41 | |
42 | metaclass - a pragma for installing using Class::MOP metaclasses |
43 | |
44 | =head1 SYNOPSIS |
45 | |
46 | use metaclass 'MyMetaClass'; |
47 | |
48 | use metaclass 'MyMetaClass' => ( |
49 | ':attribute_metaclass' => 'MyAttributeMetaClass', |
50 | ':method_metaclass' => 'MyMethodMetaClass', |
51 | ); |
52 | |
53 | =head1 DESCRIPTION |
54 | |
55 | =head1 AUTHOR |
56 | |
57 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
58 | |
59 | =head1 COPYRIGHT AND LICENSE |
60 | |
61 | Copyright 2006 by Infinity Interactive, Inc. |
62 | |
63 | L<http://www.iinteractive.com> |
64 | |
65 | This library is free software; you can redistribute it and/or modify |
66 | it under the same terms as Perl itself. |
67 | |
68 | =cut |