File Coverage

blib/lib/App/DBCritic/Policy/DuplicateRelationships.pm
Criterion Covered Total %
statement 27 27 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 36 36 100.0


line stmt bran cond sub pod time code
1             package App::DBCritic::Policy::DuplicateRelationships;
2              
3             # ABSTRACT: Check for ResultSources with unnecessary duplicate relationships
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 a
16             #pod L has relationships to
17             #pod other tables that are identical in everything but name.
18             #pod
19             #pod =cut
20              
21 5     5   7998 use strict;
  5         14  
  5         165  
22 5     5   29 use utf8;
  5         10  
  5         41  
23 5     5   151 use Modern::Perl '2011'; ## no critic (Modules::ProhibitUseQuotedVersion)
  5         11  
  5         42  
24              
25             our $VERSION = '0.023'; # VERSION
26 5     5   4223 use Algorithm::Combinatorics 'combinations';
  5         18181  
  5         351  
27 5     5   2904 use Data::Compare;
  5         54537  
  5         36  
28 5     5   20004 use English '-no_match_vars';
  5         14  
  5         46  
29 5     5   1959 use Moo;
  5         9  
  5         57  
30 5     5   2297 use Sub::Quote;
  5         12  
  5         422  
31 5     5   2664 use namespace::autoclean -also => qr{\A _}xms;
  5         7707  
  5         57  
32              
33             has description => (
34             is => 'ro',
35             default => quote_sub q{'Duplicate relationships'},
36             );
37              
38             #pod =attr description
39             #pod
40             #pod "Duplicate relationships"
41             #pod
42             #pod =cut
43              
44             has explanation => (
45             is => 'ro',
46             default => quote_sub
47             q{'Each connection between tables should only be expressed once.'},
48             );
49              
50             #pod =attr explanation
51             #pod
52             #pod "Each connection between tables should only be expressed once."
53             #pod
54             #pod =cut
55              
56             sub violates {
57             my $source = shift->element;
58             return if $source->relationships < 2;
59              
60             return join "\n" => map { sprintf '%s and %s are duplicates', @{$_} }
61             grep {
62             Compare( map { $source->relationship_info($_) } @{$_} )
63             } combinations( [ $source->relationships ], 2 );
64             }
65              
66             #pod =method violates
67             #pod
68             #pod Returns details if the
69             #pod L<"current element"|App::DBCritic::Policy>'s C
70             #pod hashes for any defined relationships are duplicated.
71             #pod
72             #pod =cut
73              
74             with 'App::DBCritic::PolicyType::ResultSource';
75              
76             #pod =attr applies_to
77             #pod
78             #pod This policy applies to Ls.
79             #pod
80             #pod =cut
81              
82             1;
83              
84             __END__