File Coverage

blib/lib/RapidApp/Util/MetaKeys/FK.pm
Criterion Covered Total %
statement 12 15 80.0
branch n/a
condition n/a
subroutine 4 7 57.1
pod 0 3 0.0
total 16 25 64.0


line stmt bran cond sub pod time code
1             package RapidApp::Util::MetaKeys::FK;
2 1     1   656 use strict;
  1         2  
  1         24  
3 1     1   5 use warnings;
  1         1  
  1         24  
4              
5              
6 1     1   421 use Moo;
  1         9680  
  1         5  
7 1     1   1700 use Types::Standard qw(:all);
  1         71605  
  1         11  
8              
9              
10             # Aliases:
11 0     0 0   sub local_column { (shift)->column(@_) }
12 0     0 0   sub local_table { (shift)->table(@_) }
13 0     0 0   sub local_schema { (shift)->schema(@_) }
14              
15             around 'BUILDARGS' => sub {
16             my $orig = shift;
17             my $class = shift;
18             my $args = $_[0];
19            
20             if(ref($args) && ref($args) eq 'HASH') {
21             my @locs = qw(local_column local_table local_schema);
22             my %locs = map {$_=>1} @locs;
23             return $class->$orig({ map {
24             $_ =~ s/^local_// if ($locs{$_});
25             ( $_ => $args->{$_} )
26             } keys %$args })
27             }
28             else {
29             return $class->$orig(@_)
30             }
31             };
32              
33              
34             has 'lhs', is => 'ro', isa => Maybe[HashRef], default => sub { undef };
35             has 'rhs', is => 'ro', isa => Maybe[HashRef], default => sub { undef };
36              
37             has 'column', is => 'ro', isa => Str, lazy => 1, default => sub {
38             my $self = shift;
39             my $lhs = $self->lhs or die "Either 'column' or 'lhs' must be supplied";
40             $lhs->{column}
41             };
42              
43             has 'table', is => 'ro', isa => Str, lazy => 1, default => sub {
44             my $self = shift;
45             my $lhs = $self->lhs or die "Either 'table' or 'lhs' must be supplied";
46             $lhs->{table}
47             };
48              
49             has 'schema', is => 'ro', isa => Maybe[Str], lazy => 1, default => sub {
50             my $self = shift;
51             my $lhs = $self->lhs or return undef;
52             $lhs->{schema}
53             };
54              
55              
56              
57              
58             has 'remote_column', is => 'ro', isa => Str, lazy => 1, default => sub {
59             my $self = shift;
60             my $rhs = $self->rhs or die "Either 'remote_column' or 'rhs' must be supplied";
61             $rhs->{column}
62             };
63              
64             has 'remote_table', is => 'ro', isa => Str, lazy => 1, default => sub {
65             my $self = shift;
66             my $rhs = $self->rhs or die "Either 'remote_table' or 'rhs' must be supplied";
67             $rhs->{table}
68             };
69              
70             has 'remote_schema', is => 'ro', isa => Maybe[Str], lazy => 1, default => sub {
71             my $self = shift;
72             my $rhs = $self->rhs or return undef;
73             $rhs->{schema}
74             };
75              
76            
77              
78             1;
79              
80              
81             __END__
82              
83             =head1 NAME
84              
85             RapidApp::Util::MetaKeys::FK - External FK declarations, fk obj (EXPERIMENTAL)
86              
87              
88             =head1 DESCRIPTION
89              
90             Experimental external definitions of foreign keys. Used internally by L<RapidApp::Util::MetaKeys>
91              
92              
93             =head1 SEE ALSO
94              
95             =over
96              
97             =item *
98              
99             L<RapidApp::Util::MetaKeys>
100              
101             =item *
102              
103             L<RapidApp>
104              
105             =back
106              
107             =head1 AUTHOR
108              
109             Henry Van Styn <vanstyn@cpan.org>
110              
111             =head1 COPYRIGHT AND LICENSE
112              
113             This software is copyright (c) 2015 by IntelliTree Solutions llc.
114              
115             This is free software; you can redistribute it and/or modify it under
116             the same terms as the Perl 5 programming language system itself.
117              
118             =cut