File Coverage

blib/lib/DBIx/Class/Helper/ResultSet/Shortcut/ResultsExist.pm
Criterion Covered Total %
statement 18 18 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 25 27 92.5


line stmt bran cond sub pod time code
1             package DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist;
2             $DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist::VERSION = '2.036000';
3 57     57   25990 use strict;
  57         138  
  57         1500  
4 57     57   289 use warnings;
  57         120  
  57         1383  
5              
6 57     57   286 use parent 'DBIx::Class::ResultSet';
  57         138  
  57         292  
7              
8             sub results_exist_as_query {
9 6     6 0 102 my ($self, $cond) = @_;
10              
11              
12 6         27 my $reified = $self->search_rs( $cond, {
13             columns => { _results_existence_check => \ '42' }
14             } )->as_query;
15              
16              
17 6         7159 $$reified->[0] = "( SELECT EXISTS $$reified->[0] )";
18              
19              
20 6         166 $reified;
21             }
22              
23              
24             sub results_exist {
25 4     4 0 86 my ($self, $cond) = @_;
26              
27 4         22 my $query = $self->results_exist_as_query($cond);
28 4         13 $$query->[0] .= ' AS _existence_subq';
29              
30 4         21 my( undef, $sth ) = $self->result_source
31             ->schema
32             ->storage
33             ->_select(
34             $query,
35             \'*',
36             {},
37             {},
38             );
39              
40 4 100       3663 $sth->fetchall_arrayref->[0][0] ? 1 : 0;
41             }
42              
43             1;
44              
45             __END__
46              
47             =pod
48              
49             =head1 NAME
50              
51             DBIx::Class::Helper::ResultSet::Shortcut::ResultsExist
52              
53             =head1 AUTHOR
54              
55             Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
56              
57             =head1 COPYRIGHT AND LICENSE
58              
59             This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt.
60              
61             This is free software; you can redistribute it and/or modify it under
62             the same terms as the Perl 5 programming language system itself.
63              
64             =cut