In my previous post, I wrote "What we need is a set of Perl::Critic policies for Moose." I've put my money where my mouth is and implemented five of them.
CPAN?
Perl::Critic::Dynamic::Moose is not on CPAN yet because Perl::Critic does not currently distinguish between "safe" (static) and "possibly unsafe" (dynamic) policies. Perl::Critic usually works by statically inspecting some Perl document. This allows users to critique untrusted code. Most of the policies I wrote are dynamic. These dynamic policies work by executing the code to be critiqued, then analyzing any new metaclasses that were created. While this limits their utility to analyzing only trusted code, this dynamicism does magnify analytic potential. Instead of inspecting PPI DOMs, these policies can inspect any and every metaobject in the system. A large part of why the metaobject protocol exists is for sane and consistent inspection, so these dynamic policies work well.
Anyway, Perl::Critic uses Module::Pluggable to unconditionally load every module in the Perl::Critic::Policy namespace. It would be harmful to add unsafe modules to that namespace, so I am going to make sure that a new Perl::Critic that runs only safe policies is released before I begin publishing dynamic policies. It should be a very simple matter of programming...
Perl::Critic::DynamicMoosePolicy
Perl::Critic::DynamicMoosePolicy is a base class for dynamic Moose policies. It's written, of course, with Moose (extending Perl::Critic::Policy using MooseX::NonMoose). It does the things that every dynamic Moose policy needs to do:
- Compile the document being analyzed
- Find all the metaclasses that were just created
- Call your policy's violates_metaclass for each metaclass
Ideally, policies would just implement violates_metaclass and it would all just work. However, there are (seemingly always) some details.
Since this analysis is entirely divorced from the source code, it is impossible (in general) to provide a useful file and line number pointing to the violation. Instead of making each policy provide an arbitrary location in the document for violations, DynamicMoosePolicy just does it for you. If you're combining PPI and metaobject inspection, then you can of course provide a more useful violation location when you have one. Instead of a location, I recommend that you be as detailed as possible in your error report (include the class name!)
Perl::Critic::DynamicPolicy runs each policy in a forked process, to prevent the analyzed code from mucking with the analyzing process's operation. Dynamic policies communicate violations with perlcritic via a parent-child pipe, with all violation objects frozen and thawed with Storable. This means your violations cannot include code references (such as those created by Scalar::Defer), or anything else that Storable cannot handle. I spent a while scratching my head trying to figure out what was causing this error:
Cannot restore overloading on HASH(0xc42f0c) (package <unknown>) at blib/lib/Storable.pm (autosplit into blib/lib/auto/Storable/thaw.al) line 415
It turned out to be the PPI::Document object that the violation was using as an arbitrary location. Specifying the first element in the document made that error go away. I'm not going to ask too many questions here, just smile and nod.
augment/inner
Policies may define a applies_to_metaclass method that filters for only the metaclasses that sensibly apply. I utilized the rarely-seen augment and inner for this method (as well as default_themes). The default implementation of applies_to_metaclass is:
sub applies_to_metaclass { 'Class::MOP::Class', inner() }
If the policy wants to analyze only role metaobjects, then they can ignore the method's inverse nature by writing the standard:
sub applies_to_metaclass { 'Moose::Meta::Role' }
If the policy wants to analyze only class metaobjects, then they do not have to augment this method. The parent's inner in such cases is a no-op, returning the empty list.
However, if a policy wants to analyze both classes and roles (which I suspect happens when the actual subject for analysis is attributes and methods), the policy can include:
augment applies_to_metaclass => sub {
'Moose::Meta::Role'
};
augment signals that the method resolution order descends the class hierarchy: grandparent -> parent -> child. inner calls the next most specific method. The end result of the above is the list ('Class::MOP::Class', 'Moose::Meta::Role').
PCP::DynamicMoose::ProhibitPublicBuilder
I wrote this policy first because I knew this area of the metaobject protocol well. Any problems were likely caused by the fork-and-eval side, not the inspection side. Pick your battles.
Each attribute can have a builder method that is called to provide a default value for that attribute. This facilitates changing this default value by subclassing and role application better than the default option does.
The inspection is straightforward. For each attribute on the class (or role), ensure that, if it has a builder, its name begins with an underscore. The only reason for this is because I sometimes forget my builders would be public API, when they generally should not be.
Handling roles for this policy sucks because attributes in roles are just inert hash references. Since there have been threats to improve roles to make use of real objects, I will elide handling roles here for brevity.
for my $name ($meta->get_attribute_list) {
my $attribute = $meta->get_attribute($name);
my $builder = $attribute->builder
or next;
if ($builder !~ /^_/) {
my $desc = "Builder method '$builder' of attribute ...";
push @violations,
$self->violation($desc, $PL);
}
}
get_attribute_list returns the names of attributes defined in this local class. Inherited attributes are not considered. I figure you would be running these policies on every class and role in your project anyway.
PCP::DynamicMoose::RequireMakeImmutable
Next up is another easy policy. This is by far the simplest. It performs one simple check on the metaclass (is_immutable).
Elliot Shank wrote Perl::Critic::Policy::Moose::RequireMakeImmutable, a static policy that checks for __PACKAGE__->meta->make_immutable. There is room enough for both a static and a dynamic policy. Not every class can make_immutable in that specific way. Class::MOP, for example calls make_immutable on all of its classes at once. In other cases, the programmer may have accidentally forgotten to call make_immutable on a dynamically-generated class.
As with most static policies, PCP::Moose::RequireMakeImmutable admirably handles the common cases, but might not handle strange corner cases well. Dynamic policies can fill such gaps.
PCP::Moose::RequireMethodModifiers
Moose provides a rich set of method modifiers:
- before
- after
- around
- override / super
- augment / inner
There's a method modifier for just about every way you'd want to interact with homonymous methods. If you define a method that is already present through inheritance, then this policy asks you to explicitly use a method modifier. This way, you might be able to catch accidental method overrides. If you do want to completely replace an ancestor's method, then you can use override without calling super. That too provides some typo protection, since override will confirm that an ancestral method exists.
This is the first novel dynamic policy; the previous policies could be implemented statically, but this one would have little chance. Let's walk through its entire violates_metaclass.
sub violates_metaclass {
my $self = shift;
my $class = shift;
my @violations;
This policy does not apply to roles, and does not require Moose-specific features (such as, well, roles), so it can use the default applies_to_metaclass. We also need a place to store the list of violations, since many methods could be implicitly overriding inherited methods.
for my $name ($class->get_method_list) {
my $method = $class->get_method($name);
We iterate over the class's local methods. get_method_list and get_method do not look at inherited methods at all. Methods brought in from locally-consumed roles are also included in this list — this is a feature called flattening. (If in your code you do want to consider inheritance, use get_all_methods and find_method_by_name)
# override and augment modifiers are always fine.
next if $method->isa('Moose::Meta::Method::Overridden')
|| $method->isa('Moose::Meta::Method::Augmented');
This quickly excludes two of the five method modifiers. Such modifiers have their own metaclasses for various reasons, not least of which is our usage here: to allow detection that the method is just a modifier.
# Since we can implicitly override and wrap in the same class, we
# need to be a little more careful here.
if ($method->isa('Class::MOP::Method::Wrapped')) {
my $orig_method = $method->get_original_method;
next if $method->associated_metaclass->name
ne $orig_method->associated_metaclass->name;
}
Handling the other three method modifiers (before, after, and around) is trickier. You can both define a method and wrap it with these three modifiers in the same class. This is useful for, say, running code before an attribute's clearer.
If the method we're wrapping is from a different metaclass, then we must be wrapping an inherited method, which is fine. If we're wrapping a local method, then we need to peel off a layer. We do not need peel off many layers in a loop, since multiple local modifiers coalesce into one layer.
# Generated methods
next if $method->isa('Class::MOP::Method::Generated');
This one worries me a little. Generated methods are those created for you by Moose. Examples include accessors, new (but only after a make_immutable), and delegation methods. Since these methods are generated for you, you have no way to indicate that they are overriding an inherited method.
Because you can certainly accidentally override an inherited method with a generated method, this check should be optional.
# XXX: this freaking sucks
next if $name eq 'meta'
|| $name eq 'BUILD'
|| $name eq 'DEMOLISH';
This "freaking sucks" for two reasons. meta is installed into your local class by Moose. That's fine (though we will eventually support renaming or excluding it). The metaclass of the meta method is not Class::MOP::Method::Generated like it should be, it's Moose::Meta::Method. This misclassification makes it look like a regular method defined by the user. meta would receive special consideration even if it were properly labeled as a generated method, because every class gets its own.
The other reason this sucks is the hardcoded BUILD and DEMOLISH. These are special methods with unusual dispatch semantics. Every BUILD and DEMOLISH method is called in your hierarchy automatically; there is no choice about redispatching to your inherited method. This is a useful feature, because too often do we forget to do this which can silently mess up initialization or destruction. Anyway, this list of special methods should be inspectable from the metaclass, and given their own Class::MOP::Method subclass.
my $next = $class->find_next_method_by_name($name);
# Adding new methods is always fine.
next if !$next;
Simple enough, right? It finds the inherited method by a given name, if any. If there is none, then it must be an entirely new method with a unique name, which is perfectly fine.
push @violations, $self->violation(
"The '$name' method of class " . $class->name
. " does not use a method modifier to"
. " override its superclass implementation.",
$EXPL);
}
return @violations;
That's all. We've exhausted all the acceptable ways for a method to interact with its super-methods, so what remains must be a violation.
PCP::DynamicMoose::ClassOverridesRole
Ahhh, the violation that launched a thousand comments. I've already summed up the what and the why of this violation.
I wrote this policy today. It required keeping track of more metadata in Moose. There exist a handful of Moose::Meta::Role::Application classes, which track, among other things, an application of a role to a class. We were creating these objects but then discarding them once the application was completed. Instead, we now keep track of them. Progress!
Let's walk through this implementation as well.
sub violates_metaclass {
my $self = shift;
my $class = shift;
my @violations;
Familiar enough.
for my $application ($class->role_applications) {
my $role = $application->role;
Every time you consume a role with with, it creates an object of class Moose::Meta::Role::Application::ToClass and adds it to your metaclass. This object has, among other things, a role attribute.
As an aside, it might be interesting to make the does method return these role application objects. They're certainly true values, and there is precedent: the true value that can returns is a code reference.
for my $method ($role->get_method_list) {
next if $application->is_method_excluded($method);
next if $application->is_method_aliased($method);
We need to consider every method in the role. If a method has been excluded or aliased, then that is explicit overriding, so the violation does not apply.
To allow for this explicit override is exactly why I needed to add role-application tracking to Moose, and why I could not implement this policy until today.
my $method_object = $class->get_method($method)
or next;
We inspect the method's metaobject from the class. Again, we use get_method and not find_method_by_name because we do not want to consider inheritance. At this point, the method is definitely there, since it hasn't been excluded. What matters now is whether the role provided it or if the class did.
if ($method_object->isa('Moose::Meta::Role::Method')) {
next if $method_object->body
== $role->get_method($method)->body;
}
Methods of class Moose::Meta::Role::Method were originally pulled in from a role. If the method was not provided by a role, then it was a silent class override.
The inside statement makes sure that the method was provided from the correct role, not just any role. If you sequentially apply Role::Dog then Role::Tree, you would want to know about the implicit override of Dog's bark method with Tree's.
The inside statement also attempts to handle the method coming in from the same role multiple ways. Suppose you have a Foo::Basic role with a method kerplow that is consumed by both the Foo::Advanced and Foo::Safe roles. A class that sequentially consumes Foo::Advanced then Foo::Safe would get the kerplow method twice. But since it's the exact same implementation (i.e. the same code reference), it's not worth warning about. I trust that the programmer will utilize Test::Perl::Critic, so that the divergence of the two kerplow methods would become a violation.
my $class_name = $class->name;
my $role_name = $role->name;
my $desc = "Class '$class_name' method '$method'"
. " implicitly overrides the same method"
. " from role '$role_name'";
push @violations, $self->violation($desc, $EXPL);
}
}
return @violations;
And that's it.
PCP::Moose::ProhibitMultipleWiths
I did write one static policy, which prohibits multiple calls to with in one package. Roles provide powerful and safe means of combination, but these are only activated if you actually combine the roles. If you sequentially apply multiple roles to a class, conflicting method names are silently ignored. This could possibly be fixed in the future, but for now we'll have to live with this behavior. At least we can now warn you about it.
This implementation is pretty simple as far as Perl::Critic policies go. I wrote this one as a static policy because PPI-based analysis is still very worthwhile. It actually would have been easier to implement dynamically. However, as I explained earlier, you would lose out the "location" of the violation — the second with.
Conclusion
I'm quite happy with how dynamic Moose policies are coming along. We now have policies for all the ideas I listed in my previous post. The only one I didn't cover, "Declaring new methods instead of using the many object construction hooks", was written quickly after my post by Elliot as a static policy.
As far as writing more policies, I think it's largely limited by creativity. I was able to write all the policies I wanted. There were some hairy bits, but mostly it was quite pleasant and a novel use of the metaobject protocol.
Ovid has submitted a bug to the Moose RT queue: Excluded methods should be added to 'requires'. I'm not sure I agree with his assertion that "since My::Class->meta->does('My::Role::Foo'), there's a promise that it will provide the &foo method". Since this may not make it into core Moose, I invite Ovid to write a policy covering this case. It would look quite similar to the ClassOverridesRole policy.
If you have ideas for more policies, or (better yet) would like help implementing them, get in touch with me! I'd be thrilled to help you out.
The code for the DynamicMoose policies is in Moose's git repository. Commit bits to this repo are handed out liberally, just ask in #moose on irc.perl.org. Providing a patch with your request will help your chances.
These policies have not been battle tested on large codebases, only on the microscopic class hierarchies in its test cases. I expect that DynamicMoosePolicy will need more work before it is all ready for wide use. Get your bug reports in before I move on to the next interesting project. :)
