line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
15
|
|
|
15
|
|
448997
|
use strict; |
|
15
|
|
|
|
|
65
|
|
|
15
|
|
|
|
|
557
|
|
2
|
15
|
|
|
15
|
|
79
|
use warnings; |
|
15
|
|
|
|
|
27
|
|
|
15
|
|
|
|
|
780
|
|
3
|
|
|
|
|
|
|
package Querylet; |
4
|
|
|
|
|
|
|
{ |
5
|
|
|
|
|
|
|
$Querylet::VERSION = '0.401'; |
6
|
|
|
|
|
|
|
} |
7
|
15
|
|
|
15
|
|
15766
|
use Filter::Simple; |
|
15
|
|
|
|
|
509295
|
|
|
15
|
|
|
|
|
152
|
|
8
|
|
|
|
|
|
|
# ABSTRACT: simplified queries for the non-programmer |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub init { <<'END_CODE' |
14
|
|
|
|
|
|
|
use strict; |
15
|
|
|
|
|
|
|
use warnings; |
16
|
|
|
|
|
|
|
use Querylet::Query; |
17
|
|
|
|
|
|
|
my $q ||= new Querylet::Query; |
18
|
|
|
|
|
|
|
END_CODE |
19
|
15
|
|
|
15
|
1
|
53
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
14
|
|
|
14
|
1
|
27
|
sub set_dbh { shift; <<"END_CODE" |
23
|
|
|
|
|
|
|
use DBI; |
24
|
|
|
|
|
|
|
my \$dbh = DBI->connect(q|$_[0]|); |
25
|
|
|
|
|
|
|
\$q->set_dbh(\$dbh); |
26
|
|
|
|
|
|
|
END_CODE |
27
|
14
|
|
|
|
|
108
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
14
|
|
|
14
|
1
|
27
|
sub set_query { shift; "\$q->set_query(q{$_[0]});\n"; } |
|
14
|
|
|
|
|
98
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
|
33
|
6
|
|
|
6
|
1
|
11
|
sub bind_next_param { shift; <<"END_CODE" |
34
|
|
|
|
|
|
|
{ |
35
|
|
|
|
|
|
|
my \$input = \$q->{input}; |
36
|
|
|
|
|
|
|
\$q->bind_more($_[0]); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
END_CODE |
39
|
6
|
|
|
|
|
35
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
|
42
|
3
|
|
|
3
|
1
|
4
|
sub set_query_vars { shift; <<"END_CODE" |
43
|
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
|
my \$input = \$q->{input}; |
45
|
|
|
|
|
|
|
\$q->set_query_vars({$_[0]}); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
END_CODE |
48
|
3
|
|
|
|
|
16
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
3
|
|
|
3
|
1
|
5
|
sub set_option { shift; |
52
|
3
|
|
|
|
|
11
|
my ($option, $value) = @_; |
53
|
3
|
|
|
|
|
17
|
$value =~ s/(^\s+|\s+$)//g; |
54
|
3
|
|
|
|
|
21
|
"\$q->option(q{$option}, q{$value});\n" |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
|
58
|
2
|
|
|
2
|
1
|
3
|
sub input { shift; "\$q->input(q{$_[0]});\n"; } |
|
2
|
|
|
|
|
13
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
2
|
|
|
2
|
1
|
4
|
sub set_input_type { shift; "\$q->input_type(q{$_[0]});\n"; } |
|
2
|
|
|
|
|
9
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
5
|
|
|
5
|
1
|
7
|
sub set_output_filename { shift; "\$q->output_filename(q{$_[0]});\n"; } |
|
5
|
|
|
|
|
32
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
0
|
1
|
0
|
sub set_output_method { shift; "\$q->write_type(q{$_[0]});\n"; } |
|
0
|
|
|
|
|
0
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
|
70
|
7
|
|
|
7
|
1
|
10
|
sub set_output_type { shift; "\$q->output_type(q{$_[0]});\n"; } |
|
7
|
|
|
|
|
43
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
5
|
|
|
5
|
1
|
7
|
sub munge_rows { shift; <<"END_CODE"; |
|
5
|
|
|
|
|
40
|
|
74
|
|
|
|
|
|
|
foreach my \$row (\@{\$q->results}) { |
75
|
|
|
|
|
|
|
$_[0] |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
END_CODE |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
1
|
1
|
2
|
sub delete_rows { shift; <<"END_CODE"; |
|
1
|
|
|
|
|
6
|
|
82
|
|
|
|
|
|
|
my \@new_results; |
83
|
|
|
|
|
|
|
for my \$row (\@{\$q->results}) { |
84
|
|
|
|
|
|
|
push \@new_results, \$row unless ($_[0]); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
\$q->set_results([\@new_results]); |
87
|
|
|
|
|
|
|
END_CODE |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
1
|
|
|
1
|
1
|
3
|
sub munge_col { shift; <<"END_CODE"; |
|
1
|
|
|
|
|
14
|
|
92
|
|
|
|
|
|
|
foreach my \$row (\@{\$q->results}) { |
93
|
|
|
|
|
|
|
foreach my \$value (\$row->{$_[0]}) { |
94
|
|
|
|
|
|
|
$_[1] |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
END_CODE |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
7
|
|
|
7
|
1
|
10
|
sub add_col { shift; <<"END_CODE"; |
|
7
|
|
|
|
|
86
|
|
102
|
|
|
|
|
|
|
if (exists \$q->results->[0]->{$_[0]}) { |
103
|
|
|
|
|
|
|
warn "column $_[0] already exists; ignoring directive\n"; |
104
|
|
|
|
|
|
|
} else { |
105
|
|
|
|
|
|
|
push \@{\$q->columns}, '$_[0]'; |
106
|
|
|
|
|
|
|
foreach my \$row (\@{\$q->results}) { |
107
|
|
|
|
|
|
|
for my \$value (\$row->{$_[0]}) { |
108
|
|
|
|
|
|
|
$_[1] |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
END_CODE |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
|
116
|
9
|
|
|
9
|
1
|
11
|
sub delete_col { shift; <<"END_CODE"; |
|
9
|
|
|
|
|
66
|
|
117
|
|
|
|
|
|
|
\$q->set_columns( [ grep { \$_ ne "$_[0]" } \@{\$q->columns} ] ); |
118
|
|
|
|
|
|
|
foreach my \$row (\@{\$q->results}) { |
119
|
|
|
|
|
|
|
delete \$row->{$_[0]}; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
END_CODE |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
|
125
|
1
|
|
|
1
|
1
|
2
|
sub delete_cols { my $class = shift; qq| |
|
1
|
|
|
|
|
4
|
|
126
|
|
|
|
|
|
|
for my \$column (\@{\$q->columns}) { |
127
|
|
|
|
|
|
|
my \@values; |
128
|
|
|
|
|
|
|
push \@values, \$_->{\$column} for \@{\$q->results}; |
129
|
|
|
|
|
|
|
if ($_[0]) { |
130
|
|
|
|
|
|
|
| . $class->delete_col('$column') . qq| |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
| |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
0
|
1
|
0
|
sub column_headers { my $class = shift; "\$q->set_headers({ $_[0] });" } |
|
0
|
|
|
|
|
0
|
|
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
|
141
|
1
|
|
|
1
|
1
|
2
|
sub munge_values { shift; <<"END_CODE"; |
|
1
|
|
|
|
|
7
|
|
142
|
|
|
|
|
|
|
foreach my \$row (\@{\$q->results}) { |
143
|
|
|
|
|
|
|
foreach my \$value (values \%\$row) { |
144
|
|
|
|
|
|
|
$_[0] |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
END_CODE |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
30
|
|
|
30
|
1
|
101
|
sub output { shift; <<'END_CODE' |
152
|
|
|
|
|
|
|
$q->write_output; |
153
|
|
|
|
|
|
|
END_CODE |
154
|
30
|
|
|
|
|
111
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my %ran; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub once { |
160
|
57
|
|
|
57
|
1
|
91
|
my ($id, $text) = @_; |
161
|
57
|
100
|
|
|
|
341
|
return q{} if $ran{$id}++; |
162
|
30
|
|
100
|
|
|
388
|
return $text || ''; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
my $to_next = qr/(?=^\S|\Z)/sm; |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
FILTER { |
168
|
|
|
|
|
|
|
my ($class) = @_; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
s/\r//g; |
171
|
|
|
|
|
|
|
s/\A/"\n" . once('init',init)/egms; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
s/^ database:\s*([^\n]+) |
174
|
|
|
|
|
|
|
/ $class->set_dbh($1) |
175
|
|
|
|
|
|
|
/egmsx; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
s/^ query:\s*(.+?) |
178
|
|
|
|
|
|
|
$to_next |
179
|
|
|
|
|
|
|
/ $class->set_query($1) |
180
|
|
|
|
|
|
|
/egmsx; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
s/^ query\s+parameter:\s*(.+?) |
183
|
|
|
|
|
|
|
$to_next |
184
|
|
|
|
|
|
|
/ $class->bind_next_param($1); |
185
|
|
|
|
|
|
|
/egmsx; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
s/^ munge\s+query:\s*(.+?) |
188
|
|
|
|
|
|
|
$to_next |
189
|
|
|
|
|
|
|
/ $class->set_query_vars($1); |
190
|
|
|
|
|
|
|
/egmsx; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
s/^ set\s+option\s+([\/A-Za-z0-9_]+):\s*(.+?) |
193
|
|
|
|
|
|
|
$to_next |
194
|
|
|
|
|
|
|
/ $class->set_option($1,$2); |
195
|
|
|
|
|
|
|
/egmsx; |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
s/^ input:\s*([^\n]+) |
198
|
|
|
|
|
|
|
/ $class->input($1) |
199
|
|
|
|
|
|
|
/egmsx; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
s/^ input\s+type:\s+(\w+)$ |
202
|
|
|
|
|
|
|
/ $class->set_input_type($1); |
203
|
|
|
|
|
|
|
/egmsx; |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
s/^ munge\s+rows:\s*(.+?) |
206
|
|
|
|
|
|
|
$to_next |
207
|
|
|
|
|
|
|
/ $class->munge_rows($1); |
208
|
|
|
|
|
|
|
/egmsx; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
s/^ delete\s+rows\s+where:\s*(.+?) |
211
|
|
|
|
|
|
|
$to_next |
212
|
|
|
|
|
|
|
/ $class->delete_rows($1); |
213
|
|
|
|
|
|
|
/egmsx; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
s/^ munge\s+all\s+values:\s*(.+?) |
216
|
|
|
|
|
|
|
$to_next |
217
|
|
|
|
|
|
|
/ $class->munge_values($1); |
218
|
|
|
|
|
|
|
/egmsx; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
s/^ munge\s+column\s+(\w+):\s*(.+?) |
221
|
|
|
|
|
|
|
$to_next |
222
|
|
|
|
|
|
|
/ $class->munge_col($1, $2); |
223
|
|
|
|
|
|
|
/egmsx; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
s/^ add\s+column\s+(\w+):\s*(.+?) |
226
|
|
|
|
|
|
|
$to_next |
227
|
|
|
|
|
|
|
/ $class->add_col($1, $2); |
228
|
|
|
|
|
|
|
/egmsx; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
s/^ delete\s+column\s+(\w+)$ |
231
|
|
|
|
|
|
|
/ $class->delete_col($1); |
232
|
|
|
|
|
|
|
/egmsx; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
s/^ delete\s+columns\s+where:\s*(.+?) |
235
|
|
|
|
|
|
|
$to_next |
236
|
|
|
|
|
|
|
/ $class->delete_cols($1); |
237
|
|
|
|
|
|
|
/egmsx; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
s/^ column\s+headers?:\s*(.+?) |
240
|
|
|
|
|
|
|
$to_next |
241
|
|
|
|
|
|
|
/ $class->column_headers($1); |
242
|
|
|
|
|
|
|
/egmsx; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
s/^ output\s+format:\s+(\w+)$ |
245
|
|
|
|
|
|
|
/ $class->set_output_type($1); |
246
|
|
|
|
|
|
|
/egmsx; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
s/^ output\s+method:\s+(\w+)$ |
249
|
|
|
|
|
|
|
/ $class->set_output_method($1); |
250
|
|
|
|
|
|
|
/egmsx; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
s/^ output\s+file:\s+([_.A-Za-z0-9]+)$ |
253
|
|
|
|
|
|
|
/ $class->set_output_filename($1); |
254
|
|
|
|
|
|
|
/egmsx; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
s/^ no\s+output$ |
257
|
|
|
|
|
|
|
/ once('output', q{}) |
258
|
|
|
|
|
|
|
/egmsx; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
s/\Z |
261
|
|
|
|
|
|
|
/once('output',output) |
262
|
|
|
|
|
|
|
/egmsx; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
"I do endeavor to give satisfaction, sir."; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
__END__ |