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