view release on metacpan or  search on metacpan

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

package App::DBCritic::Policy::BidirectionalRelationship;

# ABSTRACT: Check for missing bidirectional relationships in ResultSources

#pod =head1 SYNOPSIS
#pod
#pod     use App::DBCritic;
#pod
#pod     my $critic = App::DBCritic->new(
#pod         dsn => 'dbi:Oracle:HR', username => 'scott', password => 'tiger');
#pod     $critic->critique();
#pod
#pod =head1 DESCRIPTION
#pod
#pod This policy returns a violation if one or more of a
#pod L<DBIx::Class::ResultSource|DBIx::Class::ResultSource>'s relationships does not
#pod have a corresponding reverse relationship in the other class.
#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;
use Sub::Quote;
use namespace::autoclean -also => qr{\A _}xms;

has description => (
    is      => 'ro',
    default => quote_sub q{'Missing bidirectional relationship'},
);

#pod =attr description
#pod
#pod "Missing bidirectional relationship"
#pod
#pod =cut

has explanation => (
    is      => 'ro',
    default => quote_sub
        q{'Related tables should have relationships defined in both classes.'},
);

#pod =attr explanation
#pod
#pod "Related tables should have relationships defined in both classes."
#pod
#pod =cut

sub violates {
    my $source = shift->element;

    return join "\n",
        map { _message( $source->name, $source->related_source($_)->name ) }
        grep { !keys %{ $source->reverse_relationship_info($_) } }
        $source->relationships;
}

#pod =method violates
#pod
#pod If the L<"current element"|App::DBCritic::Policy>'s
#pod L<relationships|DBIx::Class::ResultSource/relationships> do not all have
#pod corresponding
#pod L<"reverse relationships"|DBIx::Class::ResultSource/reverse_relationship_info>,
#pod returns a string describing details of the issue.
#pod
#pod =cut

sub _message { return "$_[0] to $_[1] not reciprocated" }

with 'App::DBCritic::PolicyType::ResultSource';

#pod =attr applies_to
#pod
#pod This policy applies to L<ResultSource|DBIx::Class::ResultSource>s.
#pod
#pod =cut

1;

__END__

=pod

=encoding UTF-8

=for :stopwords Mark Gardner cpan testmatrix url annocpan anno bugtracker rt cpants
kwalitee diff irc mailto metadata placeholders metacpan

=head1 NAME

App::DBCritic::Policy::BidirectionalRelationship - Check for missing bidirectional relationships in ResultSources

=head1 VERSION

version 0.023

=head1 SYNOPSIS

    use App::DBCritic;

    my $critic = App::DBCritic->new(
        dsn => 'dbi:Oracle:HR', username => 'scott', password => 'tiger');
    $critic->critique();

=head1 DESCRIPTION

This policy returns a violation if one or more of a
L<DBIx::Class::ResultSource|DBIx::Class::ResultSource>'s relationships does not
have a corresponding reverse relationship in the other class.

=head1 ATTRIBUTES

=head2 description

"Missing bidirectional relationship"

=head2 explanation

"Related tables should have relationships defined in both classes."

=head2 applies_to

This policy applies to L<ResultSource|DBIx::Class::ResultSource>s.

=head1 METHODS

=head2 violates

If the L<"current element"|App::DBCritic::Policy>'s
L<relationships|DBIx::Class::ResultSource/relationships> do not all have
corresponding
L<"reverse relationships"|DBIx::Class::ResultSource/reverse_relationship_info>,
returns a string describing details of the issue.

=head1 SUPPORT

=head2 Perldoc

You can find documentation for this module with the perldoc command.

  perldoc App::DBCritic::Policy::BidirectionalRelationship

=head2 Websites

The following websites have more information about this module, and may be of help to you. As always,
in addition to those websites please use your favorite search engine to discover more resources.

=over 4

=item *

Search CPAN

The default CPAN search engine, useful to view POD in HTML format.

L<http://search.cpan.org/dist/App-DBCritic>

=item *

CPAN Ratings

The CPAN Ratings is a website that allows community ratings and reviews of Perl modules.