but it's possible that conflicts could occur. This module has been
tested to work with C<MooseX::AttributeHelpers>.
+=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<I am not suggesting that you must do this> 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<http://www.urth.org/~autarch/fs-donation.html>
+
=head1 AUTHOR
Dave Rolsky, C<< <autarch@urth.org> >>
1;
+=pod
+
+=head1 NAME
+
+MooseX::ClassAttribute::Meta::Method::Accessor - Accessor method generation for class attributes
+
+=head1 DESCRIPTION
+
+This class overrides L<Moose::Meta::Method::Accessor> to do code
+generation properly for class attributes.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+See L<MooseX::ClassAttribute> 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
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<Moose::Meta::Attribute>, but
+if it were then it couldn't be combined with other attribute
+metaclasses, like C<MooseX::AttributeHelpers>.
+
+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<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+See L<MooseX::ClassAttribute> 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
+
+
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;
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;
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<Class::MOP::Class> or C<Moose::Meta::Class> 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<Moose::Meta::Attribute>
+C<add_attribute()> 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<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+See L<MooseX::ClassAttribute> 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
}
}
+sub HasMXAH { $HasMXAH }
{
package HasClassAttribute;
default => sub { Delegatee->new() },
);
- if ($HasMXAH)
+ if ( SharedTests->HasMXAH() )
{
class_has 'Mapping' =>
( metaclass => 'Collection::Hash',
class_has '+ReadOnlyAttribute' =>
( default => 30 );
+ class_has 'YetAnotherAttribute' =>
+ ( is => 'ro',
+ default => 'thing',
+ );
+
no Moose;
}
SKIP:
{
skip 'These tests require MooseX::AttributeHelpers', 4
- unless $HasMXAH;
+ unless SharedTests->HasMXAH();
my @ids = HasClassAttribute->IdsInMapping();
is( scalar @ids, 0,
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"
+ );
+}
projects / gitmo/MooseX-ClassAttribute.git / commitdiff