From: Dave Rolsky Date: Fri, 5 Sep 2008 15:08:35 +0000 (+0000) Subject: pod for everything X-Git-Tag: 0.05~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7a4a3b1efe4db788811154fbecbf6c94ceeee4bf;p=gitmo%2FMooseX-ClassAttribute.git pod for everything --- diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm index 5a8221f..d05b985 100644 --- a/lib/MooseX/ClassAttribute.pm +++ b/lib/MooseX/ClassAttribute.pm @@ -118,6 +118,27 @@ This module should work with most attribute metaclasses and traits, but it's possible that conflicts could occur. This module has been tested to work with C. +=head1 DONATIONS + +If you'd like to thank me for the work I've done on this module, +please consider making a "donation" to me via PayPal. I spend a lot of +free time creating free software, and would appreciate any support +you'd care to offer. + +Please note that B in order +for me to continue working on this particular software. I will +continue to do so, inasmuch as I have in the past, for as long as it +interests me. + +Similarly, a donation made in this way will probably not make me work +on this software much more, unless I get so many donations that I can +consider working on free software full time, which seems unlikely at +best. + +To donate, log into PayPal and send money to autarch@urth.org or use +the button on this page: +L + =head1 AUTHOR Dave Rolsky, C<< >> diff --git a/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm b/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm index 506f736..e952ad2 100644 --- a/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm +++ b/lib/MooseX/ClassAttribute/Meta/Method/Accessor.pm @@ -114,3 +114,30 @@ no Moose; 1; +=pod + +=head1 NAME + +MooseX::ClassAttribute::Meta::Method::Accessor - Accessor method generation for class attributes + +=head1 DESCRIPTION + +This class overrides L to do code +generation properly for class attributes. + +=head1 AUTHOR + +Dave Rolsky, C<< >> + +=head1 BUGS + +See L for details. + +=head1 COPYRIGHT & LICENSE + +Copyright 2007-2008 Dave Rolsky, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm b/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm index 06e97d6..70052cb 100644 --- a/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm +++ b/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm @@ -136,3 +136,40 @@ around 'clear_value' => sub no Moose::Role; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::ClassAttribute::Role::Meta::Attribute - An attribute role for classes with class attributes + +=head1 DESCRIPTION + +This role modifies the behavior of class attributes in various +ways. It really should be a subclass of C, but +if it were then it couldn't be combined with other attribute +metaclasses, like C. + +There are no new public methods implemented by this role. All it does +is change the behavior of a number of existing methods. + +=head1 AUTHOR + +Dave Rolsky, C<< >> + +=head1 BUGS + +See L for details. + +=head1 COPYRIGHT & LICENSE + +Copyright 2007-2008 Dave Rolsky, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + + diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Class.pm b/lib/MooseX/ClassAttribute/Role/Meta/Class.pm index 17c7fec..937e310 100644 --- a/lib/MooseX/ClassAttribute/Role/Meta/Class.pm +++ b/lib/MooseX/ClassAttribute/Role/Meta/Class.pm @@ -148,7 +148,11 @@ sub compute_all_applicable_class_attributes my $self = shift; my %attrs = - map { %{ Class::MOP::Class->initialize($_)->get_class_attribute_map } } + map { my $meta = Class::MOP::Class->initialize($_); + $meta->can('get_class_attribute_map') + ? %{ $meta->get_class_attribute_map() } + : () + } reverse $self->linearized_isa; return values %attrs; @@ -164,7 +168,7 @@ sub find_class_attribute_by_name my $meta = Class::MOP::Class->initialize($class); return $meta->get_class_attribute($name) - if $meta->has_class_attribute($name); + if $meta->can('has_class_attribute') && $meta->has_class_attribute($name); } return; @@ -237,3 +241,114 @@ sub inline_weaken_class_slot_value no Moose::Role; 1; + +__END__ + +=pod + +=head1 NAME + +MooseX::ClassAttribute::Role::Meta::Class - A metaclass role for classes with class attributes + +=head1 SYNOPSIS + + for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() ) + { + print $attr->name(); + } + +=head1 DESCRIPTION + +This role adds awareness of class attributes to a metaclass object. It +provides a set of introspection methods that largely parallel the +existing attribute methods, except they operate on class attributes. + +=head1 METHODS + +Every method provided by this role has an analogous method in +C or C for regular attributes. + +=head2 $meta->has_class_attribute($name) + +=head2 $meta->get_class_attribute($name) + +=head2 $meta->get_class_attribute_list() + +=head2 $meta->get_class_attribute_map() + +These methods operate on the current metaclass only. + +=head2 $meta->add_class_attribute(...) + +This accepts the same options as the L +C method. However, if an attribute is specified as +"required" an error will be thrown. + +=head2 $meta->remove_class_attribute($name) + +If the named class attribute exists, it is removed from the class, +along with its accessor methods. + +=head2 $meta->get_all_class_attributes() + +=head2 $meta->compute_all_applicable_class_attributes() + +These methods return a list of attribute objects for the class and all +its parent classes. + +=head2 $meta->find_class_attribute_by_name($name) + +This method looks at the class and all its parent classes for the +named class attribute. + +=head2 $meta->get_class_attribute_value($name) + +=head2 $meta->set_class_attribute_value($name, $value) + +=head2 $meta->set_class_attribute_value($name) + +=head2 $meta->clear_class_attribute_value($name) + +These methods operate on the storage for class attribute values, which +is attached to the metaclass object. + +There's really no good reason for you to call these methods unless +you're doing some deep hacking. They are named as public methods +solely because they are used by other meta roles and classes in this +distribution. + +=head2 inline_class_slot_access($name) + +=head2 inline_get_class_slot_value($name) + +=head2 inline_set_class_slot_value($name, $val_name) + +=head2 inline_is_class_slot_initialized($name) + +=head2 inline_deinitialize_class_slot($name) + +=head2 inline_weaken_class_slot_value($name) + +These methods return code snippets for inlining. + +There's really no good reason for you to call these methods unless +you're doing some deep hacking. They are named as public methods +solely because they are used by other meta roles and classes in this +distribution. + +=head1 AUTHOR + +Dave Rolsky, C<< >> + +=head1 BUGS + +See L for details. + +=head1 COPYRIGHT & LICENSE + +Copyright 2007-2008 Dave Rolsky, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/t/lib/SharedTests.pm b/t/lib/SharedTests.pm index 55a6656..d9e6cca 100644 --- a/t/lib/SharedTests.pm +++ b/t/lib/SharedTests.pm @@ -15,6 +15,7 @@ BEGIN } } +sub HasMXAH { $HasMXAH } { package HasClassAttribute; @@ -71,7 +72,7 @@ BEGIN default => sub { Delegatee->new() }, ); - if ($HasMXAH) + if ( SharedTests->HasMXAH() ) { class_has 'Mapping' => ( metaclass => 'Collection::Hash', @@ -140,6 +141,11 @@ BEGIN class_has '+ReadOnlyAttribute' => ( default => 30 ); + class_has 'YetAnotherAttribute' => + ( is => 'ro', + default => 'thing', + ); + no Moose; } @@ -236,7 +242,7 @@ sub run_tests SKIP: { skip 'These tests require MooseX::AttributeHelpers', 4 - unless $HasMXAH; + unless SharedTests->HasMXAH(); my @ids = HasClassAttribute->IdsInMapping(); is( scalar @ids, 0, diff --git a/t/pod-coverage.t b/t/pod-coverage.t index 4005e5e..105d648 100644 --- a/t/pod-coverage.t +++ b/t/pod-coverage.t @@ -3,12 +3,38 @@ use warnings; use Test::More; +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; -plan skip_all => 'This test is only run for the module author' - unless -d '.svn' || $ENV{IS_MAINTAINER}; +# This is a stripped down version of all_pod_coverage_ok which lets us +# vary the trustme parameter per module. +my @modules = all_modules(); +plan tests => scalar @modules; -eval "use Test::Pod::Coverage 1.04"; -plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" - if $@; +my %trustme = + ( 'MooseX::ClassAttribute' => [ 'init_meta', 'class_has' ], + 'MooseX::ClassAttribute::Meta::Method::Accessor' => qr/.+/, + ); + +for my $module ( sort @modules ) +{ + my $trustme; + + if ( $trustme{$module} ) + { + # why is qr// not a ref? + if ( ! ref $trustme{module} ) + { + $trustme = [ $trustme{module} ] + } + else + { + my $methods = join '|', @{ $trustme{$module} }; + $trustme = [ qr/^(?:$methods)/ ]; + } + } -all_pod_coverage_ok( { trustme => [ qr/^(?:class_has|process_class_attribute|container_class|unimport)$/ ] } ); + pod_coverage_ok( $module, { trustme => $trustme }, + "Pod coverage for $module" + ); +}