From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 26 Apr 2009 00:32:06 +0000 (-0400)
Subject: First policy: prohibit public builders
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ac490c58d044081a1f59d5dd9a0cfaf0532891b6;p=gitmo%2FPerl-Critic-Dynamic-Moose.git

First policy: prohibit public builders
---

diff --git a/lib/Perl/Critic/Policy/Dynamic/Moose/ProhibitPublicBuilders.pm b/lib/Perl/Critic/Policy/Dynamic/Moose/ProhibitPublicBuilders.pm
new file mode 100644
index 0000000..841746d
--- /dev/null
+++ b/lib/Perl/Critic/Policy/Dynamic/Moose/ProhibitPublicBuilders.pm
@@ -0,0 +1,32 @@
+package Perl::Critic::Policy::Dynamic::Moose::ProhibitPublicBuilders;
+use Moose;
+extends 'Perl::Critic::Policy::Dynamic::Moose';
+
+Readonly::Scalar my $DESC = q{Builder method name without a leading underscore};
+Readonly::Scalar my $EXPL = q{Prefix builder method names with an underscore};
+
+sub violates_metaclass {
+    my $self = shift;
+    my $meta = shift;
+
+    my @violations;
+
+    my $attributes = $meta->get_attribute_map;
+    for my $name (keys %$attributes) {
+        my $attribute = $attributes->{$name};
+
+        next if !$attribute->has_builder;
+
+        if ($attribute->builder =~ /^_/) {
+            push @violations, $self->violation($DESC, $EXPL);
+        }
+    }
+
+    return @violations;
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
+