view release on metacpan or  search on metacpan

lib/App/DBCritic/Policy.pm  view on Meta::CPAN

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<role|Moo::Role> consumed by all L<App::DBCritic|App::DBCritic>
#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<DBIx::Class|DBIx::Class> 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<violates> 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<violates> 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<App::DBCritic::Violation|App::DBCritic::Violation>
#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