From: Stevan Little Date: Thu, 17 Aug 2006 14:43:54 +0000 (+0000) Subject: lots of documentation changes, some refactoring too X-Git-Tag: 0_33~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b9d9fc0b01c940ad89c092eaf01e67c23b6036d5;p=gitmo%2FClass-MOP.git lots of documentation changes, some refactoring too --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index df79f29..7ae48cc 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -507,10 +507,19 @@ you are brave and willing to risk it, go for it. =item B +This will return an hash of all the metaclass instances that have +been cached by B keyed by the package name. + =item B +This will return an array of all the metaclass instances that have +been cached by B. + =item B +This will return an array of all the metaclass names that have +been cached by B. + =item B =item B @@ -606,21 +615,25 @@ L report on this module's test suite. ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ - Class/MOP.pm 100.0 100.0 100.0 100.0 n/a 19.8 100.0 - Class/MOP/Attribute.pm 100.0 100.0 91.7 61.2 100.0 14.3 87.9 - Class/MOP/Class.pm 97.6 91.3 77.3 98.4 100.0 56.4 93.2 - Class/MOP/Instance.pm 91.1 75.0 33.3 91.7 100.0 6.8 90.7 - Class/MOP/Method.pm 97.6 60.0 52.9 76.9 100.0 1.6 82.6 - metaclass.pm 100.0 100.0 83.3 100.0 n/a 1.0 97.7 + Class/MOP.pm 78.0 87.5 55.6 71.4 100.0 12.4 76.8 + Class/MOP/Attribute.pm 83.4 75.6 86.7 94.4 100.0 8.9 85.2 + Class/MOP/Class.pm 96.9 75.8 43.2 98.0 100.0 55.3 83.6 + Class/MOP/Class/Immutable.pm 88.5 53.8 n/a 95.8 100.0 1.1 84.7 + Class/MOP/Instance.pm 87.9 75.0 33.3 89.7 100.0 10.1 89.1 + Class/MOP/Method.pm 97.6 60.0 57.9 76.9 100.0 1.5 82.8 + Class/MOP/Module.pm 87.5 n/a 11.1 83.3 100.0 0.3 66.7 + Class/MOP/Object.pm 100.0 n/a 33.3 100.0 100.0 0.1 89.5 + Class/MOP/Package.pm 95.1 69.0 33.3 100.0 100.0 9.9 85.5 + metaclass.pm 100.0 100.0 83.3 100.0 n/a 0.5 97.7 ---------------------------- ------ ------ ------ ------ ------ ------ ------ - Total 97.5 88.5 75.5 82.8 100.0 100.0 91.2 + Total 91.5 72.1 48.8 90.7 100.0 100.0 84.2 ---------------------------- ------ ------ ------ ------ ------ ------ ------ =head1 ACKNOWLEDGEMENTS =over 4 -=item Rob Kinyon Erob@iinteractive.comE +=item Rob Kinyon Thanks to Rob for actually getting the development of this module kick-started. diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 17f36f3..aca8a50 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -20,15 +20,6 @@ use Class::MOP::Instance; sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) } -# Class globals ... - -# NOTE: -# we need a sufficiently annoying prefix -# this should suffice for now, this is -# used in a couple of places below, so -# need to put it up here for now. -my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::'; - # Creation sub initialize { @@ -109,11 +100,12 @@ sub construct_class_instance { $meta->check_metaclass_compatability(); Class::MOP::store_metaclass_by_name($package_name, $meta); + # NOTE: # we need to weaken any anon classes # so that they can call DESTROY properly - Class::MOP::weaken_metaclass($package_name) - if $package_name =~ /^$ANON_CLASS_PREFIX/; + Class::MOP::weaken_metaclass($package_name) if $meta->is_anon_class; + $meta; } @@ -160,29 +152,42 @@ sub check_metaclass_compatability { # use case where it is not, write a test and # I will change it. my $ANON_CLASS_SERIAL = 0; + + # NOTE: + # we need a sufficiently annoying prefix + # this should suffice for now, this is + # used in a couple of places below, so + # need to put it up here for now. + my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::'; + + sub is_anon_class { + my $self = shift; + $self->name =~ /^$ANON_CLASS_PREFIX/ ? 1 : 0; + } sub create_anon_class { my ($class, %options) = @_; my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL; return $class->create($package_name, '0.00', %options); - } -} + } -# NOTE: -# this will only get called for -# anon-classes, all other calls -# are assumed to occur during -# global destruction and so don't -# really need to be handled explicitly -sub DESTROY { - my $self = shift; - return unless $self->name =~ /^$ANON_CLASS_PREFIX/; - my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/); - no strict 'refs'; - foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) { - delete ${$ANON_CLASS_PREFIX . $serial_id}{$key}; + # NOTE: + # this will only get called for + # anon-classes, all other calls + # are assumed to occur during + # global destruction and so don't + # really need to be handled explicitly + sub DESTROY { + my $self = shift; + return unless $self->name =~ /^$ANON_CLASS_PREFIX/; + my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/); + no strict 'refs'; + foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) { + delete ${$ANON_CLASS_PREFIX . $serial_id}{$key}; + } + delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'}; } - delete ${'main::' . $ANON_CLASS_PREFIX}{$serial_id . '::'}; + } # creating classes with MOP ... @@ -708,21 +713,6 @@ bootstrap this module by installing a number of attribute meta-objects into it's metaclass. This will allow this class to reap all the benifits of the MOP when subclassing it. -=item B - -This will return an hash of all the metaclass instances that have -been cached by B keyed by the package name. - -=item B - -This will return an array of all the metaclass instances that have -been cached by B. - -=item B - -This will return an array of all the metaclass names that have -been cached by B. - =back =head2 Class construction @@ -860,17 +850,15 @@ is too I to be part of the MOP. =head2 Informational -=over 4 +These are a few predicate methods for asking information about the class. -=item B +=over 4 -This is a read-only attribute which returns the package name for the -given B instance. +=item B -=item B +=item B -This is a read-only attribute which returns the C<$VERSION> of the -package for the given B instance. +=item B =back @@ -1180,47 +1168,10 @@ It will return undef if nothing is found. =back -=head2 Package Variables - -Since Perl's classes are built atop the Perl package system, it is -fairly common to use package scoped variables for things like static -class variables. The following methods are convience methods for -the creation and inspection of package scoped variables. - -=over 4 - -=item B - -Given a C<$variable_name>, which must contain a leading sigil, this -method will create that variable within the package which houses the -class. It also takes an optional C<$initial_value>, which must be a -reference of the same type as the sigil of the C<$variable_name> -implies. - -=item B - -This will return a reference to the package variable in -C<$variable_name>. - -=item B - -Returns true (C<1>) if there is a package variable defined for -C<$variable_name>, and false (C<0>) otherwise. - -=item B - -This will attempt to remove the package variable at C<$variable_name>. - -=back - =head2 Class closing =over 4 -=item B - -=item B - =item B =back diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm index c373bd8..1611362 100644 --- a/lib/Class/MOP/Module.pm +++ b/lib/Class/MOP/Module.pm @@ -59,10 +59,18 @@ Class::MOP::Module - Module Meta Object =item B +This is a read-only attribute which returns the C<$VERSION> of the +package for the given instance. + =item B +This is a read-only attribute which returns the C<$AUTHORITY> of the +package for the given instance. + =item B +This constructs a string of the name, version and authrity. + =back =head1 AUTHORS diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 18e2c10..d1dec75 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -194,24 +194,51 @@ Class::MOP::Package - Package Meta Object =item B -=item B +=item B =item B +This is a read-only attribute which returns the package name for the +given instance. + =item B -=item B +This returns a HASH reference to the symbol table. The keys of the +HASH are the symbol names, and the values are typeglob references. + +=item B + +Given a C<$variable_name>, which must contain a leading sigil, this +method will create that variable within the package which houses the +class. It also takes an optional C<$initial_value>, which must be a +reference of the same type as the sigil of the C<$variable_name> +implies. + +=item B -=item B +This will return a reference to the package variable in +C<$variable_name>. -=item B +=item B -=item B +Returns true (C<1>) if there is a package variable defined for +C<$variable_name>, and false (C<0>) otherwise. -=item B +=item B + +This will attempt to remove the package variable at C<$variable_name>. + +=item B + +This will attempt to remove the entire typeglob associated with +C<$glob_name> from the package. =item B +This will list all the glob names associated with the current package. +By inspecting the globs returned you can discern all the variables in +the package. + =back =head1 AUTHORS diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 24572a5..80db516 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 183; +use Test::More tests => 185; use Test::Exception; BEGIN { @@ -50,7 +50,9 @@ my @class_mop_module_methods = qw( my @class_mop_class_methods = qw( meta - initialize reinitialize create create_anon_class + initialize reinitialize create + + create_anon_class is_anon_class instance_metaclass get_meta_instance new_object clone_object