File Coverage

blib/lib/Aniki/Schema/Relationship/Declare.pm
Criterion Covered Total %
statement 62 62 100.0
branch n/a
condition n/a
subroutine 16 16 100.0
pod n/a
total 78 78 100.0


line stmt bran cond sub pod time code
1             package Aniki::Schema::Relationship::Declare;
2 28     28   7733483 use 5.014002;
  28         156  
3              
4 28     28   154 use strict;
  28         97  
  28         592  
5 28     28   157 use warnings;
  28         80  
  28         653  
6              
7 28     28   158 use B::Hooks::EndOfScope;
  28         68  
  28         299  
8 28     28   2403 use DBIx::Schema::DSL ();
  28         268914  
  28         454  
9 28     28   142 use Aniki::Schema::Relationship;
  28         64  
  28         1374  
10              
11             my %RULES;
12              
13             sub import {
14 28     28   333 my $caller = caller;
15             {
16 28     28   172 no strict qw/refs/;
  28         66  
  28         3112  
  28         65  
17 28     86   124 *{"${caller}::relationship_rules"} = sub { $RULES{$caller} };
  28         201  
  86         1563  
18 28         79 *{"${caller}::relation"} = \&_relation;
  28         179  
19 28         77 *{"${caller}::relay_to"} = \&_relay_to;
  28         121  
20 28         69 *{"${caller}::relay_by"} = \&_relay_by;
  28         117  
21             }
22             on_scope_end {
23 28     28   175 no strict qw/refs/;
  28         67  
  28         728  
24 28     28   194 no warnings qw/redefine/;
  28         63  
  28         8057  
25 28     28   5898 *{"${caller}::create_table"} = \&_create_table;
  28         335  
26 28         200 };
27             }
28              
29             my %TABLE_NAME;
30              
31             sub _create_table ($$) {## no critic
32 80     80   607516 my ($table_name, $code) = @_;
33 80         238 my $caller = caller;
34 80         334 $TABLE_NAME{$caller} = $table_name;
35 80         349 goto \&DBIx::Schema::DSL::create_table;
36             }
37              
38             sub _relation {
39 104     104   348 my ($src_columns, $dest_table_name, $dest_columns, %opt) = @_;
40 104         221 my $caller = caller;
41 104         206 my $src_table_name = $TABLE_NAME{$caller};
42 104         235 push @{ $RULES{$caller} } => {
  104         683  
43             src_table_name => $src_table_name,
44             src_columns => $src_columns,
45             dest_table_name => $dest_table_name,
46             dest_columns => $dest_columns,
47             %opt,
48             };
49             }
50              
51             sub _relay_to {
52 52     52   14500 my $dest_table_name = shift;
53 52         152 my $caller = caller;
54 52         172 my $src_columns = ["${dest_table_name}_id"];
55 52         215 my $dest_columns = ['id'];
56 52         181 @_ = ($src_columns, $dest_table_name, $dest_columns, @_);
57 52         186 goto \&_relation;
58             }
59              
60             sub _relay_by {
61 52     52   66608 my $dest_table_name = shift;
62 52         128 my $caller = caller;
63 52         121 my $src_table_name = $TABLE_NAME{$caller};
64 52         211 my $src_columns = ['id'];
65 52         155 my $dest_columns = ["${src_table_name}_id"];
66 52         170 @_ = ($src_columns, $dest_table_name, $dest_columns, @_);
67 52         169 goto \&_relation;
68             }
69              
70             1;
71             __END__
72              
73             =pod
74              
75             =encoding utf-8
76              
77             =head1 NAME
78              
79             Aniki::Schema::Relationship::Declare - DSL for declaring relationship rules
80              
81             =head1 SYNOPSIS
82              
83             use 5.014002;
84             package MyProj::DB::Schema {
85             use DBIx::Schema::DSL;
86             use Aniki::Schema::Relationship::Declare;
87              
88             create_table 'module' => columns {
89             integer 'id', primary_key, auto_increment;
90             varchar 'name';
91             integer 'author_id';
92              
93             add_index 'author_id_idx' => ['author_id'];
94              
95             relay_to 'author', name => '';
96             };
97              
98             create_table 'author' => columns {
99             integer 'id', primary_key, auto_increment;
100             varchar 'name', unique;
101              
102             relay_by 'module';
103             };
104             };
105              
106             1;
107              
108             =head1 FUNCTIONS
109              
110             =over 4
111              
112             =item C<relay_to>
113              
114             =item C<relay_by>
115              
116             =item C<relation>
117              
118             =back
119              
120             =head1 SEE ALSO
121              
122             L<perl>
123              
124             =head1 LICENSE
125              
126             Copyright (C) karupanerura.
127              
128             This library is free software; you can redistribute it and/or modify
129             it under the same terms as Perl itself.
130              
131             =head1 AUTHOR
132              
133             karupanerura E<lt>karupa@cpan.orgE<gt>
134              
135             =cut