File Coverage

blib/lib/DBIx/Class/Helpers/Util.pm
Criterion Covered Total %
statement 46 51 90.2
branch 28 34 82.3
condition 15 18 83.3
subroutine 10 10 100.0
pod 6 6 100.0
total 105 119 88.2


line stmt bran cond sub pod time code
1             package DBIx::Class::Helpers::Util;
2             $DBIx::Class::Helpers::Util::VERSION = '2.035000';
3 57     57   115721 use strict;
  57         130  
  57         1671  
4 57     57   313 use warnings;
  57         110  
  57         2823  
5              
6             # ABSTRACT: Helper utilities for DBIx::Class components
7              
8 57         793 use Sub::Exporter::Progressive -setup => {
9             exports => [
10             qw(
11             get_namespace_parts is_load_namespaces is_not_load_namespaces
12             assert_similar_namespaces order_by_visitor
13             normalize_connect_info
14             ),
15             ],
16 57     57   840 };
  57         1272  
17              
18             sub get_namespace_parts {
19 562     562 1 2650 my $package = shift;
20              
21 562 50       2937 if ($package =~ m/(^[\w:]+::Result)::([\w:]+)$/) {
22 562         3230 return ($1, $2);
23             } else {
24 0         0 die "$package doesn't look like ".'$namespace::Result::$resultclass';
25             }
26             }
27              
28             sub is_load_namespaces {
29 683     683 1 3567 my $namespace = shift;
30 683         4408 $namespace =~ /^[\w:]+::Result::[\w:]+$/;
31             }
32              
33             sub is_not_load_namespaces {
34 7     7 1 3331 my $namespace = shift;
35 7 50       93 $namespace =~ /^([\w:]+)::[\w]+$/ and
36             $1 !~ /::Result/;
37             }
38              
39             sub assert_similar_namespaces {
40 341     341 1 5571 my $ns1 = shift;
41 341         588 my $ns2 = shift;
42              
43 341 100 100     823 die "Namespaces $ns1 and $ns2 are dissimilar"
      100        
      100        
44             unless is_load_namespaces($ns1) and is_load_namespaces($ns2) or
45             is_not_load_namespaces($ns1) and is_not_load_namespaces($ns2);
46             }
47              
48             sub _order_by_visitor_HASHREF {
49 4     4   9 my ($hash, $callback) = @_;
50              
51 4         6 my %ret;
52             # there should only be one k/v pair, but DBIC checks for that and I'm not
53             # going to reimplement said check here.
54 4         14 for my $k (keys %$hash) {
55 4         8 my $v = $hash->{$k};
56              
57 4 100       22 if (my $v_ref = ref $v) {
58 1 50       3 if ($v_ref eq 'ARRAY' ) {
59 1         21 $ret{$k} = [ map $callback->($_), @$v ]
60             } else {
61 0         0 die 'this should never happen'
62             }
63             } else {
64 3         7 $ret{$k} = ($callback->($v));
65             }
66             }
67              
68 4         43 \%ret
69             }
70              
71             sub order_by_visitor {
72 4     4 1 3585 my ($order, $callback) = @_;
73              
74 4 100       15 if (my $top_ref = ref $order) {
75 3 100       12 if ($top_ref eq 'HASH') {
    50          
76 1         4 return _order_by_visitor_HASHREF($order, $callback)
77             } elsif ($top_ref eq 'ARRAY') {
78             return [
79             map {
80 2 100       5 if (my $ref = ref $_) {
  5         16  
81 3 50       7 if ($ref eq 'HASH') {
82 3         8 _order_by_visitor_HASHREF($_, $callback)
83             } else {
84 0         0 die 'this should never happen'
85             }
86             } else {
87 2         4 $callback->($_)
88             }
89             } @$order
90             ];
91             }
92             } else {
93 1         5 return $callback->($order)
94             }
95             }
96              
97             sub normalize_connect_info {
98 67     67 1 11225 my %all;
99              
100 67 100       348 if (!ref $_[0]) {
    50          
101             %all = (
102             dsn => $_[0],
103             ( exists $_[1] ?
104             (user => $_[1],
105              
106             exists $_[2] ?
107             ( password => $_[2],
108              
109             ( exists $_[3] && ref $_[3] ?
110 2         13 %{$_[3]}
111             : ()
112             ),
113              
114             ( exists $_[4] && ref $_[4] ?
115 65 100 66     432 %{$_[4]}
  1 100 66     6  
    100          
    100          
116             : ()
117             ),
118              
119             )
120             : ()
121              
122             )
123              
124             : ()
125             ),
126             )
127             } elsif (ref $_[0] eq 'CODE') {
128             %all = (
129             dbh_maker => $_[0],
130             ( exists $_[1] && ref $_[1] ?
131 2 100 66     16 %{$_[1]}
  1         5  
132             : ()
133             ),
134             )
135             } else {
136 0         0 %all = %{$_[0]}
  0         0  
137             }
138              
139 67         280 return \%all;
140             }
141              
142             1;
143              
144             __END__
145              
146             =pod
147              
148             =head1 NAME
149              
150             DBIx::Class::Helpers::Util - Helper utilities for DBIx::Class components
151              
152             =head1 SYNOPSIS
153              
154             use DBIx::Class::Helpers::Util ':all';
155              
156             my ($namespace, $class) = get_namespace_parts('MyApp:Schema::Person');
157             is $namespace, 'MyApp::Schema';
158             is $class, 'Person';
159              
160             if (is_load_namespaces('MyApp::Schema::Result::Person')) {
161             print 'correctly structured project';
162             }
163              
164             if (is_not_load_namespaces('MyApp::Schema::Person')) {
165             print 'incorrectly structured project';
166             }
167              
168             if (assert_similar_namespaces('MyApp::Schema::Person', 'FooApp::Schema::People')) {
169             print 'both projects are structured similarly';
170             }
171              
172             if (assert_similar_namespaces('MyApp::Schema::Result::Person', 'FooApp::Schema::Result::People')) {
173             print 'both projects are structured similarly';
174             }
175              
176             # in a resultset
177              
178             sub search {
179             my ($self, $search, $attrs) = @_;
180              
181             $attrs->{order_by} = order_by_visitor($attrs->{order_by}, sub {
182             my $field = shift;
183              
184             return 'foo_bar' if $field eq 'foo.bar';
185             return $field;
186             }) if $attrs && $attrs->{order_by};
187              
188             $self->next::method($search, $attrs);
189             }
190              
191             # in schema
192              
193             sub connection {
194             my $self = shift;
195              
196             my $args = normalize_connect_info(@_);
197             $args->{quote_names} = 1;
198              
199             $self->next::method($args)
200             }
201              
202             =head1 DESCRIPTION
203              
204             A collection of various helper utilities for L<DBIx::Class> stuff. Probably
205             only useful for components.
206              
207             =head1 EXPORTS
208              
209             =head2 order_by_visitor
210              
211             This function allows you to easily transform C<order_by> clauses. See
212             L</SYNOPSIS> for example.
213              
214             =head2 get_namespace_parts
215              
216             Returns the namespace and class name of a package. See L</SYNOPSIS> for example.
217              
218             =head2 is_load_namespaces
219              
220             Returns true if a package is structured in a way that would work for
221             load_namespaces. See L</SYNOPSIS> for example.
222              
223             =head2 is_not_load_namespaces
224              
225             Returns true if a package is structured in a way that would not work for
226             load_namespaces. See L</SYNOPSIS> for example.
227              
228             =head2 assert_similar_namespaces
229              
230             Dies if both packages are structured in the same way. The same means both are
231             load_namespaces or both are not. See L</SYNOPSIS> for example.
232              
233             =head2 normalize_connect_info
234              
235             Takes L<all of the various and interesting
236             forms|DBIx::Class::Storage::DBI/connect_info> that can be passed to connect and
237             normalizes them into the final and simplest form, a single hashref.
238              
239             =head1 AUTHOR
240              
241             Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
242              
243             =head1 COPYRIGHT AND LICENSE
244              
245             This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt.
246              
247             This is free software; you can redistribute it and/or modify it under
248             the same terms as the Perl 5 programming language system itself.
249              
250             =cut