File Coverage

blib/lib/Querylet/Query.pm
Criterion Covered Total %
statement 137 148 92.5
branch 46 50 92.0
condition 3 4 75.0
subroutine 33 35 94.2
pod 32 32 100.0
total 251 269 93.3


line stmt bran cond sub pod time code
1 18     18   75689 use strict;
  18         37  
  18         571  
2 18     18   86 use warnings;
  18         31  
  18         866  
3             package Querylet::Query;
4             {
5             $Querylet::Query::VERSION = '0.401';
6             }
7             # ABSTRACT: renders and performs queries for Querylet
8              
9             ## no critic RequireCarping
10              
11 18     18   158 use Carp ();
  18         39  
  18         35478  
12              
13              
14             sub new {
15 16     16 1 233304 bless {
16             bind_parameters => [],
17             output_type => 'csv',
18             input_type => 'term'
19             } => (shift);
20             }
21              
22              
23             sub set_dbh {
24 14     14 1 34655 my $self = shift;
25 14         38 my $dbh = shift;
26 14         90 $self->{dbh} = $dbh;
27             }
28              
29              
30             sub set_query {
31 14     14 1 79 my ($self, $sql) = @_;
32              
33 14         65 $self->{query} = $sql;
34             }
35              
36              
37             sub bind { ## no critic Homonym
38 1     1 1 7 my ($self, @parameters) = @_;
39 1         8 $self->{bind_parameters} = [ @parameters ];
40             }
41              
42              
43             sub bind_more {
44 7     7 1 1108 my ($self, @parameters) = @_;
45 7         15 push @{$self->{bind_parameters}}, @parameters;
  7         33  
46             }
47              
48              
49             sub set_query_vars {
50 3     3 1 22 my ($self, $vars) = @_;
51              
52 3   100     16 $self->{query_vars} ||= {};
53 3         4 $self->{query_vars} = { %{$self->{query_vars}}, %$vars };
  3         14  
54             }
55              
56              
57             sub render_query {
58 1     1 1 2 my $self = shift;
59 1         1 my $rendered_query;
60              
61 1         7 require Template;
62 1         8 my $tt = new Template;
63 1         23721 $tt->process(\($self->{query}), $self->{query_vars}, \$rendered_query);
64              
65 1         32066 return $rendered_query;
66             }
67              
68              
69             sub run {
70 14     14 1 29 my $self = shift;
71              
72 14 100       69 $self->{query} = $self->render_query if $self->{query_vars};
73              
74 14         242 my $sth = $self->{dbh}->prepare($self->{query});
75 14         5571 $sth->execute(@{$self->{bind_parameters}});
  14         12315  
76              
77 14         374 $self->{columns} = $sth->{NAME};
78              
79 14         247 $self->{results} = $sth->fetchall_arrayref({});
80             }
81              
82              
83             sub results {
84 56     56 1 18111 my $self = shift;
85 56 100       371 return $self->{results} if $self->{results};
86 5         24 $self->run;
87             }
88              
89              
90             sub set_results {
91 1     1 1 1820 my $self = shift;
92 1         4 $self->{results} = shift;
93             }
94              
95              
96             sub columns {
97 4022     4022 1 593218 my $self = shift;
98 4022 100       16635 return $self->{columns} if $self->{columns};
99 9         39 $self->run;
100 9         14725 return $self->{columns};
101             }
102              
103              
104             sub set_columns {
105 8     8 1 90 my $self = shift;
106 8         30 $self->{columns} = shift;
107             }
108              
109              
110             sub header {
111 10     10 1 2759 my $self = shift;
112 10         18 my $column = shift;
113 10 50       62 return exists $self->{headers}{$column}
114             ? $self->{headers}{$column}
115             : $column;
116             }
117              
118              
119             sub set_headers {
120 0     0 1 0 my $self = shift;
121 0         0 my $headers = shift;
122 0         0 while (my ($column, $header) = each %$headers) {
123 0         0 $self->{headers}{$column} = $header;
124             }
125             }
126              
127              
128             sub option {
129 5     5 1 21 my ($self, $option_name) = @_;
130 5 100       23 return $self->scratchpad->{$option_name} unless @_ > 2;
131 3         16 return $self->scratchpad->{$option_name} = $_[2];
132             }
133              
134              
135             sub scratchpad {
136 7     7 1 13 my $self = shift;
137 7 100       25 $self->{scratchpad} = {} unless $self->{scratchpad};
138 7         31 return $self->{scratchpad};
139             }
140              
141              
142             my %input_handler;
143              
144             sub input_type {
145 17     17 1 28 my $self = shift;
146 17 100       297 return $self->{input_type} unless @_;
147 4         33 return $self->{input_type} = shift;
148             }
149              
150              
151             sub input {
152 6     6 1 22 my ($self, $parameter) = @_;
153              
154 6 100       22 $self->{input} = {} unless $self->{input};
155 6 100       23 return $self->{input}->{$parameter} if exists $self->{input}->{$parameter};
156              
157 5 100       15 unless ($input_handler{$self->input_type}) {
158 3         6 warn "unknown input type: ", $self->input_type," \n";
159 3         22 return;
160             } else {
161 2         8 $input_handler{$self->input_type}->($self, $parameter);
162             }
163             }
164              
165              
166             sub register_input_handler {
167 21     21 1 63830 shift;
168 21         44 my ($type, $handler) = @_;
169 21         65 $input_handler{$type} = $handler;
170             }
171              
172              
173             sub output_filename {
174 19     19 1 14681 my $self = shift;
175 19 100       526 return $self->{output_filename} unless @_;
176              
177 7         16 my $filename = shift;
178              
179 7 100       46 $self->write_type($filename ? 'file' : undef);
180 7         26 return $self->{output_filename} = $filename;
181             }
182              
183              
184             my %write_handler;
185              
186             sub write_type {
187 22     22 1 42 my $self = shift;
188 22 100       124 return $self->{write_type} unless @_;
189 8         29 return $self->{write_type} = shift;
190             }
191              
192              
193             my %output_handler;
194              
195             sub output_type {
196 30     30 1 108 my $self = shift;
197 30 100       198 return $self->{output_type} unless @_;
198 9         36 return $self->{output_type} = shift;
199             }
200              
201              
202             sub output {
203 17     17 1 6614 my $self = shift;
204              
205 17 100       9230 return $self->{output} if exists $self->{output};
206              
207 9 100       32 unless ($output_handler{$self->output_type}) {
208 1         3 warn "unknown output type: ", $self->output_type," \n";
209 1         8 return;
210             } else {
211 8         28 $self->{output} = $output_handler{$self->output_type}->($self);
212 8 100       369 unless ($self->{output}) {
213 1         92 warn "no output received from output handler!\n";
214 1         9 return;
215             }
216 7         45 return $self->{output};
217             }
218             }
219              
220              
221             sub write { ## no critic Homonym
222 4     4 1 8 my ($self) = @_;
223              
224 4 100       16 $self->write_type('stdout') unless $self->write_type;
225              
226 4 50       12 unless ($write_handler{$self->write_type}) {
227 0         0 warn "unknown write type: ", $self->write_type," \n";
228 0         0 return;
229             } else {
230 4         11 $write_handler{$self->write_type}->($self);
231             }
232             }
233              
234              
235             sub write_output {
236 6     6 1 2544 my ($self) = @_;
237 6         20 my $output = $self->output;
238              
239 6 100       23 if (ref $output eq 'CODE') {
240 2 50       6 warn "using coderef output, but write_type set\n" if $self->write_type;
241 2         6 $output->($self->output_filename);
242             } else {
243 4         19 $self->write($self);
244             }
245             }
246              
247              
248             sub register_output_handler {
249 58     58 1 118 shift;
250 58         90 my ($type, $handler) = @_;
251 58         152 $output_handler{$type} = $handler;
252             }
253              
254              
255             __PACKAGE__->register_output_handler(csv => \&as_csv);
256             sub as_csv {
257 4     4 1 10 my $q = shift;
258 4         7 my $csv;
259 4         23 my $results = $q->results;
260 4         29 my $columns = $q->columns;
261 4         15 $csv = join(q{,}, map { $q->header($_) } @$columns) . "\n";
  9         29  
262 4         10 foreach my $row (@$results) {
263 18000 100       28946 $csv .= join(q{,},
264 8000         13872 map { (my $v = defined $_ ? $_ : q{}) =~ s/"/\\"/g; qq!"$v"! }
  18000         35742  
265             @$row{@$columns}
266             )
267             . "\n";
268             }
269              
270 4         156 return $csv;
271             }
272              
273              
274             __PACKAGE__->register_output_handler(template => \&as_template);
275             __PACKAGE__->register_output_handler(html => \&as_template);
276             sub as_template {
277 2     2 1 4 my $query = shift;
278 2         3 my $output;
279 2         8 my $template = $query->option('template_file');
280 2 100       12 unless ($template) {
281 1         2 $template = \(<<'END')
282            
283            
284             results of query
285            
286            
287             [% FOREACH column = query.columns -%][%- END %][% END %]
288            
289             [% FOREACH column = query.columns %]
290             [% query.header(column) %]
291             [% END %]
292            
293             [% FOREACH row = query.results %]
294            
[%- row.$column -%]
295            
296            
297            
298             END
299             }
300              
301 2         17 require Template;
302 2         23 my $tt = new Template({ RELATIVE => 1});
303 2         51291 $tt->process($template, { query => $query }, \$output);
304 2         1238 return $output;
305             }
306              
307              
308             sub register_write_handler {
309 36     36 1 55 shift;
310 36         65 my ($type, $handler) = @_;
311 36         112 $write_handler{$type} = $handler;
312             }
313              
314              
315             __PACKAGE__->register_write_handler(file => \&to_file);
316             sub to_file {
317 3     3 1 7 my ($query) = @_;
318              
319 3 50       13 if ($query->output_filename) {
320 3 100       36 if (open(my $output_file, '>', $query->output_filename)) {
321 2         7 binmode $output_file;
322 2         8 print $output_file $query->output;
323 2         943 close $output_file;
324             } else {
325 1         5 warn "can't open " . $query->output_filename . " for output\n";
326 1         11 return;
327             }
328             }
329             }
330              
331              
332             __PACKAGE__->register_write_handler(stdout => \&to_stdout);
333             sub to_stdout {
334 1     1 1 2 my ($query) = @_;
335 1   50     4 print $query->output || '';
336             }
337              
338              
339             __PACKAGE__->register_input_handler(term => \&from_term);
340             sub from_term {
341 0     0 1   my ($q, $parameter) = @_;
342              
343 0           print "enter $parameter: ";
344 0           my $value = ;
345 0           chomp $value;
346 0           $q->{input}->{$parameter} = $value;
347             }
348              
349              
350             "I do endeavor to give satisfaction, sir.";
351              
352             __END__