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 | |
f0480c45 | 10 | our $VERSION = '0.03'; |
11 | our $AUTHORITY = 'cpan:STEVAN'; | |
677eb158 | 12 | |
13 | use Class::MOP; | |
14 | ||
15 | sub import { | |
16 | shift; | |
1becdfcc | 17 | my $metaclass; |
c23184fc | 18 | if (!defined($_[0]) || $_[0] =~ /^(attribute|method|instance)_metaclass/) { |
1becdfcc | 19 | $metaclass = 'Class::MOP::Class'; |
20 | } | |
21 | else { | |
22 | $metaclass = shift; | |
95514cb4 | 23 | Class::MOP::load_class($metaclass); |
1becdfcc | 24 | ($metaclass->isa('Class::MOP::Class')) |
16e960bd | 25 | || confess "The metaclass ($metaclass) must be derived from Class::MOP::Class"; |
1becdfcc | 26 | } |
d82060fe | 27 | my %options = @_; |
28 | my $package = caller(); | |
95514cb4 | 29 | |
677eb158 | 30 | # create a meta object so we can install &meta |
31 | my $meta = $metaclass->initialize($package => %options); | |
32 | $meta->add_method('meta' => sub { | |
95514cb4 | 33 | # we must re-initialize so that it |
34 | # works as expected in subclasses, | |
35 | # since metaclass instances are | |
36 | # singletons, this is not really a | |
677eb158 | 37 | # big deal anyway. |
22286063 | 38 | $metaclass->initialize((blessed($_[0]) || $_[0]) => %options) |
677eb158 | 39 | }); |
40 | } | |
41 | ||
42 | 1; | |
43 | ||
44 | __END__ | |
45 | ||
46 | =pod | |
47 | ||
48 | =head1 NAME | |
49 | ||
96ceced8 | 50 | metaclass - a pragma for installing and using Class::MOP metaclasses |
677eb158 | 51 | |
52 | =head1 SYNOPSIS | |
53 | ||
550d56db | 54 | package MyClass; |
55 | ||
56 | # use Class::MOP::Class | |
95514cb4 | 57 | use metaclass; |
550d56db | 58 | |
59 | # ... or use a custom metaclass | |
677eb158 | 60 | use metaclass 'MyMetaClass'; |
95514cb4 | 61 | |
62 | # ... or use a custom metaclass | |
550d56db | 63 | # and custom attribute and method |
64 | # metaclasses | |
677eb158 | 65 | use metaclass 'MyMetaClass' => ( |
c23184fc | 66 | 'attribute_metaclass' => 'MyAttributeMetaClass', |
95514cb4 | 67 | 'method_metaclass' => 'MyMethodMetaClass', |
677eb158 | 68 | ); |
69 | ||
1becdfcc | 70 | # ... or just specify custom attribute |
71 | # and method classes, and Class::MOP::Class | |
72 | # is the assumed metaclass | |
73 | use metaclass ( | |
c23184fc | 74 | 'attribute_metaclass' => 'MyAttributeMetaClass', |
95514cb4 | 75 | 'method_metaclass' => 'MyMethodMetaClass', |
1becdfcc | 76 | ); |
77 | ||
677eb158 | 78 | =head1 DESCRIPTION |
79 | ||
95514cb4 | 80 | This is a pragma to make it easier to use a specific metaclass |
81 | and a set of custom attribute and method metaclasses. It also | |
82 | installs a C<meta> method to your class as well. | |
c9e77dbb | 83 | |
1a09d9cc | 84 | =head1 AUTHORS |
677eb158 | 85 | |
86 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |
87 | ||
88 | =head1 COPYRIGHT AND LICENSE | |
89 | ||
2367814a | 90 | Copyright 2006, 2007 by Infinity Interactive, Inc. |
677eb158 | 91 | |
92 | L<http://www.iinteractive.com> | |
93 | ||
94 | This library is free software; you can redistribute it and/or modify | |
95514cb4 | 95 | it under the same terms as Perl itself. |
677eb158 | 96 | |
16e960bd | 97 | =cut |