Implement an idea of reducing inline constructors in basic metaclasses
[gitmo/Class-MOP.git] / lib / Class / MOP / Module.pm
1
2 package Class::MOP::Module;
3
4 use strict;
5 use warnings;
6
7 use Carp         'confess';
8 use Scalar::Util 'blessed';
9
10 our $VERSION   = '0.89';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
13
14 use base 'Class::MOP::Package';
15
16 sub _new{
17     my $class = shift;
18     return Class::MOP::Class->initialize($class)->new_object(@_)
19       if $class ne __PACKAGE__;
20
21     my $params = @_ == 1 ? $_[0] : {@_};
22     return bless {
23         # from Class::MOP::Package
24         package   => $params->{package},
25         namespace => \undef,
26
27         # attributes
28         version   => \undef,
29         authority => \undef
30     } => $class;
31 }
32
33 sub version {  
34     my $self = shift;
35     ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'VERSION' })};
36 }
37
38 sub authority {  
39     my $self = shift;
40     ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'AUTHORITY' })};
41 }
42
43 sub identifier {
44     my $self = shift;
45     join '-' => (
46         $self->name,
47         ($self->version   || ()),
48         ($self->authority || ()),
49     );
50 }
51
52 sub create {
53     confess "The Class::MOP::Module->create method has been made a private object method.\n";
54 }
55
56 sub _instantiate_module {
57     my $self      = shift;
58     my $version   = shift;
59     my $authority = shift;
60
61     my $package_name = $self->name;
62
63     my $code = "package $package_name;";
64
65     $code .= "\$$package_name\:\:VERSION = '" . $version . "';"
66         if defined $version;
67     $code .= "\$$package_name\:\:AUTHORITY = '" . $authority . "';"
68         if defined $authority;
69
70     my $e = do {
71         local $@;
72         local $SIG{__DIE__};
73         eval $code;
74         $@;
75     };
76     confess "creation of $package_name failed : $e" if $e;
77 }
78
79 1;
80
81 __END__
82
83 =pod
84
85 =head1 NAME 
86
87 Class::MOP::Module - Module Meta Object
88
89 =head1 DESCRIPTION
90
91 A module is essentially a L<Class::MOP::Package> with metadata, in our
92 case the version and authority.
93
94 =head1 INHERITANCE
95
96 B<Class::MOP::Module> is a subclass of L<Class::MOP::Package>.
97
98 =head1 METHODS
99
100 =over 4
101
102 =item B<< $metamodule->version >>
103
104 This is a read-only attribute which returns the C<$VERSION> of the
105 package, if one exists.
106
107 =item B<< $metamodule->authority >>
108
109 This is a read-only attribute which returns the C<$AUTHORITY> of the
110 package, if one exists.
111
112 =item B<< $metamodule->identifier >>
113
114 This constructs a string which combines the name, version and
115 authority.
116
117 =item B<< Class::MOP::Module->meta >>
118
119 This will return a L<Class::MOP::Class> instance for this class.
120
121 =back
122
123 =head1 AUTHORS
124
125 Stevan Little E<lt>stevan@iinteractive.comE<gt>
126
127 =head1 COPYRIGHT AND LICENSE
128
129 Copyright 2006-2009 by Infinity Interactive, Inc.
130
131 L<http://www.iinteractive.com>
132
133 This library is free software; you can redistribute it and/or modify
134 it under the same terms as Perl itself.
135
136 =cut