File Coverage

blib/lib/DDC/PP/CQCount.pm
Criterion Covered Total %
statement 81 120 67.5
branch 4 36 11.1
condition 9 44 20.4
subroutine 32 58 55.1
pod 0 6 0.0
total 126 264 47.7


line stmt bran cond sub pod time code
1             ##-*- Mode: CPerl -*-
2              
3             ##======================================================================
4             ## top-level
5             package DDC::PP::CQCount;
6 20     20   149 use DDC::PP::Constants;
  20         42  
  20         658  
7 20     20   114 use DDC::PP::CQuery;
  20         40  
  20         467  
8 20     20   96 use Carp qw(carp confess);
  20         38  
  20         1094  
9 20     20   119 use strict;
  20         47  
  20         720  
10              
11             ##======================================================================
12             ## CQCountKeyExpr
13             package DDC::PP::CQCountKeyExpr;
14 20     20   114 use strict;
  20         36  
  20         1543  
15             our @ISA = qw(DDC::PP::CQuery);
16              
17 4     4   23 sub CanCountByFile { return 1; }
18              
19             ##======================================================================
20             ## CQCountKeyExprConstant
21             package DDC::PP::CQCountKeyExprConstant;
22 20     20   129 use strict;
  20         40  
  20         4303  
23             our @ISA = qw(DDC::PP::CQCountKeyExpr);
24              
25 2     2   22 sub defaultLabel { return '*'; }
26             sub new {
27 2     2   8 my ($that,$label,%opts) = @_;
28 2   33     20 return $that->SUPER::new(($label||$that->defaultLabel),%opts);
29             }
30              
31 0     0   0 sub toString { return '@'.$_[0]->sqString($_[0]{Label}); }
32              
33             ##======================================================================
34             ## CQCountKeyExprMeta
35             package DDC::PP::CQCountKeyExprMeta;
36 20     20   392 use strict;
  20         57  
  20         1188  
37             our @ISA = qw(DDC::PP::CQCountKeyExpr);
38              
39             ##======================================================================
40             ## CQCountKeyExprFileId
41             package DDC::PP::CQCountKeyExprFileId;
42 20     20   138 use strict;
  20         39  
  20         1184  
43             our @ISA = qw(DDC::PP::CQCountKeyExprMeta);
44              
45 0     0   0 sub defaultLabel { return 'fileid'; }
46              
47             ##======================================================================
48             ## CQCountKeyExprIndexed
49             package DDC::PP::CQCountKeyExprIndexed;
50 20     20   142 use strict;
  20         48  
  20         1607  
51             our @ISA = qw(DDC::PP::CQCountKeyExprMeta);
52              
53 0     0   0 sub defaultLabel { return 'file'; }
54              
55             ##======================================================================
56             ## CQCountKeyExprFileName
57             package DDC::PP::CQCountKeyExprFileName;
58 20     20   127 use strict;
  20         45  
  20         1265  
59             our @ISA = qw(DDC::PP::CQCountKeyExprIndexed);
60              
61 0     0   0 sub defaultLabel { return 'filename'; }
62              
63             ##======================================================================
64             ## CQCountKeyExprDate
65             package DDC::PP::CQCountKeyExprDate;
66 20     20   125 use strict;
  20         49  
  20         1441  
67             our @ISA = qw(DDC::PP::CQCountKeyExprIndexed);
68              
69 0     0   0 sub defaultLabel { return 'date'; }
70              
71             ##======================================================================
72             ## CQCountKeyExprDateSlice
73             package DDC::PP::CQCountKeyExprDateSlice;
74 20     20   133 use strict;
  20         56  
  20         3211  
75             our @ISA = qw(DDC::PP::CQCountKeyExprDate);
76              
77             __PACKAGE__->defprop('Slice');
78             sub new {
79 2     2   8 my ($that,$label,$slice,%opts) = @_;
80 2         22 return $that->SUPER::new($label,Slice=>$slice,%opts); ##-- lower-case 'slice' in DDC, should be ok
81             }
82              
83 0   0 0   0 sub toString { return $_[0]->sqString($_[0]{Label}).'/'.($_[0]{Slice}||1); }
84              
85             ##======================================================================
86             ## CQCountKeyExprBibl
87             package DDC::PP::CQCountKeyExprBibl;
88 20     20   138 use strict;
  20         38  
  20         2974  
89             our @ISA = qw(DDC::PP::CQCountKeyExprIndexed);
90              
91 0     0   0 sub defaultLabel { return ''; }
92             sub new {
93 14     14   45 my ($that,$attr,%opts) = @_;
94 14         95 return $that->SUPER::new($attr,%opts);
95             }
96              
97 0     0   0 sub toString { return $_[0]->sqString($_[0]{Label}); }
98              
99             ##======================================================================
100             ## CQCountKeyExprRegex
101             package DDC::PP::CQCountKeyExprRegex;
102 20     20   143 use strict;
  20         45  
  20         6154  
