X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FModule.pm;h=d43bfbd68b84b56f1ae022fb8c127d807ee3bb87;hb=f3ddcd1a0bcb963fc368a7f7fcbd1cf76c515ed0;hp=697a39153b4c3154dcf558da6e4e4fb01fd7bcae;hpb=58d75218075c1c4d117151122e54eced58f233c1;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm index 697a391..d43bfbd 100644 --- a/lib/Class/MOP/Module.pm +++ b/lib/Class/MOP/Module.pm @@ -4,22 +4,52 @@ package Class::MOP::Module; use strict; use warnings; +use Carp 'confess'; use Scalar::Util 'blessed'; -our $VERSION = '0.01'; +our $VERSION = '0.80'; +$VERSION = eval $VERSION; +our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Package'; -# introspection +sub version { + my $self = shift; + ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'VERSION' })}; +} -sub meta { - require Class::MOP::Class; - Class::MOP::Class->initialize(blessed($_[0]) || $_[0]); +sub authority { + my $self = shift; + ${$self->get_package_symbol({ sigil => '$', type => 'SCALAR', name => 'AUTHORITY' })}; } -sub version { +sub identifier { my $self = shift; - ${$self->get_package_symbol('$VERSION')}; + join '-' => ( + $self->name, + ($self->version || ()), + ($self->authority || ()), + ); +} + +sub create { + my ( $class, %options ) = @_; + + my $package_name = $options{package}; + + (defined $package_name && $package_name) + || confess "You must pass a package name"; + + my $code = "package $package_name;"; + $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';" + if exists $options{version}; + $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';" + if exists $options{authority}; + + eval $code; + confess "creation of $package_name failed : $@" if $@; + + return; # XXX: should this return some kind of meta object? ~sartak } 1; @@ -32,31 +62,51 @@ __END__ Class::MOP::Module - Module Meta Object -=head1 SYNOPSIS - =head1 DESCRIPTION +A module is essentially a L with metadata, in our +case the version and authority. + +=head1 INHERITANCE + +B is a subclass of L. + =head1 METHODS =over 4 -=item B +=item B<< $metamodule->version >> + +This is a read-only attribute which returns the C<$VERSION> of the +package, if one exists. + +=item B<< $metamodule->authority >> + +This is a read-only attribute which returns the C<$AUTHORITY> of the +package, if one exists. + +=item B<< $metamodule->identifier >> + +This constructs a string which combines the name, version and +authority. + +=item B<< Class::MOP::Module->meta >> -=item B +This will return a L instance for this class. =back -=head1 AUTHOR +=head1 AUTHORS Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut