File Coverage

blib/lib/App/DBCritic/Policy.pm

Criterion	Covered	Total	%
statement	24	24	100.0
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	33	33	100.0

package App::DBCritic::Policy;

# ABSTRACT: Role for criticizing database schemas

#pod =head1 SYNOPSIS
#pod
#pod     package App::DBCritic::Policy::MyPolicy;
#pod     use Moo;
#pod
#pod     has description => ( default => sub{'Follow my policy'} );
#pod     has explanation => ( default => {'My way or the highway'} );
#pod     has applies_to  => ( default => sub { ['ResultSource'] } );
#pod     with 'App::DBCritic::Policy';
#pod
#pod     sub violates { $_[0]->element ne '' }
#pod
#pod =head1 DESCRIPTION
#pod
#pod This is a L consumed by all L
#pod policy plugins.
#pod
#pod =cut

use strict;
use utf8;
use Modern::Perl '2011';    ## no critic (Modules::ProhibitUseQuotedVersion)

our $VERSION = '0.023';     # VERSION
use English '-no_match_vars';
use Moo::Role;
use App::DBCritic::Violation;
use namespace::autoclean -also => qr{\A _}xms;

requires qw(description explanation violates applies_to);

#pod =method description
#pod
#pod Required method. Returns a short string describing what's wrong.
#pod
#pod =method explanation
#pod
#pod Required method. Returns a string giving further details.
#pod
#pod =method applies_to
#pod
#pod Required method. Returns an array reference of types of
#pod L objects
#pod indicating what part(s) of the schema the policy is interested in.
#pod
#pod =cut

around violates => sub {
    my ( $orig, $self ) = splice @_, 0, 2;
    $self->_set_element(shift);
    $self->_set_schema(shift);

    my $details = $self->$orig(@_);
    return $self->violation($details) if $details;

    return;
};

#pod =method violates
#pod
#pod Required method. Role consumers must implement a C method that
#pod returns true if the
#pod policy is violated and false otherwise, based on attributes provided by the
#pod role.  Callers should call the C method as the following:
#pod
#pod     $policy->violates($element, $schema);
#pod
#pod =over
#pod
#pod =item Arguments: I<$element>, I<$schema>
#pod
#pod =item Return value: nothing if the policy passes, or a
#pod L
#pod object if it doesn't.
#pod
#pod =back
#pod
#pod =cut

has element => ( is => 'ro', init_arg => undef, writer => '_set_element' );

#pod =attr element
#pod
#pod Read-only accessor for the current schema element being examined by
#pod L.
#pod
#pod =cut

sub violation {
    my $self = shift;
    return App::DBCritic::Violation->new(
        details => shift,
        map { $_ => $self->$_ } qw(description explanation element),
    );
}

#pod =method violation
#pod
#pod Given a string description of a violation that has been encountered, creates a
#pod new L
#pod object from the current policy.
#pod
#pod =cut

has schema => ( is => 'ro', writer => '_set_schema' );

#pod =attr schema
#pod
#pod Read-only accessor for the current schema object being examined by
#pod L.
#pod
#pod =cut

1;

__END__