line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
################################################################################ |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Apache::Voodoo::Table |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# framework to handle common database operations |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
################################################################################ |
8
|
|
|
|
|
|
|
package Apache::Voodoo::Table; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
$VERSION = "3.0200"; |
11
|
|
|
|
|
|
|
|
12
|
2
|
|
|
2
|
|
4223
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
87
|
|
13
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
75
|
|
14
|
|
|
|
|
|
|
|
15
|
2
|
|
|
2
|
|
11
|
use base("Apache::Voodoo"); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
834
|
|
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
915
|
use Apache::Voodoo::Validate; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
71
|
|
18
|
2
|
|
|
2
|
|
778
|
use Apache::Voodoo::Pager; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
15317
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new { |
21
|
2
|
|
|
2
|
0
|
1405
|
my $class = shift; |
22
|
2
|
|
|
|
|
8
|
my $self = {}; |
23
|
|
|
|
|
|
|
|
24
|
2
|
|
|
|
|
6
|
bless $self, $class; |
25
|
|
|
|
|
|
|
|
26
|
2
|
|
|
|
|
6
|
$self->set_configuration(shift); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
$self->{'list_param_parser'} = sub { |
29
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
30
|
0
|
|
|
|
|
0
|
my $dbh = shift; |
31
|
0
|
|
|
|
|
0
|
my $params = shift; |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
|
|
|
0
|
my @fields = @{$self->{'columns'}}; |
|
0
|
|
|
|
|
0
|
|
34
|
0
|
0
|
|
|
|
0
|
if ($self->{'references'}) { |
35
|
0
|
|
|
|
|
0
|
foreach my $join (@{$self->{'references'}}) { |
|
0
|
|
|
|
|
0
|
|
36
|
0
|
|
|
|
|
0
|
foreach (@{$join->{'columns'}}) { |
|
0
|
|
|
|
|
0
|
|
37
|
0
|
|
|
|
|
0
|
push(@fields,"$join->{'table'}.$_"); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
0
|
|
|
|
|
0
|
my @search; |
43
|
0
|
|
|
|
|
0
|
foreach my $field (@fields) { |
44
|
0
|
|
|
|
|
0
|
my $s = 'search_' .$field; |
45
|
0
|
|
|
|
|
0
|
my $o = 'search_op_'.$field; |
46
|
|
|
|
|
|
|
|
47
|
0
|
0
|
|
|
|
0
|
next unless defined($params->{$s}); |
48
|
|
|
|
|
|
|
|
49
|
0
|
0
|
|
|
|
0
|
if (defined($params->{$o})) { |
|
|
0
|
|
|
|
|
|
50
|
0
|
|
|
|
|
0
|
push(@search,[$field,$params->{$o},$params->{$s}]); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
elsif ($params->{$s} =~ /^\d+$/) { |
53
|
0
|
|
|
|
|
0
|
push(@search,[$field,'=',$params->{$s}]); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
else { |
56
|
0
|
|
|
|
|
0
|
push(@search,[$field,'like',$params->{$s}]); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
0
|
|
|
|
|
0
|
return @search; |
61
|
0
|
|
|
|
|
0
|
}; |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
0
|
return $self; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub set_configuration { |
67
|
2
|
|
|
2
|
0
|
2
|
my $self = shift; |
68
|
2
|
|
|
|
|
4
|
my $conf = shift; |
69
|
|
|
|
|
|
|
|
70
|
2
|
|
|
|
|
3
|
my @errors; |
71
|
|
|
|
|
|
|
|
72
|
2
|
100
|
|
|
|
12
|
if (!defined($conf->{'table'})) { |
|
|
50
|
|
|
|
|
|
73
|
1
|
|
|
|
|
2
|
push(@errors,"missing table name"); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
elsif ($conf->{'table'} !~ /^[a-z_]\w*$/) { |
76
|
0
|
|
|
|
|
0
|
push(@errors,"bad table name"); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
else { |
79
|
1
|
|
|
|
|
4
|
$self->{'table'} = $conf->{'table'}; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
2
|
50
|
|
|
|
6
|
if (!defined($conf->{'primary_key'})) { |
|
|
0
|
|
|
|
|
|
83
|
2
|
|
|
|
|
3
|
push(@errors,"missing primary key"); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
elsif ($conf->{'primary_key'} !~ /^[a-z_]\w*$/) { |
86
|
0
|
|
|
|
|
0
|
push(@errors,"bad primary key"); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
else { |
89
|
0
|
|
|
|
|
0
|
$self->{'pkey'} = $conf->{'primary_key'}; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
2
|
50
|
|
|
|
15
|
$self->{'pkey_regexp'} = ($conf->{'primary_key_regexp'})?$conf->{'primary_key_regexp'}:'^\d+$'; |
93
|
2
|
50
|
|
|
|
8
|
$self->{'pkey_user_supplied'} = ($conf->{'primary_key_user_supplied'})?1:0; |
94
|
2
|
|
|
|
|
3
|
eval { |
95
|
2
|
|
|
|
|
17
|
$self->{valid} = Apache::Voodoo::Validate->new($conf->{'columns'}); |
96
|
|
|
|
|
|
|
}; |
97
|
2
|
100
|
|
|
|
663
|
if (my $e = Apache::Voodoo::Exception::RunTime::BadConfig->caught()) { |
|
|
50
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# FIXME hack! need to figure out to store the list of errors as a data structure and override the stringification operation. |
99
|
1
|
|
|
|
|
28
|
my (undef,@e) = split(/\n\t/,"$e"); |
100
|
1
|
|
|
|
|
1249
|
push(@errors,@e); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif ($@) { |
103
|
0
|
0
|
|
|
|
0
|
ref($@)? |
104
|
|
|
|
|
|
|
$@->rethrow: |
105
|
|
|
|
|
|
|
Apache::Voodoo::Exception::RunTime->throw($@); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
2
|
|
|
|
|
18
|
$self->{'column_names'} = {}; |
109
|
2
|
|
|
|
|
4
|
while (my ($name,$conf) = each %{$conf->{'columns'}}) { |
|
3
|
|
|
|
|
16
|
|
110
|
1
|
50
|
|
|
|
4
|
if (defined($conf->{'multiple'})) { |
111
|
0
|
|
|
|
|
0
|
push(@errors,"Column $name allows multiple values but Apache::Voodoo::Table can't handle that currently."); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
1
|
50
|
|
|
|
4
|
if (defined($conf->{'unique'})) { |
115
|
0
|
|
|
|
|
0
|
push(@{$self->{'unique'}},$name); |
|
0
|
|
|
|
|
0
|
|
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# keep a local list of column names for query construction. |
119
|
1
|
50
|
33
|
|
|
7
|
if (defined($self->{'pkey'}) && $name ne $self->{'pkey'}) { |
120
|
0
|
|
|
|
|
0
|
push(@{$self->{'columns'}},$name); |
|
0
|
|
|
|
|
0
|
|
121
|
0
|
|
|
|
|
0
|
$self->{'column_names'}->{$self->{'table'}.'.'.$name} = 1; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
1
|
50
|
|
|
|
5
|
if ($conf->{'type'} eq "date") { push(@{$self->{dates}},$name); } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
125
|
1
|
50
|
|
|
|
3
|
if ($conf->{'type'} eq "time") { push(@{$self->{times}},$name); } |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
126
|
|
|
|
|
|
|
|
127
|
1
|
50
|
|
|
|
5
|
if (defined($conf->{'references'})) { |
128
|
0
|
|
|
|
|
0
|
my %v; |
129
|
0
|
|
|
|
|
0
|
$v{'fkey'} = $name; |
130
|
0
|
|
|
|
|
0
|
$v{'table'} = $conf->{'references'}->{'table'}; |
131
|
0
|
|
|
|
|
0
|
$v{'pkey'} = $conf->{'references'}->{'primary_key'}; |
132
|
0
|
|
|
|
|
0
|
$v{'columns'} = $conf->{'references'}->{'columns'}; |
133
|
0
|
|
|
|
|
0
|
$v{'slabel'} = $conf->{'references'}->{'select_label'}; |
134
|
0
|
|
|
|
|
0
|
$v{'sdefault'} = $conf->{'references'}->{'select_default'}; |
135
|
0
|
|
|
|
|
0
|
$v{'sextra'} = $conf->{'references'}->{'select_extra'}; |
136
|
|
|
|
|
|
|
|
137
|
0
|
0
|
|
|
|
0
|
push(@errors,"no table in reference for $name") unless $v{'table'} =~ /\w+/; |
138
|
0
|
0
|
|
|
|
0
|
push(@errors,"no primary key in reference for $name") unless $v{'pkey'} =~ /\w+/; |
139
|
0
|
0
|
|
|
|
0
|
push(@errors,"no label for select list in reference for $name") unless $v{'slabel'} =~ /\w+/; |
140
|
|
|
|
|
|
|
|
141
|
0
|
0
|
|
|
|
0
|
if (defined($v{'columns'})) { |
142
|
0
|
0
|
|
|
|
0
|
if (ref($v{'columns'})) { |
143
|
0
|
0
|
|
|
|
0
|
if (ref($v{'columns'}) ne "ARRAY") { |
144
|
0
|
|
|
|
|
0
|
push(@errors,"references => column must either be a scalar or arrayref for $name"); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
else { |
148
|
0
|
|
|
|
|
0
|
$v{'columns'} = [ $v{'columns'} ]; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
else { |
152
|
0
|
|
|
|
|
0
|
push(@errors,"references => columns must be defined for $name"); |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
0
|
push(@{$self->{'references'}},\%v); |
|
0
|
|
|
|
|
0
|
|
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
2
|
|
|
|
|
8
|
$self->{'default_sort'} = $conf->{'list_options'}->{'default_sort'}; |
160
|
2
|
|
|
|
|
4
|
while (my ($k,$v) = each %{$conf->{'list_options'}->{'sort'}}) { |
|
2
|
|
|
|
|
19
|
|
161
|
0
|
0
|
|
|
|
0
|
$self->{'list_sort'}->{$k} = (ref($v) eq "ARRAY")? join(", ",@{$v}) : $v; |
|
0
|
|
|
|
|
0
|
|
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
2
|
|
|
|
|
4
|
foreach (@{$conf->{'list_options'}->{'search'}}) { |
|
2
|
|
|
|
|
6
|
|
165
|
0
|
|
|
|
|
0
|
push(@{$self->{'list_search_items'}},[$_->[1],$_->[0]]); |
|
0
|
|
|
|
|
0
|
|
166
|
0
|
|
|
|
|
0
|
$self->{'list_search'}->{$_->[1]} = 1; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
2
|
50
|
|
|
|
8
|
if ($conf->{'list_options'}->{'group_by'}) { |
170
|
0
|
|
|
|
|
0
|
$self->{'group_by'} = $conf->{'list_options'}->{'group_by'}; |
171
|
0
|
0
|
|
|
|
0
|
$self->{'group_by'} = $conf->{'table'}.".".$self->{'group_by'} unless ($self->{'group_by'} =~ /\./); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
2
|
|
|
|
|
4
|
$self->{'joins'} = []; |
175
|
2
|
|
|
|
|
5
|
$self->{'list_joins'} = []; |
176
|
2
|
|
|
|
|
5
|
$self->{'view_joins'} = []; |
177
|
|
|
|
|
|
|
|
178
|
2
|
50
|
|
|
|
6
|
if (ref($conf->{'joins'}) eq "ARRAY") { |
179
|
0
|
|
|
|
|
0
|
foreach my $j (@{$conf->{'joins'}}) { |
|
0
|
|
|
|
|
0
|
|
180
|
0
|
|
0
|
|
|
0
|
$j->{'columns'} ||= []; |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
0
|
foreach (@{$j->{'columns'}}) { |
|
0
|
|
|
|
|
0
|
|
183
|
0
|
|
|
|
|
0
|
$self->{'column_names'}->{$j->{'table'}.'.'.$_} = 1; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
0
|
|
|
0
|
my $context = lc($j->{'context'}) || ''; |
187
|
0
|
0
|
|
|
|
0
|
$context = ($context =~ /^(list|view)$/i)?$context."_":''; |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
0
|
|
|
0
|
push(@{$self->{$context.'joins'}}, |
|
0
|
|
|
|
|
0
|
|
190
|
|
|
|
|
|
|
{ |
191
|
|
|
|
|
|
|
table => $j->{'table'}, |
192
|
|
|
|
|
|
|
type => $j->{'type'} || 'LEFT', |
193
|
|
|
|
|
|
|
pkey => $j->{'primary_key'}, |
194
|
|
|
|
|
|
|
fkey => $j->{'foreign_key'}, |
195
|
|
|
|
|
|
|
columns => $j->{'columns'}, |
196
|
|
|
|
|
|
|
extra => $j->{'extra'} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
); |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
2
|
50
|
|
|
|
7
|
if ($conf->{'pager'}) { |
203
|
0
|
|
|
|
|
0
|
$self->{'pager'} = $conf->{'pager'}; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
else { |
206
|
2
|
|
|
|
|
16
|
$self->{'pager'} = Apache::Voodoo::Pager->new(); |
207
|
|
|
|
|
|
|
# setup the pagination options |
208
|
2
|
50
|
|
|
|
18
|
$self->{'pager'}->set_configuration( |
209
|
|
|
|
|
|
|
'count' => 40, |
210
|
|
|
|
|
|
|
'window' => 10, |
211
|
|
|
|
|
|
|
'persist' => [ |
212
|
|
|
|
|
|
|
'pattern', |
213
|
|
|
|
|
|
|
'limit', |
214
|
|
|
|
|
|
|
'sort', |
215
|
|
|
|
|
|
|
'last_sort', |
216
|
|
|
|
|
|
|
'desc', |
217
|
2
|
|
|
|
|
4
|
@{$conf->{'list_options'}->{'persist'} || []} |
218
|
|
|
|
|
|
|
] |
219
|
|
|
|
|
|
|
); |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
2
|
50
|
|
|
|
14
|
if (@errors) { |
223
|
2
|
|
|
|
|
12
|
Apache::Voodoo::Exception::RunTime::BadConfig->throw("Configuration Errors:\n\t".join("\n\t",@errors)); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub table { |
228
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
229
|
0
|
0
|
|
|
|
|
if ($_[0]) { |
230
|
0
|
|
|
|
|
|
$self->{'table'} = $_[0]; |
231
|
|
|
|
|
|
|
} |
232
|
0
|
|
|
|
|
|
return $self->{'table'}; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub success { |
236
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
return $self->{'success'}; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub edit_details { |
242
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
# if there wasn't a successful edit, then there's no details :) |
245
|
0
|
0
|
|
|
|
|
return unless $self->{'success'}; |
246
|
|
|
|
|
|
|
|
247
|
0
|
|
0
|
|
|
|
return $self->{'edit_details'} || []; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub add_details { |
251
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# if there wasn't a successful add, then there's no details :) |
254
|
0
|
0
|
|
|
|
|
return unless $self->{'success'}; |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
0
|
|
|
|
return $self->{'add_details'} || []; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub add_insert_callback { |
260
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
261
|
0
|
|
|
|
|
|
my $sub_ref = shift; |
262
|
|
|
|
|
|
|
|
263
|
0
|
|
|
|
|
|
push(@{$self->{'insert_callbacks'}},$sub_ref); |
|
0
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub add_update_callback { |
267
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
268
|
0
|
|
|
|
|
|
my $sub_ref = shift; |
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
push(@{$self->{'update_callbacks'}},$sub_ref); |
|
0
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub list_param_parser { |
274
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
275
|
0
|
|
|
|
|
|
my $sub_ref = shift; |
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
|
$self->{'list_param_parser'} = $sub_ref; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub validate_add { |
281
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
282
|
0
|
|
|
|
|
|
my $p = shift; |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
285
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
286
|
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
my $errors = {}; |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# call each of the insert callbacks |
290
|
0
|
|
|
|
|
|
foreach (@{$self->{'insert_callbacks'}}) { |
|
0
|
|
|
|
|
|
|
291
|
0
|
|
|
|
|
|
my $callback_errors = $_->($dbh,$params); |
292
|
0
|
|
|
|
|
|
@{$errors}{keys %{$callback_errors}} = values %{$callback_errors}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# do all the normal parameter checking |
296
|
0
|
|
|
|
|
|
my ($values,$e) = $self->{valid}->validate($params); |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# copy the errors from the process_params |
299
|
0
|
0
|
|
|
|
|
$errors = { %{$errors}, %{$e} } if ref($e) eq "HASH"; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# check to see if the user supplied primary key (optional) is unique |
302
|
0
|
0
|
|
|
|
|
if ($self->{'pkey_user_supplied'}) { |
303
|
0
|
0
|
|
|
|
|
if ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) { |
304
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref(" |
305
|
|
|
|
|
|
|
SELECT 1 |
306
|
|
|
|
|
|
|
FROM $self->{'table'} |
307
|
|
|
|
|
|
|
WHERE $self->{'pkey'} = ?", |
308
|
|
|
|
|
|
|
undef, |
309
|
|
|
|
|
|
|
$params->{$self->{'pkey'}} ); |
310
|
|
|
|
|
|
|
|
311
|
0
|
0
|
|
|
|
|
if ($res->[0]->[0] == 1) { |
312
|
0
|
|
|
|
|
|
$errors->{'DUP_'.$self->{'pkey'}} = 1; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
else { |
316
|
0
|
|
|
|
|
|
$errors->{'BAD_'.$self->{'pkey'}} = 1; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# check each unique column constraint |
321
|
0
|
|
|
|
|
|
foreach (@{$self->{'unique'}}) { |
|
0
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref(" |
323
|
|
|
|
|
|
|
SELECT 1 |
324
|
|
|
|
|
|
|
FROM $self->{'table'} |
325
|
|
|
|
|
|
|
WHERE $_ = ?", |
326
|
|
|
|
|
|
|
undef, |
327
|
|
|
|
|
|
|
$values->{$_}); |
328
|
0
|
0
|
|
|
|
|
if ($res->[0]->[0] == 1) { |
329
|
0
|
|
|
|
|
|
$errors->{"DUP_$_"} = 1; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
return ($values,$errors); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub validate_edit { |
337
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
338
|
0
|
|
|
|
|
|
my $p = shift; |
339
|
|
|
|
|
|
|
|
340
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
341
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
342
|
|
|
|
|
|
|
|
343
|
0
|
0
|
|
|
|
|
unless ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) { |
344
|
0
|
|
|
|
|
|
return $self->display_error("Invalid ID"); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
my $errors = {}; |
348
|
|
|
|
|
|
|
# call each of the update callbacks |
349
|
0
|
|
|
|
|
|
foreach (@{$self->{'update_callbacks'}}) { |
|
0
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# call back should return a list of error strings |
351
|
0
|
|
|
|
|
|
my $callback_errors = $_->($dbh,$params); |
352
|
0
|
|
|
|
|
|
@{$errors}{keys %{$callback_errors}} = values %{$callback_errors}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# run the standard error checks |
356
|
0
|
|
|
|
|
|
my ($values,$e) = $self->{valid}->validate($params); |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# copy the errors from the process_params |
359
|
0
|
0
|
|
|
|
|
$errors = { %{$errors}, %{$e} } if ref($e) eq "HASH"; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# check all the unique columns |
362
|
0
|
|
|
|
|
|
foreach (@{$self->{'unique'}}) { |
|
0
|
|
|
|
|
|
|
363
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref(" |
364
|
|
|
|
|
|
|
SELECT 1 |
365
|
|
|
|
|
|
|
FROM $self->{'table'} |
366
|
|
|
|
|
|
|
WHERE $_ = ? AND $self->{'pkey'} != ?", |
367
|
|
|
|
|
|
|
undef, |
368
|
|
|
|
|
|
|
$values->{$_}, |
369
|
|
|
|
|
|
|
$params->{$self->{'pkey'}}); |
370
|
0
|
0
|
|
|
|
|
if ($res->[0]->[0] == 1) { |
371
|
0
|
|
|
|
|
|
$errors->{"DUP_$_"} = 1; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
|
return $values,$errors; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub add { |
379
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
380
|
0
|
|
|
|
|
|
my $p = shift; |
381
|
|
|
|
|
|
|
|
382
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
383
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
384
|
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
|
my $errors = {}; |
386
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
$self->{'success'} = 0; |
388
|
0
|
|
|
|
|
|
$self->{'add_details'} = []; |
389
|
|
|
|
|
|
|
|
390
|
0
|
0
|
|
|
|
|
if ($params->{'cm'} eq "add") { |
391
|
0
|
|
|
|
|
|
my ($values,$errors) = $self->validate_add($p); |
392
|
|
|
|
|
|
|
|
393
|
0
|
0
|
|
|
|
|
if (scalar keys %{$errors}) { |
|
0
|
|
|
|
|
|
|
394
|
0
|
|
|
|
|
|
$errors->{'HAS_ERRORS'} = 1; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# copy values back into form |
397
|
0
|
|
|
|
|
|
foreach (keys(%{$values})) { |
|
0
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
|
$errors->{$_} = $values->{$_}; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
else { |
402
|
|
|
|
|
|
|
# copy clean dates,times into params for insertion |
403
|
0
|
|
|
|
|
|
foreach (@{$self->{'dates'}},@{$self->{'times'}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
404
|
0
|
|
|
|
|
|
$values->{$_->{'name'}} = $values->{$_->{'name'}."_CLEAN"}; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
|
407
|
0
|
|
|
|
|
|
my $c = join(",", @{$self->{'columns'}}); # the column names |
|
0
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
my $q = join(",",map {"?"} @{$self->{'columns'}}); # the ? mark placeholders |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
my @v = map { $values->{$_} } @{$self->{'columns'}}; # and the values |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
# store the values as they went into the db here incase the caller wants to |
413
|
|
|
|
|
|
|
# use them for something. |
414
|
0
|
|
|
|
|
|
foreach (@{$self->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
415
|
0
|
|
|
|
|
|
push(@{$self->{'add_details'}},[$_,'',$values->{$_}]); |
|
0
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
0
|
0
|
|
|
|
|
if ($self->{'pkey_user_supplied'}) { |
419
|
0
|
|
|
|
|
|
$c .= ",".$self->{'pkey'}; |
420
|
0
|
|
|
|
|
|
$q .= ",?"; |
421
|
|
|
|
|
|
|
|
422
|
0
|
|
|
|
|
|
push(@v,$params->{$self->{'pkey'}}); |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
my $insert_statement = "INSERT INTO $self->{'table'} ($c) VALUES ($q)"; |
427
|
|
|
|
|
|
|
|
428
|
0
|
|
|
|
|
|
$dbh->do($insert_statement, undef, @v); |
429
|
|
|
|
|
|
|
|
430
|
0
|
|
|
|
|
|
$self->{'success'} = 1; |
431
|
0
|
|
|
|
|
|
return 1; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# populate drop downs (also maintaining previous state). |
436
|
0
|
|
|
|
|
|
foreach (@{$self->{'references'}}) { |
|
0
|
|
|
|
|
|
|
437
|
0
|
|
|
|
|
|
my $query = "SELECT |
438
|
|
|
|
|
|
|
$_->{'pkey'}, |
439
|
|
|
|
|
|
|
$_->{'slabel'} |
440
|
|
|
|
|
|
|
FROM |
441
|
|
|
|
|
|
|
$_->{'table'} |
442
|
|
|
|
|
|
|
$_->{'sextra'}"; |
443
|
|
|
|
|
|
|
|
444
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref($query); |
445
|
|
|
|
|
|
|
|
446
|
0
|
|
0
|
|
|
|
$errors->{$_->{'fkey'}} = $self->prep_select($res,$errors->{$_->{'fkey'}} || $_->{'sdefault'}); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
# If we get here the user is just loading the page |
450
|
|
|
|
|
|
|
# for the first time or had errors. |
451
|
0
|
|
|
|
|
|
return $errors; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub edit { |
455
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
456
|
0
|
|
|
|
|
|
my $p = shift; |
457
|
0
|
|
|
|
|
|
my $additional_constraint = shift; |
458
|
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
|
$self->{'success'} = 0; |
460
|
0
|
|
|
|
|
|
$self->{'edit_details'} = []; |
461
|
|
|
|
|
|
|
|
462
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
463
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# make sure our additional constraint won't break the sql |
466
|
0
|
|
|
|
|
|
$additional_constraint =~ s/^\s*(where|and|or)\s+//go; |
467
|
0
|
0
|
|
|
|
|
if (length($additional_constraint)) { |
468
|
0
|
|
|
|
|
|
$additional_constraint = "AND $additional_constraint"; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
0
|
0
|
|
|
|
|
unless ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) { |
472
|
0
|
|
|
|
|
|
return $self->display_error("Invalid ID"); |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# find the record to be updated |
476
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref(" |
477
|
|
|
|
|
|
|
SELECT ". |
478
|
0
|
|
|
|
|
|
join(",",@{$self->{'columns'}}). " |
479
|
|
|
|
|
|
|
FROM |
480
|
|
|
|
|
|
|
$self->{'table'} |
481
|
|
|
|
|
|
|
WHERE |
482
|
|
|
|
|
|
|
$self->{'pkey'} = ? |
483
|
|
|
|
|
|
|
$additional_constraint", |
484
|
|
|
|
|
|
|
undef, |
485
|
|
|
|
|
|
|
$params->{$self->{'pkey'}}); |
486
|
|
|
|
|
|
|
|
487
|
0
|
0
|
|
|
|
|
unless (defined($res->[0])) { |
488
|
0
|
|
|
|
|
|
return $self->display_error("No record with that ID found"); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
|
my %original_values; |
492
|
0
|
|
|
|
|
|
for (my $i=0; $i <= $#{$self->{'columns'}}; $i++) { |
|
0
|
|
|
|
|
|
|
493
|
0
|
|
|
|
|
|
$original_values{$self->{'columns'}->[$i]} = $res->[0]->[$i]; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
0
|
|
|
|
|
|
my $errors = {}; |
497
|
0
|
0
|
|
|
|
|
if ($params->{'cm'} eq "update") { |
498
|
0
|
|
|
|
|
|
my ($values,$errors) = $self->validate_edit($p); |
499
|
|
|
|
|
|
|
|
500
|
0
|
0
|
|
|
|
|
if (scalar keys %{$errors}) { |
|
0
|
|
|
|
|
|
|
501
|
0
|
|
|
|
|
|
$errors->{'has_errors'} = 1; |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
# copy values into template |
504
|
0
|
|
|
|
|
|
$errors->{$self->{'pkey'}} = $params->{$self->{'pkey'}}; |
505
|
0
|
|
|
|
|
|
foreach (keys(%{$values})) { |
|
0
|
|
|
|
|
|
|
506
|
0
|
|
|
|
|
|
$errors->{$_} = $values->{$_}; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
else { |
510
|
|
|
|
|
|
|
# copy clean dates,times into params for insertion |
511
|
0
|
|
|
|
|
|
foreach (@{$self->{'dates'}},@{$self->{'times'}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
512
|
0
|
|
|
|
|
|
$values->{$_->{'name'}} = $values->{$_->{'name'}."_CLEAN"}; |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
# let's figure out what they changed so caller can do something with that info if they want |
516
|
0
|
|
|
|
|
|
foreach (@{$self->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
517
|
0
|
0
|
|
|
|
|
if ($values->{$_} ne $original_values{$_}) { |
518
|
0
|
|
|
|
|
|
push(@{$self->{'edit_details'}},[$_,$original_values{$_},$values->{$_}]); |
|
0
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
} |
521
|
0
|
|
|
|
|
|
my $update_statement = " |
522
|
|
|
|
|
|
|
UPDATE |
523
|
|
|
|
|
|
|
$self->{'table'} |
524
|
|
|
|
|
|
|
SET ". |
525
|
0
|
|
|
|
|
|
join("=?,",@{$self->{'columns'}})."=? |
526
|
|
|
|
|
|
|
WHERE |
527
|
|
|
|
|
|
|
$self->{'pkey'} = ? |
528
|
|
|
|
|
|
|
$additional_constraint"; |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
# $self->debug($update_statement); |
531
|
|
|
|
|
|
|
# $self->debug((map {$values->{$_}} @{$self->{'columns'}}),$params->{$self->{'pkey'}}); |
532
|
|
|
|
|
|
|
|
533
|
0
|
|
|
|
|
|
$dbh->do($update_statement, |
534
|
|
|
|
|
|
|
undef, |
535
|
0
|
|
|
|
|
|
(map { $values->{$_} } @{$self->{'columns'}}), |
|
0
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
$params->{$self->{'pkey'}}); |
537
|
|
|
|
|
|
|
|
538
|
0
|
|
|
|
|
|
$self->{'success'} = 1; |
539
|
0
|
|
|
|
|
|
return 1; |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
else { |
543
|
0
|
|
|
|
|
|
foreach (@{$self->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
544
|
0
|
|
|
|
|
|
$errors->{$_} = $original_values{$_}; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
0
|
|
|
|
|
|
$errors->{$self->{'pkey'}} = $params->{$self->{'pkey'}}; |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# pretty up dates |
550
|
0
|
|
|
|
|
|
foreach (@{$self->{'dates'}}) { |
|
0
|
|
|
|
|
|
|
551
|
0
|
|
|
|
|
|
$errors->{$_->{'name'}} = $self->sql_to_date($errors->{$_->{'name'}}); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# pretty up times |
555
|
0
|
|
|
|
|
|
foreach (@{$self->{'times'}}) { |
|
0
|
|
|
|
|
|
|
556
|
0
|
|
|
|
|
|
$errors->{$_->{'name'}} = $self->sql_to_time($errors->{$_->{'name'}}); |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
# populate drop downs (also maintaining previous state). |
561
|
0
|
|
|
|
|
|
foreach (@{$self->{'references'}}) { |
|
0
|
|
|
|
|
|
|
562
|
0
|
|
|
|
|
|
my $query = "SELECT |
563
|
|
|
|
|
|
|
$_->{'pkey'}, |
564
|
|
|
|
|
|
|
$_->{'slabel'} |
565
|
|
|
|
|
|
|
FROM |
566
|
|
|
|
|
|
|
$_->{'table'} |
567
|
|
|
|
|
|
|
$_->{'sextra'}"; |
568
|
|
|
|
|
|
|
|
569
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref($query); |
570
|
|
|
|
|
|
|
|
571
|
0
|
|
0
|
|
|
|
$errors->{$_->{'fkey'}} = $self->prep_select($res,$errors->{$_->{'fkey'}} || $_->{'sdefault'}); |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
# If we get here the user is just loading the page |
575
|
|
|
|
|
|
|
# for the first time or had errors. |
576
|
0
|
|
|
|
|
|
return $errors; |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
sub delete { |
580
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
581
|
0
|
|
|
|
|
|
my $p = shift; |
582
|
|
|
|
|
|
|
|
583
|
0
|
|
|
|
|
|
$self->{'success'} = 0; |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# additional constraint to the where clause. |
586
|
0
|
|
|
|
|
|
my $additional_constraint = shift; |
587
|
|
|
|
|
|
|
|
588
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
589
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
590
|
|
|
|
|
|
|
|
591
|
0
|
0
|
|
|
|
|
unless ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) { |
592
|
0
|
|
|
|
|
|
return $self->display_error("Invalid ID"); |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# make sure our additional constraint won't break the sql |
596
|
0
|
|
|
|
|
|
$additional_constraint =~ s/^\s*(where|and|or)\s+//go; |
597
|
0
|
0
|
|
|
|
|
if (length($additional_constraint)) { |
598
|
0
|
|
|
|
|
|
$additional_constraint = "AND $additional_constraint"; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
# record exists? |
602
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref(" |
603
|
|
|
|
|
|
|
SELECT 1 |
604
|
|
|
|
|
|
|
FROM $self->{'table'} |
605
|
|
|
|
|
|
|
WHERE $self->{'pkey'} = ? |
606
|
|
|
|
|
|
|
$additional_constraint", |
607
|
|
|
|
|
|
|
undef, |
608
|
|
|
|
|
|
|
$params->{$self->{'pkey'}}); |
609
|
|
|
|
|
|
|
|
610
|
0
|
0
|
|
|
|
|
unless ($res->[0]->[0] == 1) { |
611
|
0
|
|
|
|
|
|
return $self->display_error("No Record found with that ID"); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
0
|
0
|
|
|
|
|
if ($params->{'confirm'} eq "Yes") { |
|
|
0
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# fry it |
616
|
0
|
|
|
|
|
|
$dbh->do(" |
617
|
|
|
|
|
|
|
DELETE FROM |
618
|
|
|
|
|
|
|
$self->{'table'} |
619
|
|
|
|
|
|
|
WHERE |
620
|
|
|
|
|
|
|
$self->{'pkey'} = ? |
621
|
|
|
|
|
|
|
$additional_constraint", |
622
|
|
|
|
|
|
|
undef, |
623
|
|
|
|
|
|
|
$params->{$self->{'pkey'}}); |
624
|
|
|
|
|
|
|
|
625
|
0
|
|
|
|
|
|
$self->{'success'} = 2; |
626
|
|
|
|
|
|
|
|
627
|
0
|
|
|
|
|
|
return 1; |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
elsif ($params->{'confirm'} eq "No") { |
630
|
|
|
|
|
|
|
# don't fry it |
631
|
|
|
|
|
|
|
|
632
|
0
|
|
|
|
|
|
$self->{'success'} = 1; |
633
|
|
|
|
|
|
|
|
634
|
0
|
|
|
|
|
|
return 1; |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
else { |
637
|
|
|
|
|
|
|
# ask if they want to fry it. |
638
|
0
|
|
|
|
|
|
return { $self->{'pkey'} => $params->{$self->{'pkey'}} }; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub list { |
643
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
644
|
0
|
|
|
|
|
|
my $p = shift; |
645
|
0
|
|
|
|
|
|
my $additional_constraint = shift; |
646
|
|
|
|
|
|
|
|
647
|
0
|
|
|
|
|
|
$self->{'success'} = 0; |
648
|
|
|
|
|
|
|
|
649
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
650
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# hello warning supression |
653
|
0
|
|
0
|
|
|
|
$params->{'sort'} ||= ''; |
654
|
0
|
|
0
|
|
|
|
$params->{'last_sort'} ||= $params->{'sort'}; |
655
|
0
|
|
0
|
|
|
|
$params->{'count'} ||= ''; |
656
|
0
|
|
0
|
|
|
|
$params->{'page'} ||= ''; |
657
|
0
|
|
0
|
|
|
|
$params->{'start'} ||= ''; |
658
|
0
|
|
0
|
|
|
|
$params->{'desc'} ||= ''; |
659
|
0
|
|
0
|
|
|
|
$params->{'showall'} ||= ''; |
660
|
0
|
|
0
|
|
|
|
$params->{'pattern'} ||= ''; |
661
|
0
|
|
0
|
|
|
|
$params->{'limit'} ||= ''; |
662
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
$params->{'sort'} =~ s/[^\w-]//g; |
664
|
0
|
|
|
|
|
|
$params->{'last_sort'} =~ s/[^\w-]//g; |
665
|
|
|
|
|
|
|
|
666
|
0
|
|
|
|
|
|
$params->{'count'} =~ s/\D//g; |
667
|
0
|
|
|
|
|
|
$params->{'page'} =~ s/\D//g; |
668
|
0
|
|
|
|
|
|
$params->{'start'} =~ s/\D//g; |
669
|
0
|
|
|
|
|
|
$params->{'desc'} =~ s/\D//g; |
670
|
0
|
|
|
|
|
|
$params->{'showall'} =~ s/\D//g; |
671
|
|
|
|
|
|
|
|
672
|
0
|
|
|
|
|
|
my $pattern = $params->{'pattern'}; |
673
|
0
|
|
|
|
|
|
my $limit = $params->{'limit'}; |
674
|
|
|
|
|
|
|
|
675
|
0
|
|
|
|
|
|
my $sort; |
676
|
0
|
0
|
|
|
|
|
if (defined($self->{'list_sort'}->{$params->{'sort'}})) { |
677
|
0
|
|
|
|
|
|
$sort = $params->{'sort'}; |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
else { |
680
|
0
|
|
|
|
|
|
$sort = $self->{'default_sort'}; |
681
|
|
|
|
|
|
|
} |
682
|
|
|
|
|
|
|
|
683
|
0
|
|
|
|
|
|
my $last_sort; |
684
|
0
|
0
|
|
|
|
|
if (defined($self->{'list_sort'}->{$params->{'last_sort'}})) { |
685
|
0
|
|
|
|
|
|
$last_sort = $params->{'last_sort'}; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
else { |
688
|
0
|
|
|
|
|
|
$last_sort = $self->{'default_sort'}; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
|
691
|
0
|
|
|
|
|
|
my $desc = $params->{'desc'}; |
692
|
0
|
|
0
|
|
|
|
my $showall = $params->{'showall'} || 0; |
693
|
|
|
|
|
|
|
|
694
|
0
|
0
|
|
|
|
|
my $count = ($params->{'count'})?$params->{'count'}:$self->{'pager'}->{'count'}; |
695
|
0
|
0
|
|
|
|
|
my $page = ($params->{'page'} )?$params->{'page'} :1; |
696
|
|
|
|
|
|
|
|
697
|
0
|
0
|
|
|
|
|
my $offset = ($params->{'start'})?$params->{'start'}:$count * ($page -1); |
698
|
|
|
|
|
|
|
|
699
|
0
|
|
|
|
|
|
my @search_params = $self->{'list_param_parser'}->($self,$dbh,$params); |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
# create the initial list of columns |
702
|
0
|
|
|
|
|
|
my @columns; |
703
|
0
|
|
|
|
|
|
foreach ($self->{'pkey'}, @{$self->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
704
|
0
|
0
|
|
|
|
|
if ($_ =~ /\./) { |
705
|
0
|
|
|
|
|
|
push(@columns,$_); |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
else { |
708
|
0
|
|
|
|
|
|
push(@columns,"$self->{'table'}.$_"); |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
0
|
0
|
|
|
|
|
if (ref($additional_constraint)) { |
713
|
0
|
0
|
|
|
|
|
if (defined($additional_constraint->{'additional_column'})) { |
714
|
0
|
|
|
|
|
|
push(@columns, $additional_constraint->{'additional_column'}); |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
# figure out tables to join against |
719
|
0
|
|
|
|
|
|
my @joins; |
720
|
0
|
0
|
|
|
|
|
if ($self->{'references'}) { |
721
|
0
|
|
|
|
|
|
foreach my $join ( sort { ($a->{'fkey'} =~ /\./) <=> ($b->{'fkey'} =~ /\./) } @{$self->{'references'}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
722
|
0
|
0
|
|
|
|
|
my $fkey = ($join->{'fkey'} =~ /\./)?$join->{'fkey'} : $self->{'table'}.'.'.$join->{'fkey'}; |
723
|
|
|
|
|
|
|
|
724
|
0
|
|
|
|
|
|
push(@joins,"LEFT JOIN $join->{'table'} ON $fkey = $join->{'table'}.$join->{'pkey'}"); |
725
|
|
|
|
|
|
|
|
726
|
0
|
|
|
|
|
|
foreach (@{$join->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
727
|
0
|
|
|
|
|
|
push(@columns,"$join->{'table'}.$_"); |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
0
|
|
|
|
|
|
foreach my $join (@{$self->{'joins'}},@{$self->{'list_joins'}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
733
|
0
|
|
|
|
|
|
my @join_clauses = (); |
734
|
0
|
|
|
|
|
|
my $join_stmt = "$join->{type} JOIN $join->{'table'} ON "; |
735
|
|
|
|
|
|
|
|
736
|
0
|
0
|
0
|
|
|
|
if($join->{'pkey'} and $join->{'fkey'}){ |
737
|
0
|
0
|
|
|
|
|
push(@join_clauses, |
|
|
0
|
|
|
|
|
|
738
|
|
|
|
|
|
|
(($join->{'fkey'} =~ /\./) ? $join->{'fkey'} : $self->{'table'} .".". $join->{'fkey'}). |
739
|
|
|
|
|
|
|
" = " . |
740
|
|
|
|
|
|
|
(($join->{'pkey'} =~ /\./) ? $join->{'pkey'} : $join->{'table'} .".". $join->{'pkey'}) |
741
|
|
|
|
|
|
|
); |
742
|
|
|
|
|
|
|
} |
743
|
|
|
|
|
|
|
|
744
|
0
|
0
|
|
|
|
|
if($join->{'extra'}){ |
745
|
0
|
0
|
|
|
|
|
push(@join_clauses, $join->{'extra'}) unless ref $join->{'extra'}; |
746
|
0
|
0
|
|
|
|
|
push(@join_clauses, @{$join->{'extra'}}) if ref($join->{'extra'}) eq 'ARRAY'; |
|
0
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
0
|
0
|
|
|
|
|
next unless scalar @join_clauses; |
750
|
0
|
|
|
|
|
|
push(@joins,$join_stmt . join(" AND ", @join_clauses)); |
751
|
|
|
|
|
|
|
|
752
|
0
|
|
|
|
|
|
foreach (@{$join->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
753
|
0
|
0
|
|
|
|
|
if ($_ =~ /\./) { |
754
|
0
|
|
|
|
|
|
push(@columns,$_); |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
else { |
757
|
0
|
|
|
|
|
|
push(@columns,$join->{'table'}.".$_"); |
758
|
|
|
|
|
|
|
} |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
|
762
|
0
|
0
|
0
|
|
|
|
if (defined($self->{'list_search'}->{$limit}) && $self->safe_text($pattern)) { |
763
|
0
|
|
|
|
|
|
push(@search_params,[$limit,'LIKE',$pattern]); |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
0
|
0
|
|
|
|
|
if ($additional_constraint) { |
767
|
0
|
0
|
0
|
|
|
|
if (ref($additional_constraint) eq "HASH" and |
|
|
0
|
|
|
|
|
|
768
|
|
|
|
|
|
|
defined($additional_constraint->{'additional_constraint'})) { |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# make sure our additional constraint won't break the sql |
771
|
0
|
|
|
|
|
|
my $ac = $additional_constraint->{'additional_constraint'}; |
772
|
0
|
|
|
|
|
|
$ac =~ s/^\s*(where|and|or)\s+//go; |
773
|
0
|
|
|
|
|
|
push(@search_params,$ac); |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
elsif (!ref($additional_constraint)) { |
776
|
0
|
|
|
|
|
|
$additional_constraint =~ s/^\s*(where|and|or)\s+//go; |
777
|
0
|
|
|
|
|
|
push(@search_params,$additional_constraint); |
778
|
|
|
|
|
|
|
} |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
0
|
|
|
|
|
|
$self->debug(\@search_params); |
782
|
|
|
|
|
|
|
# Make sure the search params are sane |
783
|
0
|
|
|
|
|
|
my @where; |
784
|
|
|
|
|
|
|
my @values; |
785
|
0
|
|
|
|
|
|
foreach my $clause (@search_params) { |
786
|
0
|
|
|
|
|
|
my $r = ref($clause); |
787
|
0
|
0
|
|
|
|
|
if ($r eq "ARRAY") { |
|
|
0
|
|
|
|
|
|
788
|
0
|
0
|
|
|
|
|
unless ($clause->[0] =~ /\./) { |
789
|
0
|
|
|
|
|
|
$clause->[0] = $self->{'table'}.'.'.$clause->[0]; |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
0
|
0
|
|
|
|
|
next unless grep { $clause->[0] } @columns; |
|
0
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
|
794
|
0
|
0
|
|
|
|
|
if (scalar(@{$clause}) eq 1) { |
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
795
|
0
|
|
|
|
|
|
push(@where,"$r->[0] = 1"); |
796
|
|
|
|
|
|
|
} |
797
|
|
|
|
|
|
|
elsif (scalar(@{$clause}) == 3) { |
798
|
0
|
0
|
0
|
|
|
|
if ($clause->[1] =~ /^is(\s+not)?$/i && $clause->[2] =~ /^null$/i) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
799
|
0
|
|
|
|
|
|
push(@where,join(" ",@{$clause})); |
|
0
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
elsif ($clause->[1] =~ /^(=|!=|>|<|>=|<=)/) { |
802
|
0
|
|
|
|
|
|
push(@where,"$clause->[0] $clause->[1] ?"); |
803
|
0
|
|
|
|
|
|
push(@values,$clause->[2]); |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
elsif ($clause->[1] =~ /^(not )?\s*like/i) { |
806
|
0
|
0
|
|
|
|
|
if ($dbh->get_info(17) eq "SQLite") { |
807
|
0
|
|
|
|
|
|
push(@where,"$clause->[0] $clause->[1] ? || '%'"); |
808
|
|
|
|
|
|
|
} |
809
|
|
|
|
|
|
|
else { |
810
|
0
|
|
|
|
|
|
push(@where,"$clause->[0] $clause->[1] concat(?,'%')"); |
811
|
|
|
|
|
|
|
} |
812
|
0
|
|
|
|
|
|
push(@values,$clause->[2]); |
813
|
|
|
|
|
|
|
} |
814
|
|
|
|
|
|
|
} |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
elsif (!$r) { |
817
|
0
|
|
|
|
|
|
push(@where,$clause); |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
else { |
820
|
0
|
|
|
|
|
|
return $self->exception("each entry in the search params list must either be a scalar or a 3 element array"); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
0
|
|
|
|
|
|
my $where = ' '; |
825
|
|
|
|
|
|
|
|
826
|
0
|
0
|
|
|
|
|
if (scalar(@where)) { |
827
|
0
|
|
|
|
|
|
$where = "\nWHERE\n".join(" AND\n",@where)."\n"; |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
|
830
|
0
|
0
|
|
|
|
|
if ($self->{'group_by'}) { |
831
|
0
|
|
|
|
|
|
$where .= "GROUP BY ".$self->{'group_by'}."\n"; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
# From the DBI docs. This will give us the database server name. |
835
|
0
|
0
|
|
|
|
|
my $is_mysql = ($dbh->get_info(17) eq "MySQL")?1:0; |
836
|
|
|
|
|
|
|
|
837
|
0
|
0
|
|
|
|
|
my $select_stmt = |
838
|
|
|
|
|
|
|
"SELECT". (($is_mysql)?" SQL_CALC_FOUND_ROWS ": " "). |
839
|
|
|
|
|
|
|
join(",\n",@columns)."\n". |
840
|
|
|
|
|
|
|
"FROM $self->{'table'}\n". |
841
|
|
|
|
|
|
|
join("\n",@joins). |
842
|
|
|
|
|
|
|
$where; |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
|
845
|
0
|
|
|
|
|
|
my $n_desc = $desc; |
846
|
0
|
0
|
|
|
|
|
if (defined($sort)) { |
847
|
0
|
|
|
|
|
|
my $q = $self->{'list_sort'}->{$sort}; |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
# if we're sorting on the same key as before, then we have the chance to go descending |
850
|
0
|
0
|
|
|
|
|
if ($sort eq $last_sort) { |
851
|
0
|
0
|
|
|
|
|
if ($desc eq '1') { |
852
|
0
|
|
|
|
|
|
$q =~ s/,/ DESC, /g; |
853
|
0
|
|
|
|
|
|
$q .= " DESC"; |
854
|
0
|
|
|
|
|
|
$n_desc = 0; # say that we are ascending the next time. |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
else { |
857
|
0
|
|
|
|
|
|
$n_desc = 1; # say that we are descending the next time. |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
else { |
861
|
0
|
|
|
|
|
|
$n_desc = 1; # we just sorted ascending, so now we need to say to sort descending |
862
|
0
|
|
|
|
|
|
$desc = 0; |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
|
865
|
0
|
|
|
|
|
|
$select_stmt .= "ORDER BY $q\n"; |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
else { |
868
|
|
|
|
|
|
|
# bogus, fry it. |
869
|
0
|
|
|
|
|
|
$sort = undef; |
870
|
0
|
|
|
|
|
|
$last_sort = undef; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
0
|
0
|
|
|
|
|
$select_stmt .= "LIMIT $count OFFSET $offset\n" unless $showall; |
874
|
|
|
|
|
|
|
|
875
|
0
|
|
|
|
|
|
$self->debug($select_stmt); |
876
|
0
|
|
|
|
|
|
my $page_set = $dbh->selectall_arrayref($select_stmt,undef,@values); |
877
|
|
|
|
|
|
|
|
878
|
0
|
|
|
|
|
|
my $res_count; |
879
|
0
|
0
|
|
|
|
|
if ($is_mysql) { |
880
|
0
|
|
|
|
|
|
$res_count = $dbh->selectall_arrayref("SELECT FOUND_ROWS()")->[0]->[0]; |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
else { |
883
|
0
|
|
|
|
|
|
my $count_stmt = "SELECT count(*) FROM $self->{table} ".join("\n",@joins).$where; |
884
|
0
|
|
|
|
|
|
$res_count = $dbh->selectall_arrayref($count_stmt,undef,@values)->[0]->[0]; |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
0
|
|
|
|
|
|
my %return; |
888
|
|
|
|
|
|
|
|
889
|
0
|
|
|
|
|
|
$return{'SORT_PARAMS'} = $self->mkurlparams( |
890
|
|
|
|
|
|
|
{ |
891
|
|
|
|
|
|
|
'limit' => $limit, |
892
|
|
|
|
|
|
|
'pattern' => $pattern, |
893
|
|
|
|
|
|
|
'showall' => $showall, |
894
|
|
|
|
|
|
|
'desc' => $n_desc, |
895
|
|
|
|
|
|
|
'last_sort' => $sort |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
); |
898
|
|
|
|
|
|
|
|
899
|
0
|
|
|
|
|
|
$return{'LIMIT'} = $self->prep_select($self->{'list_search_items'},$limit); |
900
|
0
|
|
|
|
|
|
$return{'PATTERN'} = $pattern; |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
|
903
|
0
|
|
|
|
|
|
$return{'NUM_MATCHES'} = $res_count; |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
################################################################################ |
906
|
|
|
|
|
|
|
# prep data for the template |
907
|
|
|
|
|
|
|
################################################################################ |
908
|
0
|
|
|
|
|
|
my %dates; |
909
|
0
|
|
|
|
|
|
foreach (@{$self->{'dates'}}) { |
|
0
|
|
|
|
|
|
|
910
|
0
|
|
|
|
|
|
$dates{$_} = 1; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
0
|
|
|
|
|
|
my %times; |
914
|
0
|
|
|
|
|
|
foreach (@{$self->{'times'}}) { |
|
0
|
|
|
|
|
|
|
915
|
0
|
|
|
|
|
|
$times{$_} = 1; |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
|
918
|
0
|
|
|
|
|
|
foreach (@{$page_set}) { |
|
0
|
|
|
|
|
|
|
919
|
0
|
|
|
|
|
|
my %v; |
920
|
0
|
|
|
|
|
|
for (my $i=0; $i < @columns; $i++) { |
921
|
0
|
|
|
|
|
|
my $key = $columns[$i]; |
922
|
|
|
|
|
|
|
|
923
|
0
|
|
|
|
|
|
$key =~ s/$self->{'table'}\.//; # take of the table name in front |
924
|
|
|
|
|
|
|
# we either end up with the column name from the primay table, |
925
|
|
|
|
|
|
|
# or the joined table name + column |
926
|
0
|
|
|
|
|
|
$key =~ s/^.* AS //i; |
927
|
|
|
|
|
|
|
|
928
|
0
|
|
|
|
|
|
$v{$key} = $_->[$i]; |
929
|
|
|
|
|
|
|
|
930
|
0
|
0
|
|
|
|
|
if (defined($dates{$key})) { |
|
|
0
|
|
|
|
|
|
931
|
0
|
|
|
|
|
|
$v{$key} = $self->sql_to_date($v{$key}); |
932
|
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
|
elsif (defined($times{$key})) { |
934
|
0
|
|
|
|
|
|
$v{$key} = $self->sql_to_time($v{$key}); |
935
|
|
|
|
|
|
|
} |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
0
|
|
|
|
|
|
push(@{$return{'DATA'}},\%v); |
|
0
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
} |
940
|
|
|
|
|
|
|
|
941
|
0
|
|
|
|
|
|
$self->{'success'} = 1; |
942
|
0
|
|
|
|
|
|
return { %return, $self->{'pager'}->paginate($params,$res_count) }; |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
sub view { |
946
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
947
|
0
|
|
|
|
|
|
my $p = shift; |
948
|
0
|
|
0
|
|
|
|
my $additional_constraint = shift || ""; |
949
|
|
|
|
|
|
|
|
950
|
0
|
|
|
|
|
|
$self->{'success'} = 0; |
951
|
|
|
|
|
|
|
|
952
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
953
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
954
|
|
|
|
|
|
|
|
955
|
0
|
0
|
|
|
|
|
unless ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) { |
956
|
0
|
|
|
|
|
|
return $self->display_error("Invalid ID"); |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
# make sure our additional constraint won't break the sql |
960
|
0
|
|
|
|
|
|
$additional_constraint =~ s/^\s*(where|and|or)\s+//go; |
961
|
0
|
0
|
|
|
|
|
if (length($additional_constraint)) { |
962
|
0
|
|
|
|
|
|
$additional_constraint = "AND $additional_constraint"; |
963
|
|
|
|
|
|
|
} |
964
|
|
|
|
|
|
|
|
965
|
0
|
|
|
|
|
|
my @list; |
966
|
0
|
|
|
|
|
|
foreach ($self->{'pkey'}, @{$self->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
967
|
0
|
|
|
|
|
|
push(@list,"$self->{'table'}.$_"); |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
# figure out tables to join against |
971
|
0
|
|
|
|
|
|
my @joins; |
972
|
0
|
|
|
|
|
|
foreach my $join (@{$self->{'references'}}) { |
|
0
|
|
|
|
|
|
|
973
|
0
|
|
|
|
|
|
push(@joins,"LEFT JOIN $join->{'table'} ON $self->{'table'}.$join->{'fkey'} = $join->{'table'}.$join->{'pkey'}"); |
974
|
0
|
|
|
|
|
|
foreach (@{$join->{'columns'}}) { |
|
0
|
|
|
|
|
|
|
975
|
0
|
|
|
|
|
|
push(@list,"$join->{'table'}.$_"); |
976
|
|
|
|
|
|
|
} |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
0
|
|
|
|
|
|
foreach my $join (@{$self->{joins}},@{$self->{view_joins}}) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
980
|
0
|
|
|
|
|
|
my @join_clauses = (); |
981
|
0
|
|
|
|
|
|
my $join_stmt = "$join->{type} JOIN $join->{'table'} ON "; |
982
|
|
|
|
|
|
|
|
983
|
0
|
0
|
0
|
|
|
|
if($join->{'pkey'} and $join->{'fkey'}){ |
984
|
0
|
0
|
|
|
|
|
push(@join_clauses, |
|
|
0
|
|
|
|
|
|
985
|
|
|
|
|
|
|
(($join->{'fkey'} =~ /\./) ? $join->{'fkey'} : $self->{'table'} .".". $join->{'fkey'}). |
986
|
|
|
|
|
|
|
" = " . |
987
|
|
|
|
|
|
|
(($join->{'pkey'} =~ /\./) ? $join->{'pkey'} : $join->{'table'} .".". $join->{'pkey'}) |
988
|
|
|
|
|
|
|
); |
989
|
|
|
|
|
|
|
} |
990
|
|
|
|
|
|
|
|
991
|
0
|
0
|
|
|
|
|
if($join->{'extra'}){ |
992
|
0
|
0
|
|
|
|
|
push(@join_clauses, $join->{'extra'}) unless ref $join->{'extra'}; |
993
|
0
|
0
|
|
|
|
|
push(@join_clauses, @{$join->{'extra'}}) if ref($join->{'extra'}) eq 'ARRAY'; |
|
0
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
0
|
0
|
|
|
|
|
next unless scalar @join_clauses; |
997
|
0
|
|
|
|
|
|
push(@joins,$join_stmt . join(" AND ", @join_clauses)); |
998
|
|
|
|
|
|
|
|
999
|
0
|
|
|
|
|
|
foreach (@{$join->{columns}}) { |
|
0
|
|
|
|
|
|
|
1000
|
0
|
0
|
|
|
|
|
if ($_ =~ /\./) { |
1001
|
0
|
|
|
|
|
|
push(@list,$_); |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
else { |
1004
|
0
|
|
|
|
|
|
push(@list,$join->{'table'}.".$_"); |
1005
|
|
|
|
|
|
|
} |
1006
|
|
|
|
|
|
|
} |
1007
|
|
|
|
|
|
|
} |
1008
|
|
|
|
|
|
|
|
1009
|
0
|
|
|
|
|
|
my $select_statement = " |
1010
|
|
|
|
|
|
|
SELECT " . |
1011
|
|
|
|
|
|
|
join(",\n",@list). " |
1012
|
|
|
|
|
|
|
FROM |
1013
|
|
|
|
|
|
|
$self->{'table'} ". |
1014
|
|
|
|
|
|
|
join("\n",@joins). " |
1015
|
|
|
|
|
|
|
WHERE |
1016
|
|
|
|
|
|
|
$self->{'table'}.$self->{'pkey'} = ? |
1017
|
|
|
|
|
|
|
$additional_constraint"; |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
#$self->debug($select_statement); |
1020
|
0
|
|
|
|
|
|
my $res = $dbh->selectall_arrayref($select_statement,undef,$params->{$self->{'pkey'}}); |
1021
|
|
|
|
|
|
|
|
1022
|
0
|
|
|
|
|
|
my %v; |
1023
|
0
|
0
|
0
|
|
|
|
if (defined($res) && defined($res->[0])) { |
1024
|
|
|
|
|
|
|
# copy values into template |
1025
|
0
|
|
|
|
|
|
$v{$self->{'pkey'}} = $params->{$self->{'pkey'}}; |
1026
|
|
|
|
|
|
|
|
1027
|
0
|
|
|
|
|
|
for (my $i=0; $i <= $#list; $i++) { |
1028
|
0
|
|
|
|
|
|
my $key = $list[$i]; |
1029
|
|
|
|
|
|
|
|
1030
|
0
|
|
|
|
|
|
$key =~ s/$self->{'table'}\.//; # take of the table name in front |
1031
|
|
|
|
|
|
|
|
1032
|
0
|
|
|
|
|
|
$v{$key} = $res->[0]->[$i]; |
1033
|
|
|
|
|
|
|
} |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
else { |
1036
|
0
|
|
|
|
|
|
return $self->display_error("Record not found"); |
1037
|
|
|
|
|
|
|
} |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
# pretty up dates |
1040
|
0
|
|
|
|
|
|
foreach (@{$self->{'dates'}}) { |
|
0
|
|
|
|
|
|
|
1041
|
0
|
|
|
|
|
|
$v{$_} = $self->sql_to_date($v{$_}); |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
# pretty up times |
1045
|
0
|
|
|
|
|
|
foreach (@{$self->{'times'}}) { |
|
0
|
|
|
|
|
|
|
1046
|
0
|
|
|
|
|
|
$v{$_} = $self->sql_to_time($v{$_}); |
1047
|
|
|
|
|
|
|
} |
1048
|
|
|
|
|
|
|
|
1049
|
0
|
|
|
|
|
|
$self->{'success'} = 1; |
1050
|
0
|
|
|
|
|
|
return \%v; |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
sub toggle { |
1054
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1055
|
0
|
|
|
|
|
|
my $p = shift; |
1056
|
0
|
|
|
|
|
|
my $column = shift; |
1057
|
|
|
|
|
|
|
|
1058
|
0
|
|
|
|
|
|
$self->{'success'} = 0; |
1059
|
|
|
|
|
|
|
|
1060
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
1061
|
0
|
|
|
|
|
|
my $params = $p->{'params'}; |
1062
|
|
|
|
|
|
|
|
1063
|
0
|
0
|
|
|
|
|
unless ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) { |
1064
|
0
|
|
|
|
|
|
return $self->display_error("Invalid ID"); |
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
|
1067
|
0
|
0
|
|
|
|
|
unless ($column =~ /^\w+$/) { |
1068
|
0
|
|
|
|
|
|
return $self->display_error("Invalid toggle column"); |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
0
|
|
|
|
|
|
$dbh->do(" |
1072
|
|
|
|
|
|
|
UPDATE |
1073
|
|
|
|
|
|
|
$self->{'table'} |
1074
|
|
|
|
|
|
|
SET |
1075
|
|
|
|
|
|
|
$column = ($column+1)%2 |
1076
|
|
|
|
|
|
|
WHERE |
1077
|
|
|
|
|
|
|
$self->{'pkey'} = ?", |
1078
|
|
|
|
|
|
|
undef, |
1079
|
|
|
|
|
|
|
$params->{$self->{'pkey'}}); |
1080
|
|
|
|
|
|
|
|
1081
|
0
|
|
|
|
|
|
$self->{'success'} = 1; |
1082
|
0
|
|
|
|
|
|
return 1; |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
sub get_insert_id { |
1086
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1087
|
0
|
|
|
|
|
|
my $p = shift; |
1088
|
|
|
|
|
|
|
|
1089
|
0
|
|
|
|
|
|
my $dbh = $p->{'dbh'}; |
1090
|
|
|
|
|
|
|
|
1091
|
0
|
|
|
|
|
|
return $p->{dbh}->last_insert_id(undef,undef,$self->{'table'},$self->{'pkey'}); |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
1; |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
################################################################################ |
1097
|
|
|
|
|
|
|
# Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org). |
1098
|
|
|
|
|
|
|
# All rights reserved. |
1099
|
|
|
|
|
|
|
# |
1100
|
|
|
|
|
|
|
# You may use and distribute Apache::Voodoo under the terms described in the |
1101
|
|
|
|
|
|
|
# LICENSE file include in this package. The summary is it's a legalese version |
1102
|
|
|
|
|
|
|
# of the Artistic License :) |
1103
|
|
|
|
|
|
|
# |
1104
|
|
|
|
|
|
|
################################################################################ |