103             our @ISA = qw(DDC::PP::CQCountKeyExprIndexed);
104              
105             __PACKAGE__->defprop('Src');
106             __PACKAGE__->defprop('Pattern');
107             __PACKAGE__->defprop('Replacement');
108             __PACKAGE__->defprop('Modifiers');
109             __PACKAGE__->defprop('isGlobal');
110 0     0   0 sub defaultLabel { return 'regex'; }
111             sub new {
112 2     2   10 my ($that,$src,$pat,$repl,$mods,%opts) = @_;
113 2         22 return $that->SUPER::new(undef,Src=>$src,Pattern=>$pat,Replacement=>$repl,Modifiers=>$mods,IsGlobal=>0,%opts);
114             }
115              
116 0     0   0 sub Children { [grep {defined($_)} $_[0]{Src}]; }
  0         0  
117              
118 0     0   0 sub Clear { delete $_[0]{Src}; }
119             sub toString {
120 0     0   0 return '(' . $_[0]{Src}->toString . " ~ s/$_[0]{Pattern}/$_[0]{Replacement}/$_[0]{Modifiers})";
121             }
122              
123             ##======================================================================
124             ## CQCountKeyExprToken
125             package DDC::PP::CQCountKeyExprToken;
126 20     20   149 use strict;
  20         40  
  20         5052  
127             our @ISA = qw(DDC::PP::CQCountKeyExprIndexed);
128              
129             __PACKAGE__->defprop('IndexName');
130             __PACKAGE__->defprop('MatchId');
131             __PACKAGE__->defprop('Offset');
132 0     0   0 sub defaultLabel { return 'token'; }
133             sub new {
134 18     18   54 my ($that,$index,$matchid,$offset,%opts) = @_;
135 18   50     183 return $that->SUPER::new(undef,IndexName=>($index||"Token"),MatchId=>($matchid||0),Offset=>($offset||0),%opts);
      100        
      100        
136             }
137              
138 2     2   18 sub CanCountByFile { return 0; }
139             *GetMatchId = \&getMatchId;
140             *SetMatchId = \&setMatchId;
141              
142             sub toString {
143             return ('$'
144             .$_[0]{IndexName}
145             .($_[0]{MatchId} ? sprintf(" =%hhu", $_[0]{MatchId}) : '')
146 0 0   0   0 .($_[0]{Offset} ? sprintf(" %+d", $_[0]{Offset}) : '')
    0          
147             );
148             }
149              
150             ##======================================================================
151             ## CQCountKeyExprList
152             package DDC::PP::CQCountKeyExprList;
153 20     20   166 use strict;
  20         48  
  20         8123  
154             our @ISA = qw(DDC::PP::CQCountKeyExpr);
155              
156             __PACKAGE__->defprop('Exprs');
157 0     0   0 sub defaultLabel { return 'list'; }
158             sub new {
159 32     32   66 my $that = shift;
160 32         142 return $that->SUPER::new(undef,Exprs=>[],@_);
161             }
162              
163              
164 0     0   0 sub Clear { @{$_[0]{Exprs}} = qw(); }
  0         0  
165 0   0 0   0 sub empty { return !$_[0]{Exprs} || !@{$_[0]{Exprs}}; }
166 8     8   21 sub PushKey { push(@{$_[0]{Exprs}},$_[1]); }
  8         50  
167              
168 4 50   4   16 sub CanCountByFile { return !grep {$_ && !$_->CanCountByFile} @{$_[0]{Exprs}||[]}; }
  6 50       80  
  4         18  
169             sub GetMatchId {
170 2     2   4 my ($id);
171 2 50       3 foreach (@{$_[0]{Exprs}||[]}) {
  2         10  
172 2 50 33     12 return $id if ($_ && ($id=$_->GetMatchId));
173             }
174 0         0 return 0;
175             }
176             #sub SetMatchId ##-- not implemented
177              
178 0   0 0   0 sub Children { return $_[0]{Exprs} || []; }
179              
180             sub toString {
181 0 0   0   0 return join(',', map {$_->toString} @{$_[0]{Exprs}||[]});
  0         0  
  0         0  
182             }
183              
184             ##======================================================================
185             ## CQCount
186             package DDC::PP::CQCount;
187 20     20   150 use strict;
  20         57  
  20         10635  
188             our @ISA = qw(DDC::PP::CQuery);
189              
190             __PACKAGE__->defprop('Dtr');
191             __PACKAGE__->defprop('Sample');
192             __PACKAGE__->defprop('Sort');
193             __PACKAGE__->defprop('Lo');
194             __PACKAGE__->defprop('Hi');
195             __PACKAGE__->defprop('Keys');
196             sub new {
197 28     28 0 90 my ($that,$dtr,$keys,$samp,$sort,$lo,$hi,%opts) = @_;
198 28   50     229 return $that->SUPER::new('COUNT',Dtr=>$dtr,Keys=>$keys,Sample=>($samp||-1),Sort=>($sort||DDC::PP::NoSort),Lo=>$lo,Hi=>$hi,%opts);
      33        
199             }
200              
201 0     0 0 0 sub Children { [grep {defined($_)} @{$_[0]}{qw(Dtr Keys)}]; }
  0         0  
  0         0  
