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