line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CGI::OptimalQuery::Base; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
756
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
5
|
1
|
|
|
1
|
|
4
|
no warnings qw( uninitialized ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
6
|
1
|
|
|
1
|
|
766
|
use CGI(); |
|
1
|
|
|
|
|
20763
|
|
|
1
|
|
|
|
|
24
|
|
7
|
1
|
|
|
1
|
|
7
|
use Carp('confess'); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
44
|
|
8
|
1
|
|
|
1
|
|
504
|
use POSIX(); |
|
1
|
|
|
|
|
4233
|
|
|
1
|
|
|
|
|
21
|
|
9
|
1
|
|
|
1
|
|
6
|
use DBIx::OptimalQuery; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
16
|
|
10
|
1
|
|
|
1
|
|
575
|
use JSON::XS; |
|
1
|
|
|
|
|
3544
|
|
|
1
|
|
|
|
|
46
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# some tools that OQ auto activates |
13
|
1
|
|
|
1
|
|
317
|
use CGI::OptimalQuery::ExportDataTool(); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
14
|
|
14
|
1
|
|
|
1
|
|
375
|
use CGI::OptimalQuery::SaveSearchTool(); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
19
|
|
15
|
1
|
|
|
1
|
|
313
|
use CGI::OptimalQuery::LoadSearchTool(); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2412
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub escapeHTML { |
18
|
0
|
0
|
|
0
|
0
|
|
return defined $_[0] ? CGI::escapeHTML($_[0]) : ''; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
0
|
|
|
0
|
0
|
|
sub can_embed { 0 } |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# alias for output |
24
|
|
|
|
|
|
|
sub print { |
25
|
0
|
|
|
0
|
0
|
|
my $o = shift; |
26
|
0
|
|
|
|
|
|
$o->output(@_); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub new { |
30
|
0
|
|
|
0
|
0
|
|
my $pack = shift; |
31
|
0
|
|
|
|
|
|
my $schema = shift; |
32
|
0
|
0
|
|
|
|
|
die "could not find schema!" unless ref($schema) eq 'HASH'; |
33
|
|
|
|
|
|
|
|
34
|
0
|
|
|
|
|
|
my $o = bless {}, $pack; |
35
|
|
|
|
|
|
|
|
36
|
0
|
|
|
|
|
|
$$o{schema} = clone($schema); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
$$o{dbh} = $$o{schema}{dbh} |
39
|
0
|
0
|
|
|
|
|
or confess "couldn't find dbh in schema!"; |
40
|
|
|
|
|
|
|
$$o{q} = $$o{schema}{q} |
41
|
0
|
0
|
|
|
|
|
or confess "couldn't find q in schema!"; |
42
|
0
|
|
|
|
|
|
$$o{output_handler} = $$o{schema}{output_handler}; |
43
|
0
|
|
|
|
|
|
$$o{error_handler} = $$o{schema}{error_handler}; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# check for required attributes |
46
|
|
|
|
|
|
|
confess "specified select is not a hash ref!" |
47
|
0
|
0
|
|
|
|
|
unless ref $$o{schema}{select} eq "HASH"; |
48
|
|
|
|
|
|
|
confess "specified joins is not a hash ref!" |
49
|
0
|
0
|
|
|
|
|
unless ref $$o{schema}{joins} eq "HASH"; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# set defaults |
52
|
0
|
|
0
|
|
|
|
$$o{schema}{debug} ||= 0; |
53
|
|
|
|
|
|
|
$$o{schema}{check} = $ENV{'CGI-OPTIMALQUERY_CHECK'} |
54
|
0
|
0
|
|
|
|
|
if ! defined $$o{schema}{check}; |
55
|
0
|
0
|
|
|
|
|
$$o{schema}{check} = 0 if ! defined $$o{schema}{check}; |
56
|
0
|
|
0
|
|
|
|
$$o{schema}{title} ||= ""; |
57
|
0
|
|
0
|
|
|
|
$$o{schema}{options} ||= {}; |
58
|
0
|
|
0
|
|
|
|
$$o{schema}{resourceURI} ||= $ENV{OPTIMALQUERY_RESOURCES} || '/OptimalQuery'; |
|
|
|
0
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
if (! $$o{schema}{URI}) { |
61
|
0
|
0
|
|
|
|
|
$_ = ($$o{q}->can('uri')) ? $$o{q}->uri() : $ENV{REQUEST_URI}; s/\?.*$//; |
|
0
|
|
|
|
|
|
|
62
|
0
|
|
|
|
|
|
$$o{schema}{URI} = $_; |
63
|
|
|
|
|
|
|
# disabled so we can run from command line for testing where REQUEST_URI probably isn't defined |
64
|
|
|
|
|
|
|
# or die "could not find 'URI' in schema"; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
0
|
|
|
|
$$o{schema}{URI_standalone} ||= $$o{schema}{URI}; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# make sure developer is not using illegal state_params |
70
|
0
|
0
|
|
|
|
|
if (ref($$o{schema}{state_params}) eq 'ARRAY') { |
71
|
0
|
|
|
|
|
|
foreach my $p (@{ $$o{schema}{state_params} }) { |
|
0
|
|
|
|
|
|
|
72
|
0
|
0
|
|
|
|
|
die "cannot use reserved state param name: act" if $p eq 'act'; |
73
|
0
|
0
|
|
|
|
|
die "cannot use reserved state param name: module" if $p eq 'module'; |
74
|
0
|
0
|
|
|
|
|
die "cannot use reserved state param name: view" if $p eq 'view'; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# construct optimal query object |
79
|
|
|
|
|
|
|
$$o{oq} = DBIx::OptimalQuery->new( |
80
|
|
|
|
|
|
|
'dbh' => $$o{schema}{dbh}, |
81
|
|
|
|
|
|
|
'select' => $$o{schema}{select}, |
82
|
|
|
|
|
|
|
'joins' => $$o{schema}{joins}, |
83
|
|
|
|
|
|
|
'named_filters' => $$o{schema}{named_filters}, |
84
|
|
|
|
|
|
|
'named_sorts' => $$o{schema}{named_sorts}, |
85
|
|
|
|
|
|
|
'debug' => $$o{schema}{debug}, |
86
|
|
|
|
|
|
|
'error_handler' => $$o{schema}{error_handler} |
87
|
0
|
|
|
|
|
|
); |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# the following code is responsible for setting the disable_sort flag for all |
90
|
|
|
|
|
|
|
# multi valued selects (since it never makes since to sort a m-valued column) |
91
|
0
|
|
|
|
|
|
my %cached_dep_multival_status; |
92
|
|
|
|
|
|
|
my $find_dep_multival_status_i; |
93
|
0
|
|
|
|
|
|
my $find_dep_multival_status; |
94
|
|
|
|
|
|
|
$find_dep_multival_status = sub { |
95
|
0
|
|
|
0
|
|
|
my $joinAlias = shift; |
96
|
0
|
|
|
|
|
|
$find_dep_multival_status_i++; |
97
|
0
|
0
|
|
|
|
|
die "could not resolve join alias: $joinAlias deps" if $find_dep_multival_status_i > 100; |
98
|
0
|
0
|
|
|
|
|
if (! exists $cached_dep_multival_status{$joinAlias}) { |
99
|
0
|
|
|
|
|
|
my $v; |
100
|
0
|
0
|
|
|
|
|
if (exists $$o{oq}{joins}{$joinAlias}[3]{new_cursor}) { $v = 0; } |
|
0
|
0
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
elsif (! @{ $$o{oq}{joins}{$joinAlias}[0] }) { $v = 1; } |
|
0
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
else { $v = $find_dep_multival_status->($$o{oq}{joins}{$joinAlias}[0][0]); } |
103
|
0
|
|
|
|
|
|
$cached_dep_multival_status{$joinAlias} = $v; |
104
|
|
|
|
|
|
|
} |
105
|
0
|
|
|
|
|
|
return $cached_dep_multival_status{$joinAlias}; |
106
|
0
|
|
|
|
|
|
}; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# loop though all selects |
109
|
0
|
|
|
|
|
|
foreach my $selectAlias (keys %{ $$o{oq}{select} }) { |
|
0
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
$find_dep_multival_status_i = 0; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# set the disable sort flag is select is a multi value |
113
|
|
|
|
|
|
|
$$o{oq}{select}{$selectAlias}[3]{disable_sort} = 1 |
114
|
0
|
0
|
|
|
|
|
if ! $find_dep_multival_status->($$o{oq}{select}{$selectAlias}[0][0]); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# set is_hidden flag if select does not have a nice name assigned |
117
|
|
|
|
|
|
|
$$o{oq}{select}{$selectAlias}[3]{is_hidden} = 1 |
118
|
0
|
0
|
|
|
|
|
if ! $$o{oq}{select}{$selectAlias}[2]; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# if no SQL (could be a recview) then disable sort, filter |
121
|
0
|
0
|
|
|
|
|
if (! $$o{oq}{select}{$selectAlias}[1]) { |
122
|
0
|
|
|
|
|
|
$$o{oq}{select}{$selectAlias}[3]{disable_sort} = 1; |
123
|
0
|
|
|
|
|
|
$$o{oq}{select}{$selectAlias}[3]{disable_filter} = 1; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# if a select column has additional select fields specified in options, make sure that the options array is an array |
127
|
0
|
0
|
0
|
|
|
|
if ($$o{oq}{select}{$selectAlias}[3]{select} && ref($$o{oq}{select}{$selectAlias}[3]{select}) ne 'ARRAY') { |
128
|
0
|
|
|
|
|
|
my @x = split /\ *\,\ */, $$o{oq}{select}{$selectAlias}[3]{select}; |
129
|
0
|
|
|
|
|
|
$$o{oq}{select}{$selectAlias}[3]{select} = \@x; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# if any fields are passed into on_select, ensure they are always selected |
134
|
0
|
|
|
|
|
|
my $on_select = $$o{q}->param('on_select'); |
135
|
0
|
0
|
|
|
|
|
if ($on_select =~ /[^\,]+\,(.+)/) { |
136
|
0
|
|
|
|
|
|
my @fields = split /\,/, $1; |
137
|
0
|
|
|
|
|
|
for (@fields) { |
138
|
|
|
|
|
|
|
$$o{oq}{'select'}{$_}[3]{always_select}=1 |
139
|
0
|
0
|
|
|
|
|
if exists $$o{oq}{'select'}{$_}; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# check schema validity |
144
|
0
|
0
|
0
|
|
|
|
$$o{oq}->check_join_counts() if $$o{schema}{check} && ! defined $$o{q}->param('module'); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# install the export tool |
147
|
0
|
|
|
|
|
|
CGI::OptimalQuery::ExportDataTool::activate($o); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# if savedSearchUserID enable savereport and loadreport tools |
150
|
0
|
|
0
|
|
|
|
$$o{schema}{savedSearchUserID} ||= undef; |
151
|
0
|
0
|
|
|
|
|
if ($$o{schema}{savedSearchUserID} =~ /^\d+$/) { |
152
|
0
|
|
|
|
|
|
CGI::OptimalQuery::LoadSearchTool::activate($o); |
153
|
0
|
|
|
|
|
|
CGI::OptimalQuery::SaveSearchTool::activate($o); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# run on_init function for each enabled tool |
157
|
0
|
|
|
|
|
|
foreach my $v (values %{ $$o{schema}{tools} }) { |
|
0
|
|
|
|
|
|
|
158
|
0
|
0
|
|
|
|
|
$$v{on_init}->($o) if ref($$v{on_init}) eq 'CODE'; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# if schema params exist |
162
|
0
|
0
|
|
|
|
|
if (ref($$o{schema}{params}) eq 'HASH') { |
163
|
0
|
|
|
|
|
|
foreach my $k (qw( page rows_page show filter hiddenFilter queryDescr sort mode )) { |
164
|
0
|
0
|
|
|
|
|
$$o{$k} = $$o{schema}{params}{$k} if exists $$o{schema}{params}{$k}; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# else use CGI params |
169
|
|
|
|
|
|
|
else { |
170
|
0
|
|
|
|
|
|
foreach my $k (qw( page rows_page show filter hiddenFilter queryDescr sort mode )) { |
171
|
0
|
0
|
|
|
|
|
next unless defined $$o{q}->param($k); |
172
|
0
|
|
|
|
|
|
$$o{$k} = $$o{q}->param($k); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# use schema defaults when no user defaults are available |
177
|
0
|
|
|
|
|
|
foreach my $k (qw( show filter hiddenFilter queryDescr sort mode)) { |
178
|
0
|
0
|
|
|
|
|
$$o{$k} = $$o{schema}{$k} unless defined $$o{$k}; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
0
|
|
|
|
$$o{mode} ||= 'default'; |
182
|
0
|
|
|
|
|
|
$$o{mode} =~ s/\W//g; |
183
|
|
|
|
|
|
|
|
184
|
0
|
|
0
|
|
|
|
$$o{schema}{results_per_page_picker_nums} ||= [25,50,100,500,1000,'All']; |
185
|
0
|
|
0
|
|
|
|
$$o{rows_page} ||= $$o{schema}{rows_page} || $$o{schema}{results_per_page_picker_nums}[0] || 10; |
|
|
|
0
|
|
|
|
|
186
|
0
|
|
0
|
|
|
|
$$o{page} ||= 1; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# convert show into array |
189
|
0
|
0
|
|
|
|
|
if (! ref($$o{show})) { |
190
|
0
|
|
|
|
|
|
my @ar = split /\,/, $$o{show}; |
191
|
0
|
|
|
|
|
|
$$o{show} = \@ar; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# if we still don't have something to show then show all cols |
195
|
|
|
|
|
|
|
# that aren't hidden |
196
|
0
|
0
|
|
|
|
|
if (! scalar( @{ $$o{show} } )) { |
|
0
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
for (keys %{ $$o{schema}{select} }) { |
|
0
|
|
|
|
|
|
|
198
|
0
|
0
|
|
|
|
|
push @{$$o{show}}, $_ unless $$o{oq}->{'select'}->{$_}->[3]->{is_hidden}; |
|
0
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
|
|
|
return $o; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
0
|
0
|
|
sub oq { $_[0]{oq} } |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# ----------- UTILITY METHODS ------------------------------------------------ |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
0
|
0
|
|
sub escape_html { escapeHTML($_[1]) } |
210
|
0
|
|
|
0
|
0
|
|
sub escape_uri { CGI::escape($_[1]) } |
211
|
|
|
|
|
|
|
sub escape_js { |
212
|
0
|
|
|
0
|
0
|
|
my $o = shift; |
213
|
0
|
|
|
|
|
|
$_ = shift; |
214
|
0
|
|
|
|
|
|
s/\\/\\x5C/g; #escape \ |
215
|
0
|
|
|
|
|
|
s/\n/\\x0A/g; #escape new lines |
216
|
0
|
|
|
|
|
|
s/\'/\\x27/g; #escape ' |
217
|
0
|
|
|
|
|
|
s/\"/\\x22/g; #escape " |
218
|
0
|
|
|
|
|
|
s/\&/\\x26/g; #escape & |
219
|
0
|
|
|
|
|
|
s/\r//g; #remove carriage returns |
220
|
0
|
|
|
|
|
|
s/script/scr\\x69pt/ig; # make nice script tags |
221
|
0
|
|
|
|
|
|
return $_; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
sub commify { |
224
|
0
|
|
|
0
|
0
|
|
my $o = shift; |
225
|
0
|
|
|
|
|
|
my $text = reverse $_[0]; |
226
|
0
|
|
|
|
|
|
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; |
227
|
0
|
|
|
|
|
|
return scalar reverse $text; |
228
|
|
|
|
|
|
|
} # Commify |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
my %no_clone = ('dbh' => 1, 'q' => 1); |
232
|
|
|
|
|
|
|
sub clone { |
233
|
0
|
|
|
0
|
0
|
|
my $thing = shift; |
234
|
0
|
0
|
|
|
|
|
if (ref($thing) eq 'HASH') { |
|
|
0
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
my %tmp; |
236
|
0
|
|
|
|
|
|
while (my ($k,$v) = each %$thing) { |
237
|
0
|
0
|
|
|
|
|
if (exists $no_clone{$k}) { $tmp{$k} = $v; } |
|
0
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
else { $tmp{$k} = clone($v); } |
239
|
|
|
|
|
|
|
} |
240
|
0
|
|
|
|
|
|
$thing = \%tmp; |
241
|
|
|
|
|
|
|
} elsif (ref($thing) eq 'ARRAY') { |
242
|
0
|
|
|
|
|
|
my @tmp; |
243
|
0
|
|
|
|
|
|
foreach my $v (@$thing) { push @tmp, clone($v); } |
|
0
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
$thing = \@tmp; |
245
|
|
|
|
|
|
|
} |
246
|
0
|
|
|
|
|
|
return $thing; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
#-------------- ACCESSORS -------------------------------------------------- |
252
|
|
|
|
|
|
|
sub sth { |
253
|
0
|
|
|
0
|
0
|
|
my ($o) = @_; |
254
|
0
|
0
|
|
|
|
|
return $$o{sth} if $$o{sth}; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# show is made up of all the fields that should be selected |
257
|
0
|
|
|
|
|
|
my @show; { |
258
|
0
|
|
|
|
|
|
my %show; |
|
0
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
foreach my $colalias (@{$$o{show}}) { |
|
0
|
|
|
|
|
|
|
260
|
0
|
0
|
|
|
|
|
if (ref($$o{schema}{select}{$colalias}[3]{select}) eq 'ARRAY') { |
261
|
0
|
|
|
|
|
|
$show{$_}=1 for @{ $$o{schema}{select}{$colalias}[3]{select} }; |
|
0
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
} |
263
|
0
|
0
|
|
|
|
|
if ($$o{schema}{select}{$colalias}[1]) { |
264
|
0
|
|
|
|
|
|
$show{$colalias}=1; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
0
|
|
|
|
|
|
@show = sort keys %show; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# create & execute SQL statement |
271
|
|
|
|
|
|
|
$$o{sth} = $$o{oq}->prepare( |
272
|
|
|
|
|
|
|
show => \@show, |
273
|
|
|
|
|
|
|
filter => $$o{filter}, |
274
|
|
|
|
|
|
|
hiddenFilter => $$o{hiddenFilter}, |
275
|
|
|
|
|
|
|
forceFilter => $$o{schema}{forceFilter}, |
276
|
0
|
|
|
|
|
|
sort => $$o{sort} ); |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
# current fetched row |
279
|
0
|
|
|
|
|
|
$$o{rec} = undef; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# calculate what the limit is |
282
|
|
|
|
|
|
|
# and make sure page, num_pages, rows_page make sense |
283
|
0
|
0
|
0
|
|
|
|
if ($$o{sth}->count() == 0) { |
|
|
0
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
$$o{page} = 0; |
285
|
0
|
|
|
|
|
|
$$o{rows_page} = 0; |
286
|
0
|
|
|
|
|
|
$$o{num_pages} = 0; |
287
|
0
|
|
|
|
|
|
$$o{limit} = [0,0]; |
288
|
|
|
|
|
|
|
} elsif ($$o{rows_page} eq 'All' || ($$o{sth}->count() < $$o{rows_page})) { |
289
|
0
|
|
|
|
|
|
$$o{rows_page} = "All"; |
290
|
0
|
|
|
|
|
|
$$o{page} = 1; |
291
|
0
|
|
|
|
|
|
$$o{num_pages} = 1; |
292
|
0
|
|
|
|
|
|
$$o{limit} = [1, $$o{sth}->count()]; |
293
|
|
|
|
|
|
|
} else { |
294
|
0
|
|
|
|
|
|
$$o{num_pages} = POSIX::ceil($$o{sth}->count() / $$o{rows_page}); |
295
|
0
|
0
|
|
|
|
|
$$o{page} = $$o{num_pages} if $$o{page} > $$o{num_pages}; |
296
|
0
|
|
|
|
|
|
my $lo = ($$o{rows_page} * $$o{page}) - $$o{rows_page} + 1; |
297
|
0
|
|
|
|
|
|
my $hi = $lo + $$o{rows_page} - 1; |
298
|
0
|
0
|
|
|
|
|
$hi = $$o{sth}->count() if $hi > $$o{sth}->count(); |
299
|
0
|
|
|
|
|
|
$$o{limit} = [$lo, $hi]; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
0
|
|
|
|
|
|
$$o{sth}->set_limit($$o{limit}); |
303
|
|
|
|
|
|
|
|
304
|
0
|
|
|
|
|
|
return $$o{sth}; |
305
|
|
|
|
|
|
|
} |
306
|
0
|
|
|
0
|
0
|
|
sub get_count { $_[0]->sth->count() } |
307
|
0
|
|
|
0
|
0
|
|
sub get_rows_page { $_[0]{rows_page} } |
308
|
0
|
|
|
0
|
0
|
|
sub get_current_page { $_[0]{page} } |
309
|
0
|
|
|
0
|
0
|
|
sub get_lo_rec { $_[0]->sth->get_lo_rec() } |
310
|
0
|
|
|
0
|
0
|
|
sub get_hi_rec { $_[0]->sth->get_hi_rec() } |
311
|
0
|
|
|
0
|
0
|
|
sub get_num_pages { $_[0]{num_pages} } |
312
|
0
|
|
|
0
|
0
|
|
sub get_title { $_[0]{schema}{title} } |
313
|
0
|
|
|
0
|
0
|
|
sub get_filter { $_[0]->sth->filter_descr() } |
314
|
0
|
|
|
0
|
0
|
|
sub get_sort { $_[0]->sth->sort_descr() } |
315
|
0
|
|
|
0
|
0
|
|
sub get_query { $_[0]{query} } |
316
|
0
|
|
|
0
|
0
|
|
sub get_nice_name { $_[0]{schema}{select}{$_[1]}[2] } |
317
|
0
|
|
|
0
|
0
|
|
sub get_num_usersel_cols { scalar @{$_[0]{show}} } |
|
0
|
|
|
|
|
|
|
318
|
0
|
|
|
0
|
0
|
|
sub get_usersel_cols { $_[0]{show} } |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
sub finish { |
321
|
0
|
|
|
0
|
0
|
|
my ($o) = @_; |
322
|
0
|
0
|
|
|
|
|
$$o{sth}->finish() if $$o{sth}; |
323
|
0
|
|
|
|
|
|
undef $$o{sth}; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# get the options |
327
|
|
|
|
|
|
|
sub get_opts { |
328
|
0
|
|
|
0
|
0
|
|
my ($o) = @_; |
329
|
|
|
|
|
|
|
|
330
|
0
|
0
|
|
|
|
|
if (! $$o{_opts}) { |
331
|
0
|
|
|
|
|
|
my $class = ref $o; |
332
|
|
|
|
|
|
|
|
333
|
0
|
0
|
0
|
|
|
|
if (exists $$o{schema}{options}{$class}) { |
|
|
0
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
$$o{_opts} = $$o{schema}{options}{$class}; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# remove numerics and try again, this allows for module developers to create upgraded modules that use |
338
|
|
|
|
|
|
|
# backwards compatible options example: InteractiveQuery & InteractiveQuery2 |
339
|
|
|
|
|
|
|
elsif ($class =~ s/\d+$// && exists $$o{schema}{options}{$class}) { |
340
|
0
|
|
|
|
|
|
$$o{_opts} = $$o{schema}{options}{$class}; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
else { |
344
|
0
|
|
|
|
|
|
$$o{_opts} = {}; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
0
|
|
|
|
|
|
return $$o{_opts}; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub fetch { |
352
|
0
|
|
|
0
|
0
|
|
my ($o) = @_; |
353
|
0
|
0
|
|
|
|
|
if ($$o{rec} = $o->sth->fetchrow_hashref()) { |
354
|
0
|
|
|
|
|
|
my $mutator = $o->get_opts()->{'mutateRecord'}; |
355
|
0
|
0
|
|
|
|
|
$mutator->($$o{rec}) if ref($mutator) eq 'CODE'; |
356
|
0
|
0
|
|
|
|
|
$$o{schema}{mutateRecord}->($$o{rec}) if ref($$o{schema}{mutateRecord}) eq 'CODE'; |
357
|
0
|
|
|
|
|
|
return $$o{rec}; |
358
|
|
|
|
|
|
|
} |
359
|
0
|
|
|
|
|
|
return undef; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub get_val { |
363
|
0
|
|
|
0
|
0
|
|
my ($o, $colAlias) = @_; |
364
|
0
|
0
|
|
|
|
|
$o->fetch() unless $$o{rec}; |
365
|
0
|
|
0
|
|
|
|
my $formatter = $$o{schema}{select}{$colAlias}[3]{formatter} || \&default_formatter; |
366
|
0
|
|
|
|
|
|
return $formatter->($$o{rec}{$colAlias}, $$o{rec}, $o, $colAlias); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub get_html_val { |
370
|
0
|
|
|
0
|
0
|
|
my ($o, $colAlias) = @_; |
371
|
0
|
0
|
|
|
|
|
$o->fetch() unless $$o{rec}; |
372
|
0
|
|
0
|
|
|
|
my $formatter = $$o{schema}{select}{$colAlias}[3]{html_formatter} || \&default_html_formatter; |
373
|
0
|
|
|
|
|
|
return $formatter->($$o{rec}{$colAlias}, $$o{rec}, $o, $colAlias); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub default_formatter { |
377
|
0
|
|
|
0
|
0
|
|
my ($val) = @_; |
378
|
0
|
0
|
|
|
|
|
return (ref($val) eq 'ARRAY') ? join(', ', @$val) : $val; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub default_html_formatter { |
382
|
0
|
|
|
0
|
0
|
|
my ($val, $rec, $o, $colAlias) = @_; |
383
|
0
|
0
|
|
|
|
|
if (! exists $$o{_noEscapeColMap}) { |
384
|
0
|
0
|
|
|
|
|
my %noEsc = map { $_ => 1 } @{ $o->get_opts()->{'noEscapeCol'} || [] }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
|
$$o{_noEscapeColMap} = \%noEsc; |
386
|
|
|
|
|
|
|
} |
387
|
0
|
0
|
|
|
|
|
if ($$o{_noEscapeColMap}{$colAlias}) { |
|
|
0
|
|
|
|
|
|
388
|
0
|
0
|
|
|
|
|
$val = join(' ', $val) if ref($val) eq 'ARRAY'; |
389
|
|
|
|
|
|
|
} elsif (ref($val) eq 'ARRAY') { |
390
|
0
|
|
|
|
|
|
$val = join(', ', map { escapeHTML($_) } @$val); |
|
0
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
} else { |
392
|
0
|
|
|
|
|
|
$val = escapeHTML($val); |
393
|
|
|
|
|
|
|
} |
394
|
0
|
|
|
|
|
|
return $val; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
sub recview_formatter { |
398
|
0
|
|
|
0
|
0
|
|
my ($val, $rec, $o, $colAlias) = @_; |
399
|
|
|
|
|
|
|
|
400
|
0
|
|
|
|
|
|
my @val; |
401
|
0
|
|
|
|
|
|
foreach my $colAlias2 (@{ $$o{schema}{select}{$colAlias}[3]{select} }) { |
|
0
|
|
|
|
|
|
|
402
|
0
|
|
|
|
|
|
my $val2 = default_formatter($$rec{$colAlias2}); |
403
|
0
|
0
|
|
|
|
|
if ($val2 ne '') { |
404
|
0
|
|
0
|
|
|
|
my $label = $$o{schema}{select}{$colAlias2}[2] || $colAlias2; |
405
|
0
|
|
|
|
|
|
push @val, "$label: $val2"; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
} |
408
|
0
|
|
|
|
|
|
return join("\n", @val); |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
sub recview_html_formatter { |
412
|
0
|
|
|
0
|
0
|
|
my ($val, $rec, $o, $colAlias) = @_; |
413
|
|
|
|
|
|
|
|
414
|
0
|
|
|
|
|
|
my @val; |
415
|
0
|
|
|
|
|
|
foreach my $colAlias2 (@{ $$o{schema}{select}{$colAlias}[3]{select} }) { |
|
0
|
|
|
|
|
|
|
416
|
0
|
|
|
|
|
|
my $val2 = $o->get_html_val($colAlias2); |
417
|
0
|
0
|
|
|
|
|
if ($val2 ne '') { |
418
|
0
|
|
0
|
|
|
|
my $label = $$o{schema}{select}{$colAlias2}[2] || $colAlias2; |
419
|
0
|
|
|
|
|
|
push @val, " |
".escapeHTML($label)." | $val2 |
";
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
} |
422
|
0
|
0
|
|
|
|
|
return $#val > -1 ? "" : ''; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub get_link { |
426
|
0
|
|
|
0
|
0
|
|
my ($o) = @_; |
427
|
0
|
|
|
|
|
|
my @args; |
428
|
0
|
|
|
|
|
|
foreach my $k (qw( show filter hiddenFilter queryDescr sort)) { |
429
|
0
|
|
|
|
|
|
my $v1 = $$o{$k}; |
430
|
0
|
0
|
|
|
|
|
$v1 = join(',', @$v1) if ref($v1) eq 'ARRAY'; |
431
|
0
|
|
|
|
|
|
my $v2 = $$o{schema}{$k}; |
432
|
0
|
0
|
|
|
|
|
$v2 = join(',', @$v2) if ref($v2) eq 'ARRAY'; |
433
|
0
|
0
|
|
|
|
|
push @args, "$k=".CGI::escape($v1) if $v1 ne $v2; |
434
|
|
|
|
|
|
|
} |
435
|
0
|
|
|
|
|
|
my $rv = $$o{schema}{URI}; |
436
|
0
|
|
|
|
|
|
my $args = join('&', @args); |
437
|
0
|
0
|
|
|
|
|
$rv .= '?'.$args if $args; |
438
|
0
|
|
|
|
|
|
return $rv; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
1; |