202              
203 0     0 0 0 sub Clear { delete @{$_[0]}{qw(Dtr Keys)}; }
  0         0  
204             sub GetMatchId {
205             return (($_[0]{Keys} && $_[0]{Keys}->GetMatchId)
206             || ($_[0]{Dtr} && $_[0]{Dtr}->GetMatchId)
207 2   0 2 0 15 || 0);
208             }
209              
210             sub toString {
211 0     0 0   return "COUNT(" . $_[0]{Dtr}->toString . $_[0]{Dtr}->optionsToString .")". $_[0]->countOptionsToString;
212             }
213             sub countOptionsToString {
214 0     0 0   my $obj = shift;
215             return (
216             ($obj->{Keys} && !$obj->{Keys}->empty ? (" #BY[".$obj->{Keys}->toString."]") : '')
217             .($obj->{Sample} && $obj->{Sample} > 0 ? " #SAMPLE $obj->{Sample}" : '')
218             .($obj->{Sort} != $DDC::PP::HitSortEnum{NoSort}
219             ? (" #".uc($DDC::PP::HitSortEnumStrings[$obj->{Sort}])
220             .($obj->{Lo} || $obj->{Hi}
221             ? ("[".($obj->{Lo} ? $obj->sqString($obj->{Lo}) : '')
222 0 0 0       .",".($obj->{Hi} ? $obj->sqString($obj->{Hi}) : '')
    0 0        
    0 0        
    0          
    0          
    0          
223             ."]")
224             : '')
225             )
226             : '')
227             );
228             }
229              
230             ##======================================================================
231             ## CQKeys
232             package DDC::PP::CQKeys;
233 20     20   163 use strict;
  20         765  
  20         7701  
234             our @ISA = qw(DDC::PP::CQuery);
235              
236             __PACKAGE__->defprop('QCount');
237             __PACKAGE__->defprop('CountLimit');
238             __PACKAGE__->defprop('IndexNames');
239             __PACKAGE__->defprop('MatchId');
240             sub new {
241 0     0     my ($that,$qcount,$climit,$ixnames,%opts) = @_;
242 0   0       return $that->SUPER::new('KEYS',QCount=>$qcount,CountLimit=>($climit||-1),IndexNames=>($ixnames||[]),%opts);
      0        
243             }
244              
245             sub GetMatchId {
246             return ($_[0]{MatchId}
247             || ($_[0]{QCount} && $_[0]{QCount}->GetMatchId)
248 0   0 0     || 0);
249             }
250             *SetMatchId = \&setMatchId;
251              
252             sub toString {
253 0     0     my $obj = shift;
254             return (
255             ($obj->{IndexNames} && @{$obj->{IndexNames}}
256 0           ? ('$('.join(',', map {$obj->sqString($_)} @{$obj->{IndexNames}}).')=')
  0            
257             : '')
258             .'KEYS('
259             .($obj->{QCount}
260             ? (($obj->{QCount}{Dtr} ? ($obj->{QCount}{Dtr}->toString.$obj->{QCount}{Dtr}->optionsToString) : '')
261             .$obj->{QCount}->countOptionsToString)
262             : '')
263             .($obj->{CountLimit} > 0 ? " #CLIMIT $obj->{CountLimit}" : '')
264             .')'
265 0 0 0       .($obj->{MatchId} ? " =$obj->{MatchId}" : '')
    0          
    0          
    0          
    0          
266             );
267             }
268              
269              
270              
271             1; ##-- be happy
272              
273             =pod
274              
275             =head1 NAME
276              
277             DDC::PP::CQCount - pure-perl implementation of DDC::XS::CQCount
278              
279             =head1 SYNOPSIS
280              
281             use DDC::PP::CQCount;
282             #... stuff happens ...
283              
284              
285             =head1 DESCRIPTION
286              
287             The DDC::PP::CQCount class is a pure-perl fork of the L class,
288             which see for details.
289              
290             =head1 SEE ALSO
291              
292             perl(1),
293             DDC::PP(3perl),
294             DDC::XS::CQCount(3perl).
295              
296             =head1 AUTHOR
297              
298             Bryan Jurish Emoocow@cpan.orgE
299              
300             =head1 COPYRIGHT AND LICENSE
301              
302             Copyright (C) 2016 by Bryan Jurish
303              
304             This library is free software; you can redistribute it and/or modify
305             it under the same terms as Perl itself, either Perl version 5.14.2 or,
306             at your option, any later version of Perl 5 you may have available.
307              
308             =cut
309