File Coverage

blib/lib/App/DBCritic/Policy/BidirectionalRelationship.pm
Criterion Covered Total %
statement 21 21 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 28 28 100.0


line stmt bran cond sub pod time code
1             package App::DBCritic::Policy::BidirectionalRelationship;
2              
3             # ABSTRACT: Check for missing bidirectional relationships in ResultSources
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod use App::DBCritic;
8             #pod
9             #pod my $critic = App::DBCritic->new(
10             #pod dsn => 'dbi:Oracle:HR', username => 'scott', password => 'tiger');
11             #pod $critic->critique();
12             #pod
13             #pod =head1 DESCRIPTION
14             #pod
15             #pod This policy returns a violation if one or more of a
16             #pod L's relationships does not
17             #pod have a corresponding reverse relationship in the other class.
18             #pod
19             #pod =cut
20              
21 5     5   3855 use strict;
  5         13  
  5         193  
22 5     5   29 use utf8;
  5         11  
  5         29  
23 5     5   128 use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion)
  5         12  
  5         31  
24              
25             our $VERSION = '0.023'; # VERSION
26 5     5   769 use English '-no_match_vars';
  5         14  
  5         39  
27 5     5   1963 use Moo;
  5         12  
  5         30  
28 5     5   2091 use Sub::Quote;
  5         21  
  5         524  
29 5     5   46 use namespace::autoclean -also => qr{\A _}xms;
  5         12  
  5         78  
30              
31             has description => (
32             is => 'ro',
33             default => quote_sub q{'Missing bidirectional relationship'},
34             );
35              
36             #pod =attr description
37             #pod
38             #pod "Missing bidirectional relationship"
39             #pod
40             #pod =cut
41              
42             has explanation => (
43             is => 'ro',
44             default => quote_sub
45             q{'Related tables should have relationships defined in both classes.'},
46             );
47              
48             #pod =attr explanation
49             #pod
50             #pod "Related tables should have relationships defined in both classes."
51             #pod
52             #pod =cut
53              
54             sub violates {
55             my $source = shift->element;
56              
57             return join "\n",
58             map { _message( $source->name, $source->related_source($_)->name ) }
59             grep { !keys %{ $source->reverse_relationship_info($_) } }
60             $source->relationships;
61             }
62              
63             #pod =method violates
64             #pod
65             #pod If the L<"current element"|App::DBCritic::Policy>'s
66             #pod L do not all have
67             #pod corresponding
68             #pod L<"reverse relationships"|DBIx::Class::ResultSource/reverse_relationship_info>,
69             #pod returns a string describing details of the issue.
70             #pod
71             #pod =cut
72              
73             sub _message { return "$_[0] to $_[1] not reciprocated" }
74              
75             with 'App::DBCritic::PolicyType::ResultSource';
76              
77             #pod =attr applies_to
78             #pod
79             #pod This policy applies to Ls.
80             #pod
81             #pod =cut
82              
83             1;
84              
85             __END__