| 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 |  |  |  |  |  |  | ################################################################################ |