| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package # hide from PAUSE | 
| 2 |  |  |  |  |  |  | DBIx::DBO::DBD; | 
| 3 |  |  |  |  |  |  |  | 
| 4 | 11 |  |  | 11 |  | 68 | use strict; | 
|  | 11 |  |  |  |  | 27 |  | 
|  | 11 |  |  |  |  | 11158 |  | 
| 5 | 11 |  |  | 11 |  | 79 | use warnings; | 
|  | 11 |  |  |  |  | 22 |  | 
|  | 11 |  |  |  |  | 1232 |  | 
| 6 | 11 |  |  | 11 |  | 59 | use Carp 'croak'; | 
|  | 11 |  |  |  |  | 22 |  | 
|  | 11 |  |  |  |  | 7101 |  | 
| 7 | 11 |  |  | 11 |  | 77 | use Scalar::Util 'blessed'; | 
|  | 11 |  |  |  |  | 20 |  | 
|  | 11 |  |  |  |  | 881 |  | 
| 8 | 11 |  |  | 11 |  | 64 | use constant PLACEHOLDER => "\x{b1}\x{a4}\x{221e}"; | 
|  | 11 |  |  |  |  | 20 |  | 
|  | 11 |  |  |  |  | 65280 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | our @CARP_NOT = qw(DBIx::DBO DBIx::DBO::DBD DBIx::DBO::Table DBIx::DBO::Query DBIx::DBO::Row); | 
| 11 |  |  |  |  |  |  | *DBIx::DBO::CARP_NOT = \@CARP_NOT; | 
| 12 |  |  |  |  |  |  | *DBIx::DBO::Table::CARP_NOT = \@CARP_NOT; | 
| 13 |  |  |  |  |  |  | *DBIx::DBO::Query::CARP_NOT = \@CARP_NOT; | 
| 14 |  |  |  |  |  |  | *DBIx::DBO::Row::CARP_NOT = \@CARP_NOT; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | our $placeholder = PLACEHOLDER; | 
| 17 |  |  |  |  |  |  | $placeholder = qr/\Q$placeholder/; | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | sub _isa { | 
| 20 | 2068 |  |  | 2068 |  | 4097 | my($me, @class) = @_; | 
| 21 | 2068 | 100 |  |  |  | 9826 | if (blessed $me) { | 
| 22 | 820 |  | 100 |  |  | 8934 | $me->isa($_) and return 1 for @class; | 
| 23 |  |  |  |  |  |  | } | 
| 24 |  |  |  |  |  |  | } | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | sub _init_dbo { | 
| 27 | 13 |  |  | 13 |  | 30 | my($class, $me) = @_; | 
| 28 | 13 |  |  |  |  | 75 | return $me; | 
| 29 |  |  |  |  |  |  | } | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | sub _get_table_schema { | 
| 32 | 0 |  |  | 0 |  | 0 | my($class, $me, $schema, $table) = @_; | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 0 |  |  |  |  | 0 | my $q_schema = $schema; | 
| 35 | 0 |  |  |  |  | 0 | my $q_table = $table; | 
| 36 | 0 | 0 |  |  |  | 0 | $q_schema =~ s/([\\_%])/\\$1/g if defined $q_schema; | 
| 37 | 0 |  |  |  |  | 0 | $q_table =~ s/([\\_%])/\\$1/g; | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | # First try just these types | 
| 40 | 0 |  |  |  |  | 0 | my $info = $me->rdbh->table_info(undef, $q_schema, $q_table, | 
| 41 |  |  |  |  |  |  | 'TABLE,VIEW,GLOBAL TEMPORARY,LOCAL TEMPORARY,SYSTEM TABLE')->fetchall_arrayref; | 
| 42 |  |  |  |  |  |  | # Then if we found nothing, try any type | 
| 43 | 0 | 0 | 0 |  |  | 0 | $info = $me->rdbh->table_info(undef, $q_schema, $q_table)->fetchall_arrayref if $info and @$info == 0; | 
| 44 | 0 | 0 | 0 |  |  | 0 | croak 'Invalid table: '.$class->_qi($me, $schema, $table) unless $info and @$info == 1 and $info->[0][2] eq $table; | 
|  |  |  | 0 |  |  |  |  | 
| 45 | 0 |  |  |  |  | 0 | return $info->[0][1]; | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | sub _get_column_info { | 
| 49 | 3 |  |  | 3 |  | 8 | my($class, $me, $schema, $table) = @_; | 
| 50 |  |  |  |  |  |  |  | 
| 51 | 3 |  |  |  |  | 13 | my $cols = $me->rdbh->column_info(undef, $schema, $table, '%'); | 
| 52 | 3 |  | 100 |  |  | 10808 | $cols = $cols && $cols->fetchall_arrayref({}) || []; | 
| 53 | 3 | 100 |  |  |  | 408 | croak 'Invalid table: '.$class->_qi($me, $schema, $table) unless @$cols; | 
| 54 |  |  |  |  |  |  |  | 
| 55 | 2 |  |  |  |  | 5 | return map { $_->{COLUMN_NAME} => $_->{ORDINAL_POSITION} } @$cols; | 
|  | 5 |  |  |  |  | 31 |  | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | sub _get_table_info { | 
| 59 | 3 |  |  | 3 |  | 12 | my($class, $me, $schema, $table) = @_; | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 3 |  |  |  |  | 81 | my %h; | 
| 62 | 3 |  |  |  |  | 27 | $h{Column_Idx} = { $class->_get_column_info($me, $schema, $table) }; | 
| 63 | 2 |  |  |  |  | 5 | $h{Columns} = [ sort { $h{Column_Idx}{$a} <=> $h{Column_Idx}{$b} } keys %{$h{Column_Idx}} ]; | 
|  | 4 |  |  |  |  | 15 |  | 
|  | 2 |  |  |  |  | 14 |  | 
| 64 |  |  |  |  |  |  |  | 
| 65 | 2 |  |  |  |  | 6 | $h{PrimaryKeys} = []; | 
| 66 | 2 |  |  |  |  | 25 | $class->_set_table_key_info($me, $schema, $table, \%h); | 
| 67 |  |  |  |  |  |  |  | 
| 68 | 2 | 50 |  |  |  | 227 | return $me->{TableInfo}{defined $schema ? $schema : ''}{$table} = \%h; | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | sub _set_table_key_info { | 
| 72 | 2 |  |  | 2 |  | 4 | my($class, $me, $schema, $table, $h) = @_; | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 2 | 50 |  |  |  | 8 | if (my $sth = $me->rdbh->primary_key_info(undef, $schema, $table)) { | 
| 75 | 2 |  |  |  |  | 1424 | $h->{PrimaryKeys}[$_->{KEY_SEQ} - 1] = $_->{COLUMN_NAME} for @{$sth->fetchall_arrayref({})}; | 
|  | 2 |  |  |  |  | 9 |  | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | sub _unquote_table { | 
| 80 | 18 |  |  | 18 |  | 38 | my($class, $me, $table) = @_; | 
| 81 |  |  |  |  |  |  | # TODO: Better splitting of: schema.table or `schema`.`table` or "schema"."table"@"catalog" or ... | 
| 82 | 18 | 50 |  |  |  | 167 | $table =~ /^(?:("|)(.+)\1\.|)("|)(.+)\3$/ or croak "Invalid table: \"$table\""; | 
| 83 | 18 |  |  |  |  | 134 | return ($2, $4); | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | sub _selectrow_array { | 
| 87 | 3 |  |  | 3 |  | 9 | my($class, $me, $sql, $attr, @bind) = @_; | 
| 88 | 3 |  |  |  |  | 11 | $class->_sql($me, $sql, @bind); | 
| 89 | 3 |  |  |  |  | 12 | $me->rdbh->selectrow_array($sql, $attr, @bind); | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | sub _selectrow_arrayref { | 
| 93 | 4 |  |  | 4 |  | 13 | my($class, $me, $sql, $attr, @bind) = @_; | 
| 94 | 4 |  |  |  |  | 16 | $class->_sql($me, $sql, @bind); | 
| 95 | 4 |  |  |  |  | 13 | $me->rdbh->selectrow_arrayref($sql, $attr, @bind); | 
| 96 |  |  |  |  |  |  | } | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | sub _selectrow_hashref { | 
| 99 | 1 |  |  | 1 |  | 3 | my($class, $me, $sql, $attr, @bind) = @_; | 
| 100 | 1 |  |  |  |  | 4 | $class->_sql($me, $sql, @bind); | 
| 101 | 1 |  |  |  |  | 3 | $me->rdbh->selectrow_hashref($sql, $attr, @bind); | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | sub _selectall_arrayref { | 
| 105 | 4 |  |  | 4 |  | 12 | my($class, $me, $sql, $attr, @bind) = @_; | 
| 106 | 4 |  |  |  |  | 16 | $class->_sql($me, $sql, @bind); | 
| 107 | 4 |  |  |  |  | 94 | $me->rdbh->selectall_arrayref($sql, $attr, @bind); | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | sub _selectall_hashref { | 
| 111 | 1 |  |  | 1 |  | 5 | my($class, $me, $sql, $key, $attr, @bind) = @_; | 
| 112 | 1 |  |  |  |  | 5 | $class->_sql($me, $sql, @bind); | 
| 113 | 1 |  |  |  |  | 5 | $me->rdbh->selectall_hashref($sql, $key, $attr, @bind); | 
| 114 |  |  |  |  |  |  | } | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | sub _qi { | 
| 117 | 206 |  |  | 206 |  | 592 | my($class, $me, @id) = @_; | 
| 118 | 206 | 100 |  |  |  | 779 | return $me->rdbh->quote_identifier(@id) if $me->config('QuoteIdentifier'); | 
| 119 |  |  |  |  |  |  | # Strip off any null/undef elements (ie schema) | 
| 120 | 2 |  | 100 |  |  | 41 | shift(@id) while @id and not (defined $id[0] and length $id[0]); | 
|  |  |  | 100 |  |  |  |  | 
| 121 | 2 |  |  |  |  | 20 | return join '.', @id; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | sub _sql { | 
| 125 | 86 |  |  | 86 |  | 153 | my $class = shift; | 
| 126 | 86 |  |  |  |  | 185 | my $me = shift; | 
| 127 | 86 | 50 |  |  |  | 259 | if (my $hook = $me->config('HookSQL')) { | 
| 128 | 86 |  |  |  |  | 318 | $hook->($me, @_); | 
| 129 |  |  |  |  |  |  | } | 
| 130 | 86 | 50 |  |  |  | 291 | my $dbg = $me->config('DebugSQL') or return; | 
| 131 | 0 |  |  |  |  | 0 | my($sql, @bind) = @_; | 
| 132 |  |  |  |  |  |  |  | 
| 133 | 0 | 0 |  |  |  | 0 | require Carp::Heavy if eval "$Carp::VERSION < 1.12"; | 
| 134 | 0 |  |  |  |  | 0 | my $loc = Carp::short_error_loc(); | 
| 135 | 0 |  |  |  |  | 0 | my %i = Carp::caller_info($loc); | 
| 136 | 0 |  |  |  |  | 0 | my $trace; | 
| 137 | 0 | 0 |  |  |  | 0 | if ($dbg > 1) { | 
| 138 | 0 |  |  |  |  | 0 | $trace = "\t$i{sub_name} called at $i{file} line $i{line}\n"; | 
| 139 | 0 |  |  |  |  | 0 | $trace .= "\t$i{sub_name} called at $i{file} line $i{line}\n" while %i = Carp::caller_info(++$loc); | 
| 140 |  |  |  |  |  |  | } else { | 
| 141 | 0 |  |  |  |  | 0 | $trace = "\t$i{sub} called at $i{file} line $i{line}\n"; | 
| 142 |  |  |  |  |  |  | } | 
| 143 | 0 |  |  |  |  | 0 | warn $sql."\n(".join(', ', map $me->rdbh->quote($_), @bind).")\n".$trace; | 
| 144 |  |  |  |  |  |  | } | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | sub _do { | 
| 147 | 20 |  |  | 20 |  | 58 | my($class, $me, $sql, $attr, @bind) = @_; | 
| 148 | 20 |  |  |  |  | 82 | $class->_sql($me, $sql, @bind); | 
| 149 | 20 |  |  |  |  | 81 | $me->dbh->do($sql, $attr, @bind); | 
| 150 |  |  |  |  |  |  | } | 
| 151 |  |  |  |  |  |  |  | 
| 152 |  |  |  |  |  |  | sub _build_sql_select { | 
| 153 | 44 |  |  | 44 |  | 89 | my($class, $me) = @_; | 
| 154 | 44 |  |  |  |  | 385 | my $sql = 'SELECT '.$class->_build_show($me); | 
| 155 | 44 |  |  |  |  | 196 | $sql .= ' FROM '.$class->_build_from($me); | 
| 156 | 44 |  |  |  |  | 74 | my $clause; | 
| 157 | 44 | 100 |  |  |  | 164 | $sql .= ' WHERE '.$clause if $clause = $class->_build_where($me); | 
| 158 | 44 | 100 |  |  |  | 177 | $sql .= ' GROUP BY '.$clause if $clause = $class->_build_group($me); | 
| 159 | 44 | 100 |  |  |  | 160 | $sql .= ' HAVING '.$clause if $clause = $class->_build_having($me); | 
| 160 | 44 | 100 |  |  |  | 148 | $sql .= ' ORDER BY '.$clause if $clause = $class->_build_order($me); | 
| 161 | 44 | 100 |  |  |  | 194 | $sql .= ' '.$clause if $clause = $class->_build_limit($me); | 
| 162 | 44 |  |  |  |  | 173 | return $sql; | 
| 163 |  |  |  |  |  |  | } | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | sub _bind_params_select { | 
| 166 | 50 |  |  | 50 |  | 93 | my($class, $me) = @_; | 
| 167 | 50 |  |  |  |  | 177 | my $h = $me->_build_data; | 
| 168 | 269 |  |  |  |  | 1563 | map { | 
| 169 | 50 | 100 |  |  |  | 98 | exists $h->{$_} ? @{$h->{$_}} : () | 
|  | 300 |  |  |  |  | 554 |  | 
| 170 |  |  |  |  |  |  | } qw(Show_Bind From_Bind Where_Bind Group_Bind Having_Bind Order_Bind); | 
| 171 |  |  |  |  |  |  | } | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | sub _build_sql_update { | 
| 174 | 6 |  |  | 6 |  | 16 | my($class, $me, @arg) = @_; | 
| 175 | 6 | 50 |  |  |  | 22 | croak 'Update is not valid with a GROUP BY clause' if $class->_build_group($me); | 
| 176 | 6 | 50 |  |  |  | 121 | croak 'Update is not valid with a HAVING clause' if $class->_build_having($me); | 
| 177 | 6 |  |  |  |  | 23 | my $sql = 'UPDATE '.$class->_build_from($me); | 
| 178 | 6 |  |  |  |  | 31 | $sql .= ' SET '.$class->_build_set($me, @arg); | 
| 179 | 6 |  |  |  |  | 13 | my $clause; | 
| 180 | 6 | 100 |  |  |  | 22 | $sql .= ' WHERE '.$clause if $clause = $class->_build_where($me); | 
| 181 | 6 | 50 |  |  |  | 21 | $sql .= ' ORDER BY '.$clause if $clause = $class->_build_order($me); | 
| 182 | 6 | 50 |  |  |  | 25 | $sql .= ' '.$clause if $clause = $class->_build_limit($me); | 
| 183 | 6 |  |  |  |  | 21 | $sql; | 
| 184 |  |  |  |  |  |  | } | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | sub _bind_params_update { | 
| 187 | 6 |  |  | 6 |  | 11 | my($class, $me) = @_; | 
| 188 | 6 |  |  |  |  | 20 | my $h = $me->_build_data; | 
| 189 | 21 |  |  |  |  | 58 | map { | 
| 190 | 6 | 100 |  |  |  | 13 | exists $h->{$_} ? @{$h->{$_}} : () | 
|  | 24 |  |  |  |  | 46 |  | 
| 191 |  |  |  |  |  |  | } qw(From_Bind Set_Bind Where_Bind Order_Bind); | 
| 192 |  |  |  |  |  |  | } | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | sub _build_sql_delete { | 
| 195 | 1 |  |  | 1 |  | 2 | my($class, $me) = @_; | 
| 196 | 1 | 50 |  |  |  | 6 | croak 'Delete is not valid with a GROUP BY clause' if $class->_build_group($me); | 
| 197 | 1 |  |  |  |  | 5 | my $sql = 'DELETE FROM '.$class->_build_from($me); | 
| 198 | 1 |  |  |  |  | 3 | my $clause; | 
| 199 | 1 | 50 |  |  |  | 5 | $sql .= ' WHERE '.$clause if $clause = $class->_build_where($me); | 
| 200 | 1 | 50 |  |  |  | 4 | $sql .= ' ORDER BY '.$clause if $clause = $class->_build_order($me); | 
| 201 | 1 | 50 |  |  |  | 5 | $sql .= ' '.$clause if $clause = $class->_build_limit($me); | 
| 202 | 1 |  |  |  |  | 4 | $sql; | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | sub _bind_params_delete { | 
| 206 | 1 |  |  | 1 |  | 4 | my($class, $me) = @_; | 
| 207 | 1 |  |  |  |  | 6 | my $h = $me->_build_data; | 
| 208 | 2 |  |  |  |  | 20 | map { | 
| 209 | 1 | 100 |  |  |  | 4 | exists $h->{$_} ? @{$h->{$_}} : () | 
|  | 3 |  |  |  |  | 9 |  | 
| 210 |  |  |  |  |  |  | } qw(From_Bind Where_Bind Order_Bind); | 
| 211 |  |  |  |  |  |  | } | 
| 212 |  |  |  |  |  |  |  | 
| 213 |  |  |  |  |  |  | sub _build_table { | 
| 214 | 28 |  |  | 28 |  | 44 | my($class, $me, $t) = @_; | 
| 215 | 28 |  |  |  |  | 121 | my $from = $t->_from($me->{build_data}); | 
| 216 | 28 |  |  |  |  | 371 | my $alias = $me->_table_alias($t); | 
| 217 | 28 | 100 |  |  |  | 102 | $alias = defined $alias ? ' '.$class->_qi($me, $alias) : ''; | 
| 218 | 28 |  |  |  |  | 319 | return $from.$alias; | 
| 219 |  |  |  |  |  |  | } | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | sub _build_show { | 
| 222 | 44 |  |  | 44 |  | 267 | my($class, $me) = @_; | 
| 223 | 44 |  |  |  |  | 191 | my $h = $me->_build_data; | 
| 224 | 44 | 100 |  |  |  | 199 | return $h->{show} if defined $h->{show}; | 
| 225 | 23 | 100 |  |  |  | 59 | my $distinct = $h->{Show_Distinct} ? 'DISTINCT ' : ''; | 
| 226 | 23 |  |  |  |  | 36 | undef @{$h->{Show_Bind}}; | 
|  | 23 |  |  |  |  | 68 |  | 
| 227 | 23 | 100 |  |  |  | 35 | return $h->{show} = $distinct.'*' unless @{$h->{Showing}}; | 
|  | 23 |  |  |  |  | 98 |  | 
| 228 | 14 |  |  |  |  | 25 | my @flds; | 
| 229 | 14 |  |  |  |  | 24 | for my $fld (@{$h->{Showing}}) { | 
|  | 14 |  |  |  |  | 42 |  | 
| 230 | 26 | 100 |  |  |  | 162 | if (_isa($fld, 'DBIx::DBO::Table', 'DBIx::DBO::Query')) { | 
| 231 | 8 |  | 66 |  |  | 34 | push @flds, $class->_qi($me, $me->_table_alias($fld) || $fld->{Name}).'.*'; | 
| 232 |  |  |  |  |  |  | } else { | 
| 233 | 18 | 50 |  |  |  | 55 | $h->{_subqueries}{$fld->[0][0]} = $fld->[0][0]->sql if _isa($fld->[0][0], 'DBIx::DBO::Query'); | 
| 234 | 18 |  |  |  |  | 80 | push @flds, $class->_build_val($me, $h->{Show_Bind}, @$fld); | 
| 235 |  |  |  |  |  |  | } | 
| 236 |  |  |  |  |  |  | } | 
| 237 | 14 |  |  |  |  | 154 | return $h->{show} = $distinct.join(', ', @flds); | 
| 238 |  |  |  |  |  |  | } | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | sub _build_from { | 
| 241 | 84 |  |  | 84 |  | 129 | my($class, $me) = @_; | 
| 242 | 84 |  |  |  |  | 240 | my $h = $me->_build_data; | 
| 243 | 84 | 100 |  |  |  | 414 | return $h->{from} if defined $h->{from}; | 
| 244 | 22 |  |  |  |  | 31 | undef @{$h->{From_Bind}}; | 
|  | 22 |  |  |  |  | 63 |  | 
| 245 | 22 |  |  |  |  | 80 | my @tables = $me->tables; | 
| 246 | 22 |  |  |  |  | 119 | $h->{from} = $class->_build_table($me, $tables[0]); | 
| 247 | 22 |  |  |  |  | 82 | for (my $i = 1; $i < @tables; $i++) { | 
| 248 | 6 |  |  |  |  | 29 | $h->{from} .= $h->{Join}[$i].$class->_build_table($me, $tables[$i]); | 
| 249 | 6 | 100 |  |  |  | 42 | $h->{from} .= ' ON '.join(' AND ', $class->_build_where_chunk($me, $h->{From_Bind}, 'OR', $h->{Join_On}[$i])) | 
| 250 |  |  |  |  |  |  | if $h->{Join_On}[$i]; | 
| 251 |  |  |  |  |  |  | } | 
| 252 | 22 |  |  |  |  | 82 | return $h->{from}; | 
| 253 |  |  |  |  |  |  | } | 
| 254 |  |  |  |  |  |  |  | 
| 255 |  |  |  |  |  |  | sub _parse_col_val { | 
| 256 | 69 |  |  | 69 |  | 243 | my($class, $me, $col, %c) = @_; | 
| 257 | 69 | 100 |  |  |  | 201 | unless (defined $c{Aliases}) { | 
| 258 | 54 |  |  |  |  | 559 | (my $method = (caller(1))[3]) =~ s/.*:://; | 
| 259 | 54 |  |  |  |  | 217 | $c{Aliases} = $class->_alias_preference($me, $method); | 
| 260 |  |  |  |  |  |  | } | 
| 261 | 69 | 100 |  |  |  | 272 | return $class->_parse_val($me, $col, Check => 'Column', %c) if ref $col; | 
| 262 | 39 |  |  |  |  | 135 | return [ $class->_parse_col($me, $col, $c{Aliases}) ]; | 
| 263 |  |  |  |  |  |  | } | 
| 264 |  |  |  |  |  |  |  | 
| 265 |  |  |  |  |  |  | # In some cases column aliases can be used, but this differs by DB and where in the statement it's used. | 
| 266 |  |  |  |  |  |  | # The $method is the method we were called from: (join_on|column|where|having|_del_where|order_by|group_by) | 
| 267 |  |  |  |  |  |  | # This method provides a way for DBs to override the default which is always 1 except for join_on. | 
| 268 |  |  |  |  |  |  | # Return values: 0 = Don't use aliases, 1 = Check aliases then columns, 2 = Check columns then aliases | 
| 269 |  |  |  |  |  |  | sub _alias_preference { | 
| 270 |  |  |  |  |  |  | #    my($class, $me, $method) = @_; | 
| 271 | 55 | 100 |  | 55 |  | 210 | return $_[2] eq 'join_on' ? 0 : 1; | 
| 272 |  |  |  |  |  |  | } | 
| 273 |  |  |  |  |  |  |  | 
| 274 |  |  |  |  |  |  | sub _valid_col { | 
| 275 | 61 |  |  | 61 |  | 109 | my($class, $me, $col) = @_; | 
| 276 |  |  |  |  |  |  | # Check if the object is an alias | 
| 277 | 61 | 100 |  |  |  | 258 | return $col if $col->[0] == $me; | 
| 278 |  |  |  |  |  |  | # TODO: Sub-queries | 
| 279 |  |  |  |  |  |  | # Check if the column is from one of our tables | 
| 280 | 51 |  |  |  |  | 182 | for my $tbl ($me->tables) { | 
| 281 | 62 | 100 |  |  |  | 332 | return $col if $col->[0] == $tbl; | 
| 282 |  |  |  |  |  |  | } | 
| 283 | 1 |  |  |  |  | 126 | croak 'Invalid column, the column is from a table not included in this query'; | 
| 284 |  |  |  |  |  |  | } | 
| 285 |  |  |  |  |  |  |  | 
| 286 |  |  |  |  |  |  | sub _parse_col { | 
| 287 | 101 |  |  | 101 |  | 976 | my($class, $me, $col, $_check_aliases) = @_; | 
| 288 | 101 | 100 |  |  |  | 258 | if (ref $col) { | 
| 289 | 14 | 50 |  |  |  | 36 | return $class->_valid_col($me, $col) if _isa($col, 'DBIx::DBO::Column'); | 
| 290 | 0 |  |  |  |  | 0 | croak 'Invalid column: '.$col; | 
| 291 |  |  |  |  |  |  | } | 
| 292 |  |  |  |  |  |  | # If $_check_aliases is not defined dont accept an alias | 
| 293 | 87 |  | 100 |  |  | 486 | $me->_inner_col($col, $_check_aliases || 0); | 
| 294 |  |  |  |  |  |  | } | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | sub _build_col { | 
| 297 | 147 |  |  | 147 |  | 305 | my($class, $me, $col) = @_; | 
| 298 | 147 |  |  |  |  | 585 | $class->_qi($me, $me->_table_alias($col->[0]), $col->[1]); | 
| 299 |  |  |  |  |  |  | } | 
| 300 |  |  |  |  |  |  |  | 
| 301 |  |  |  |  |  |  | sub _parse_val { | 
| 302 | 133 |  |  | 133 |  | 365 | my($class, $me, $fld, %c) = @_; | 
| 303 | 133 | 100 |  |  |  | 407 | $c{Check} = '' unless defined $c{Check}; | 
| 304 |  |  |  |  |  |  |  | 
| 305 | 133 |  |  |  |  | 243 | my $func; | 
| 306 |  |  |  |  |  |  | my $opt; | 
| 307 | 133 | 100 |  |  |  | 515 | if (ref $fld eq 'SCALAR') { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 308 | 15 | 0 |  |  |  | 39 | croak 'Invalid '.($c{Check} eq 'Column' ? 'column' : 'field').' reference (scalar ref to undef)' | 
|  |  | 50 |  |  |  |  |  | 
| 309 |  |  |  |  |  |  | unless defined $$fld; | 
| 310 | 15 |  |  |  |  | 23 | $func = $$fld; | 
| 311 | 15 |  |  |  |  | 31 | $fld = []; | 
| 312 |  |  |  |  |  |  | } elsif (ref $fld eq 'HASH') { | 
| 313 | 18 | 100 |  |  |  | 76 | $func = $fld->{FUNC} if exists $fld->{FUNC}; | 
| 314 | 18 | 100 |  |  |  | 119 | $opt->{AS} = $fld->{AS} if exists $fld->{AS}; | 
| 315 | 18 | 100 |  |  |  | 63 | if (exists $fld->{ORDER}) { | 
| 316 | 2 | 50 |  |  |  | 17 | croak 'Invalid ORDER, must be ASC or DESC' if $fld->{ORDER} !~ /^(A|DE)SC$/i; | 
| 317 | 2 |  |  |  |  | 7 | $opt->{ORDER} = uc $fld->{ORDER}; | 
| 318 |  |  |  |  |  |  | } | 
| 319 | 18 | 100 |  |  |  | 64 | $opt->{COLLATE} = $fld->{COLLATE} if exists $fld->{COLLATE}; | 
| 320 | 18 | 100 |  |  |  | 50 | if (exists $fld->{COL}) { | 
| 321 | 11 | 50 |  |  |  | 34 | croak 'Invalid HASH containing both COL and VAL' if exists $fld->{VAL}; | 
| 322 | 11 | 100 |  |  |  | 53 | my @cols = ref $fld->{COL} eq 'ARRAY' ? @{$fld->{COL}} : $fld->{COL}; | 
|  | 1 |  |  |  |  | 3 |  | 
| 323 | 11 |  |  |  |  | 72 | $fld = [ map $class->_parse_col($me, $_, $c{Aliases}), @cols ]; | 
| 324 |  |  |  |  |  |  | } else { | 
| 325 | 7 | 100 |  |  |  | 26 | $fld = exists $fld->{VAL} ? $fld->{VAL} : []; | 
| 326 |  |  |  |  |  |  | } | 
| 327 |  |  |  |  |  |  | } elsif (_isa($fld, 'DBIx::DBO::Column')) { | 
| 328 | 15 |  |  |  |  | 63 | return [ $class->_valid_col($me, $fld) ]; | 
| 329 |  |  |  |  |  |  | } | 
| 330 | 118 | 100 |  |  |  | 386 | $fld = [$fld] unless ref $fld eq 'ARRAY'; | 
| 331 |  |  |  |  |  |  |  | 
| 332 |  |  |  |  |  |  | # Swap placeholders | 
| 333 | 118 |  |  |  |  | 231 | my $with = @$fld; | 
| 334 | 118 | 100 | 66 |  |  | 467 | if (defined $func) { | 
|  |  | 50 |  |  |  |  |  | 
| 335 | 27 |  |  |  |  | 103 | my $need = $class->_substitute_placeholders($me, $func); | 
| 336 | 27 | 100 |  |  |  | 202 | croak "The number of params ($with) does not match the number of placeholders ($need)" if $need != $with; | 
| 337 |  |  |  |  |  |  | } elsif ($with != 1 and $c{Check} ne 'Auto') { | 
| 338 | 0 | 0 |  |  |  | 0 | croak 'Invalid '.($c{Check} eq 'Column' ? 'column' : 'field')." reference (passed $with params instead of 1)"; | 
| 339 |  |  |  |  |  |  | } | 
| 340 | 117 |  |  |  |  | 675 | return ($fld, $func, $opt); | 
| 341 |  |  |  |  |  |  | } | 
| 342 |  |  |  |  |  |  |  | 
| 343 |  |  |  |  |  |  | sub _substitute_placeholders { | 
| 344 | 27 |  |  | 27 |  | 41 | my($class, $me) = @_; | 
| 345 | 27 |  |  |  |  | 38 | my $num_placeholders = 0; | 
| 346 | 27 | 100 |  |  |  | 199 | $_[2] =~ s/((? | 
|  | 20 |  |  |  |  | 169 |  | 
| 347 | 27 |  |  |  |  | 66 | return $num_placeholders; | 
| 348 |  |  |  |  |  |  | } | 
| 349 |  |  |  |  |  |  |  | 
| 350 |  |  |  |  |  |  | sub _build_val { | 
| 351 | 226 |  |  | 226 |  | 469 | my($class, $me, $bind, $fld, $func, $opt) = @_; | 
| 352 | 226 |  |  |  |  | 309 | my $extra = ''; | 
| 353 | 226 | 100 |  |  |  | 531 | $extra .= ' COLLATE '.$me->rdbh->quote($opt->{COLLATE}) if exists $opt->{COLLATE}; | 
| 354 | 226 | 100 |  |  |  | 565 | $extra .= ' AS '.$class->_qi($me, $opt->{AS}) if exists $opt->{AS}; | 
| 355 | 226 | 100 |  |  |  | 645 | $extra .= " $opt->{ORDER}" if exists $opt->{ORDER}; | 
| 356 |  |  |  |  |  |  |  | 
| 357 |  |  |  |  |  |  | my @ary = map { | 
| 358 | 226 | 100 |  |  |  | 392 | if (!ref $_) { | 
|  | 214 | 100 |  |  |  | 543 |  | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 359 | 115 |  |  |  |  | 202 | push @$bind, $_; | 
| 360 | 115 |  |  |  |  | 289 | '?'; | 
| 361 |  |  |  |  |  |  | } elsif (_isa($_, 'DBIx::DBO::Column')) { | 
| 362 | 97 |  |  |  |  | 265 | $class->_build_col($me, $_); | 
| 363 |  |  |  |  |  |  | } elsif (ref $_ eq 'SCALAR') { | 
| 364 | 2 |  |  |  |  | 6 | $$_; | 
| 365 |  |  |  |  |  |  | } elsif (_isa($_, 'DBIx::DBO::Query')) { | 
| 366 | 0 |  |  |  |  | 0 | $_->_from($me->{build_data}); | 
| 367 |  |  |  |  |  |  | } else { | 
| 368 | 0 |  |  |  |  | 0 | croak 'Invalid field: '.$_; | 
| 369 |  |  |  |  |  |  | } | 
| 370 |  |  |  |  |  |  | } @$fld; | 
| 371 | 226 | 100 |  |  |  | 3109 | unless (defined $func) { | 
| 372 | 173 | 50 |  |  |  | 353 | die "Number of placeholders and values don't match!" if @ary != 1; | 
| 373 | 173 |  |  |  |  | 1050 | return $ary[0].$extra; | 
| 374 |  |  |  |  |  |  | } | 
| 375 |  |  |  |  |  |  | # Add one value to @ary to make sure the number of placeholders & values match | 
| 376 | 53 |  |  |  |  | 90 | push @ary, 'Error'; | 
| 377 | 53 |  |  |  |  | 197 | $func =~ s/$placeholder/shift @ary/ego; | 
|  | 41 |  |  |  |  | 92 |  | 
| 378 |  |  |  |  |  |  | # At this point all the values should have been used and @ary must only have 1 item! | 
| 379 | 53 | 50 |  |  |  | 154 | die "Number of placeholders and values don't match!" if @ary != 1; | 
| 380 | 53 |  |  |  |  | 301 | return $func.$extra; | 
| 381 |  |  |  |  |  |  | } | 
| 382 |  |  |  |  |  |  |  | 
| 383 |  |  |  |  |  |  | # Construct the WHERE clause | 
| 384 |  |  |  |  |  |  | sub _build_where { | 
| 385 | 51 |  |  | 51 |  | 78 | my($class, $me) = @_; | 
| 386 | 51 |  |  |  |  | 173 | my $h = $me->_build_data; | 
| 387 | 51 | 100 |  |  |  | 204 | return $h->{where} if defined $h->{where}; | 
| 388 | 36 |  |  |  |  | 51 | undef @{$h->{Where_Bind}}; | 
|  | 36 |  |  |  |  | 105 |  | 
| 389 | 36 |  |  |  |  | 49 | my @where; | 
| 390 | 36 | 100 |  |  |  | 129 | push @where, $class->_build_quick_where($me, $h->{Where_Bind}, @{$h->{Quick_Where}}) if exists $h->{Quick_Where}; | 
|  | 16 |  |  |  |  | 84 |  | 
| 391 | 36 | 100 |  |  |  | 206 | push @where, $class->_build_where_chunk($me, $h->{Where_Bind}, 'OR', $h->{Where_Data}) if exists $h->{Where_Data}; | 
| 392 | 36 |  |  |  |  | 221 | return $h->{where} = join ' AND ', @where; | 
| 393 |  |  |  |  |  |  | } | 
| 394 |  |  |  |  |  |  |  | 
| 395 |  |  |  |  |  |  | # Construct the WHERE contents of one set of parentheses | 
| 396 |  |  |  |  |  |  | sub _build_where_chunk { | 
| 397 | 39 |  |  | 39 |  | 86 | my($class, $me, $bind, $ag, $whs) = @_; | 
| 398 | 39 |  |  |  |  | 48 | my @str; | 
| 399 |  |  |  |  |  |  | # Make a copy so we can hack at it | 
| 400 | 39 |  |  |  |  | 124 | my @whs = @$whs; | 
| 401 | 39 |  |  |  |  | 224 | while (my $wh = shift @whs) { | 
| 402 | 61 |  |  |  |  | 87 | my @ary; | 
| 403 | 61 | 100 |  |  |  | 142 | if (ref $wh->[0]) { | 
| 404 | 9 | 100 |  |  |  | 43 | @ary = $class->_build_where_chunk($me, $bind, $ag eq 'OR' ? 'AND' : 'OR', $wh); | 
| 405 |  |  |  |  |  |  | } else { | 
| 406 | 52 |  |  |  |  | 189 | @ary = $class->_build_where_piece($me, $bind, @$wh); | 
| 407 | 52 |  |  |  |  | 137 | my($op, $fld, $fld_func, $fld_opt, $val, $val_func, $val_opt, $force) = @$wh; | 
| 408 |  |  |  |  |  |  | # Group AND/OR'ed for same fld if $force or $op requires it | 
| 409 | 52 | 100 | 100 |  |  | 176 | if ($ag eq ($force || _op_ag($op))) { | 
| 410 | 18 |  |  |  |  | 64 | for (my $i = $#whs; $i >= 0; $i--) { | 
| 411 |  |  |  |  |  |  | # Right now this starts with the last @whs and works backwards | 
| 412 |  |  |  |  |  |  | # It splices when the ag is the correct AND/OR and the funcs match and all flds match | 
| 413 | 19 | 100 | 100 |  |  | 124 | next if ref $whs[$i][0] or $ag ne ($whs[$i][7] || _op_ag($whs[$i][0])); | 
|  |  |  | 100 |  |  |  |  | 
| 414 | 11 |  |  | 11 |  | 112 | no warnings 'uninitialized'; | 
|  | 11 |  |  |  |  | 24 |  | 
|  | 11 |  |  |  |  | 4434 |  | 
| 415 | 8 | 50 |  |  |  | 30 | next if $whs[$i][2] ne $fld_func; | 
| 416 | 11 |  |  | 11 |  | 61 | use warnings 'uninitialized'; | 
|  | 11 |  |  |  |  | 2114 |  | 
|  | 11 |  |  |  |  | 48021 |  | 
| 417 |  |  |  |  |  |  | #                    next unless $fld_func ~~ $whs[$i][2]; | 
| 418 | 8 |  |  |  |  | 14 | my $l = $whs[$i][1]; | 
| 419 | 8 | 50 |  |  |  | 74 | next if ((ref $l eq 'ARRAY' ? "@$l" : $l) ne (ref $fld eq 'ARRAY' ? "@$fld" : $fld)); | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | #                    next unless $fld ~~ $whs[$i][1]; | 
| 421 | 6 |  |  |  |  | 11 | push @ary, $class->_build_where_piece($me, $bind, @{splice @whs, $i, 1}); | 
|  | 6 |  |  |  |  | 24 |  | 
| 422 |  |  |  |  |  |  | } | 
| 423 |  |  |  |  |  |  | } | 
| 424 |  |  |  |  |  |  | } | 
| 425 | 61 | 100 |  |  |  | 318 | push @str, @ary == 1 ? $ary[0] : '('.join(' '.$ag.' ', @ary).')'; | 
| 426 |  |  |  |  |  |  | } | 
| 427 | 39 |  |  |  |  | 120 | return @str; | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | sub _op_ag { | 
| 431 | 65 | 100 | 100 | 65 |  | 652 | return 'OR' if $_[0] eq '=' or $_[0] eq 'IS' or $_[0] eq '<=>' or $_[0] eq 'IN' or $_[0] eq 'BETWEEN'; | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 100 |  |  |  |  | 
|  |  |  | 100 |  |  |  |  | 
| 432 | 37 | 100 | 100 |  |  | 348 | return 'AND' if $_[0] eq '<>' or $_[0] eq 'IS NOT' or $_[0] eq 'NOT IN' or $_[0] eq 'NOT BETWEEN'; | 
|  |  |  | 100 |  |  |  |  | 
|  |  |  | 100 |  |  |  |  | 
| 433 |  |  |  |  |  |  | } | 
| 434 |  |  |  |  |  |  |  | 
| 435 |  |  |  |  |  |  | # Construct one WHERE expression | 
| 436 |  |  |  |  |  |  | sub _build_where_piece { | 
| 437 | 58 |  |  | 58 |  | 127 | my($class, $me, $bind, $op, $fld, $fld_func, $fld_opt, $val, $val_func, $val_opt) = @_; | 
| 438 | 58 |  |  |  |  | 218 | $class->_build_val($me, $bind, $fld, $fld_func, $fld_opt)." $op ".$class->_build_val($me, $bind, $val, $val_func, $val_opt); | 
| 439 |  |  |  |  |  |  | } | 
| 440 |  |  |  |  |  |  |  | 
| 441 |  |  |  |  |  |  | # Construct one WHERE expression (simple) | 
| 442 |  |  |  |  |  |  | sub _build_quick_where { | 
| 443 | 28 | 50 |  | 28 |  | 167 | croak 'Wrong number of arguments' unless @_ & 1; | 
| 444 | 28 |  |  |  |  | 82 | my($class, $me, $bind) = splice @_, 0, 3; | 
| 445 | 28 |  |  |  |  | 40 | my @where; | 
| 446 | 28 |  |  |  |  | 117 | while (my($col, $val) = splice @_, 0, 2) { | 
| 447 |  |  |  |  |  |  | # FIXME: What about aliases in quick_where? | 
| 448 | 26 |  |  |  |  | 97 | push @where, $class->_build_col($me, $class->_parse_col($me, $col)) . do { | 
| 449 | 25 | 100 | 100 |  |  | 1273 | if (ref $val eq 'SCALAR' and $$val =~ /^\s*(?:NOT\s+)NULL\s*$/is) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 450 | 2 |  |  |  |  | 15 | ' IS '; | 
| 451 |  |  |  |  |  |  | } elsif (ref $val eq 'ARRAY') { | 
| 452 | 2 | 50 |  |  |  | 12 | croak 'Invalid value argument, IN requires at least 1 value' unless @$val; | 
| 453 | 2 |  |  |  |  | 14 | $val = { FUNC => '('.join(',', ('?') x @$val).')', VAL => $val }; | 
| 454 | 2 |  |  |  |  | 13 | ' IN '; | 
| 455 |  |  |  |  |  |  | } elsif (defined $val) { | 
| 456 | 20 |  |  |  |  | 86 | ' = '; | 
| 457 |  |  |  |  |  |  | } else { | 
| 458 | 1 |  |  |  |  | 6 | $val = \'NULL'; | 
| 459 | 1 |  |  |  |  | 7 | ' IS '; | 
| 460 |  |  |  |  |  |  | } | 
| 461 |  |  |  |  |  |  | } . $class->_build_val($me, $bind, $class->_parse_val($me, $val)); | 
| 462 |  |  |  |  |  |  | } | 
| 463 | 27 |  |  |  |  | 128 | return join ' AND ', @where; | 
| 464 |  |  |  |  |  |  | } | 
| 465 |  |  |  |  |  |  |  | 
| 466 |  |  |  |  |  |  | sub _parse_set { | 
| 467 | 6 | 50 |  | 6 |  | 29 | croak 'Wrong number of arguments' if @_ & 1; | 
| 468 | 6 |  |  |  |  | 19 | my($class, $me, @arg) = @_; | 
| 469 | 6 |  |  |  |  | 9 | my @update; | 
| 470 |  |  |  |  |  |  | my %remove_duplicates; | 
| 471 | 6 |  |  |  |  | 20 | while (@arg) { | 
| 472 | 8 |  |  |  |  | 35 | my @val = $class->_parse_val($me, pop @arg); | 
| 473 | 8 |  |  |  |  | 31 | my $col = $class->_parse_col($me, pop @arg); | 
| 474 | 8 | 100 |  |  |  | 70 | unshift @update, $col, \@val unless $remove_duplicates{$col}++; | 
| 475 |  |  |  |  |  |  | } | 
| 476 | 6 |  |  |  |  | 29 | return @update; | 
| 477 |  |  |  |  |  |  | } | 
| 478 |  |  |  |  |  |  |  | 
| 479 |  |  |  |  |  |  | sub _build_set { | 
| 480 | 6 |  |  | 6 |  | 16 | my($class, $me, @arg) = @_; | 
| 481 | 6 |  |  |  |  | 16 | my $h = $me->_build_data; | 
| 482 | 6 |  |  |  |  | 17 | undef @{$h->{Set_Bind}}; | 
|  | 6 |  |  |  |  | 23 |  | 
| 483 | 6 |  |  |  |  | 16 | my @set; | 
| 484 | 6 |  |  |  |  | 17 | while (@arg) { | 
| 485 | 7 |  |  |  |  | 25 | push @set, $class->_build_col($me, shift @arg).' = '.$class->_build_val($me, $h->{Set_Bind}, @{shift @arg}); | 
|  | 7 |  |  |  |  | 204 |  | 
| 486 |  |  |  |  |  |  | } | 
| 487 | 6 |  |  |  |  | 32 | return join ', ', @set; | 
| 488 |  |  |  |  |  |  | } | 
| 489 |  |  |  |  |  |  |  | 
| 490 |  |  |  |  |  |  | sub _build_group { | 
| 491 | 51 |  |  | 51 |  | 91 | my($class, $me) = @_; | 
| 492 | 51 |  |  |  |  | 151 | my $h = $me->_build_data; | 
| 493 | 51 | 100 |  |  |  | 241 | return $h->{group} if defined $h->{group}; | 
| 494 | 20 |  |  |  |  | 38 | undef @{$h->{Group_Bind}}; | 
|  | 20 |  |  |  |  | 60 |  | 
| 495 | 20 |  |  |  |  | 33 | return $h->{group} = join ', ', map $class->_build_val($me, $h->{Group_Bind}, @$_), @{$h->{GroupBy}}; | 
|  | 20 |  |  |  |  | 115 |  | 
| 496 |  |  |  |  |  |  | } | 
| 497 |  |  |  |  |  |  |  | 
| 498 |  |  |  |  |  |  | # Construct the HAVING clause | 
| 499 |  |  |  |  |  |  | sub _build_having { | 
| 500 | 50 |  |  | 50 |  | 90 | my($class, $me) = @_; | 
| 501 | 50 |  |  |  |  | 130 | my $h = $me->_build_data; | 
| 502 | 50 | 100 |  |  |  | 202 | return $h->{having} if defined $h->{having}; | 
| 503 | 26 |  |  |  |  | 44 | undef @{$h->{Having_Bind}}; | 
|  | 26 |  |  |  |  | 58 |  | 
| 504 | 26 |  |  |  |  | 43 | my @having; | 
| 505 | 26 | 100 |  |  |  | 83 | push @having, $class->_build_where_chunk($me, $h->{Having_Bind}, 'OR', $h->{Having_Data}) if exists $h->{Having_Data}; | 
| 506 | 26 |  |  |  |  | 130 | return $h->{having} = join ' AND ', @having; | 
| 507 |  |  |  |  |  |  | } | 
| 508 |  |  |  |  |  |  |  | 
| 509 |  |  |  |  |  |  | sub _build_order { | 
| 510 | 51 |  |  | 51 |  | 72 | my($class, $me) = @_; | 
| 511 | 51 |  |  |  |  | 154 | my $h = $me->_build_data; | 
| 512 | 51 | 100 |  |  |  | 258 | return $h->{order} if defined $h->{order}; | 
| 513 | 24 |  |  |  |  | 28 | undef @{$h->{Order_Bind}}; | 
|  | 24 |  |  |  |  | 54 |  | 
| 514 | 24 |  |  |  |  | 39 | return $h->{order} = join ', ', map $class->_build_val($me, $h->{Order_Bind}, @$_), @{$h->{OrderBy}}; | 
|  | 24 |  |  |  |  | 129 |  | 
| 515 |  |  |  |  |  |  | } | 
| 516 |  |  |  |  |  |  |  | 
| 517 |  |  |  |  |  |  | sub _build_limit { | 
| 518 | 51 |  |  | 51 |  | 97 | my($class, $me) = @_; | 
| 519 | 51 |  |  |  |  | 150 | my $h = $me->_build_data; | 
| 520 | 51 | 100 |  |  |  | 200 | return $h->{limit} if defined $h->{limit}; | 
| 521 | 27 | 100 |  |  |  | 155 | return $h->{limit} = '' unless defined $h->{LimitOffset}; | 
| 522 | 7 |  |  |  |  | 23 | $h->{limit} = 'LIMIT '.$h->{LimitOffset}[0]; | 
| 523 | 7 | 100 |  |  |  | 33 | $h->{limit} .= ' OFFSET '.$h->{LimitOffset}[1] if $h->{LimitOffset}[1]; | 
| 524 | 7 |  |  |  |  | 32 | return $h->{limit}; | 
| 525 |  |  |  |  |  |  | } | 
| 526 |  |  |  |  |  |  |  | 
| 527 |  |  |  |  |  |  | sub _get_config { | 
| 528 | 751 |  |  | 751 |  | 1568 | my($class, $opt, @confs) = @_; | 
| 529 | 751 |  | 100 |  |  | 5999 | defined $_->{$opt} and return $_->{$opt} for @confs; | 
| 530 | 307 |  |  |  |  | 1445 | return; | 
| 531 |  |  |  |  |  |  | } | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | sub _set_config { | 
| 534 | 123 |  |  | 123 |  | 290 | my($class, $ref, $opt, $val) = @_; | 
| 535 | 123 | 50 | 66 |  |  | 501 | croak "Invalid value for the 'OnRowUpdate' setting" | 
|  |  |  | 66 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 536 |  |  |  |  |  |  | if $opt eq 'OnRowUpdate' and $val and $val ne 'empty' and $val ne 'simple' and $val ne 'reload'; | 
| 537 | 123 | 100 | 100 |  |  | 839 | croak "Invalid value for the 'UseHandle' setting" | 
|  |  |  | 100 |  |  |  |  | 
|  |  |  | 100 |  |  |  |  | 
| 538 |  |  |  |  |  |  | if $opt eq 'UseHandle' and $val and $val ne 'read-only' and $val ne 'read-write'; | 
| 539 | 122 |  |  |  |  | 241 | my $old = $ref->{$opt}; | 
| 540 | 122 |  |  |  |  | 261 | $ref->{$opt} = $val; | 
| 541 | 122 |  |  |  |  | 462 | return $old; | 
| 542 |  |  |  |  |  |  | } | 
| 543 |  |  |  |  |  |  |  | 
| 544 |  |  |  |  |  |  |  | 
| 545 |  |  |  |  |  |  | # Query methods | 
| 546 |  |  |  |  |  |  | sub _rows { | 
| 547 | 1 |  |  | 1 |  | 3 | my($class, $me) = @_; | 
| 548 | 1 | 50 | 33 |  |  | 4 | $me->_sth and ($me->{sth}{Executed} or $me->run) | 
|  |  |  | 33 |  |  |  |  | 
| 549 |  |  |  |  |  |  | or croak $me->rdbh->errstr; | 
| 550 | 1 |  |  |  |  | 7 | my $rows = $me->_sth->rows; | 
| 551 | 1 | 50 |  |  |  | 7 | $me->{Row_Count} = $rows == -1 ? undef : $rows; | 
| 552 |  |  |  |  |  |  | } | 
| 553 |  |  |  |  |  |  |  | 
| 554 |  |  |  |  |  |  | sub _calc_found_rows { | 
| 555 | 1 |  |  | 1 |  | 2 | my($class, $me) = @_; | 
| 556 | 1 |  |  |  |  | 4 | local $me->{build_data}{limit} = ''; | 
| 557 | 1 |  |  |  |  | 4 | $me->{Found_Rows} = $me->count_rows; | 
| 558 |  |  |  |  |  |  | } | 
| 559 |  |  |  |  |  |  |  | 
| 560 |  |  |  |  |  |  |  | 
| 561 |  |  |  |  |  |  | # Table methods | 
| 562 | 0 |  |  | 0 |  | 0 | sub _save_last_insert_id { | 
| 563 |  |  |  |  |  |  | #my($class, $me, $sth) = @_; | 
| 564 |  |  |  |  |  |  | # Should be provided in a DBD specific method | 
| 565 |  |  |  |  |  |  | # It is called after insert and must return the autogenerated ID | 
| 566 |  |  |  |  |  |  | #return $sth->{Database}->last_insert_id(undef, @$me{qw(Schema Name)}, undef); | 
| 567 |  |  |  |  |  |  | } | 
| 568 |  |  |  |  |  |  |  | 
| 569 |  |  |  |  |  |  | sub _fast_bulk_insert { | 
| 570 | 0 |  |  | 0 |  | 0 | my($class, $me, $sql, $cols, %opt) = @_; | 
| 571 |  |  |  |  |  |  |  | 
| 572 | 0 |  |  |  |  | 0 | my @vals; | 
| 573 |  |  |  |  |  |  | my @bind; | 
| 574 | 0 | 0 |  |  |  | 0 | if (ref $opt{rows}[0] eq 'ARRAY') { | 
| 575 | 0 |  |  |  |  | 0 | for my $row (@{$opt{rows}}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 576 | 0 |  |  |  |  | 0 | push @vals, '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row).')'; | 
| 577 |  |  |  |  |  |  | } | 
| 578 |  |  |  |  |  |  | } else { | 
| 579 | 0 |  |  |  |  | 0 | for my $row (@{$opt{rows}}) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 580 | 0 |  |  |  |  | 0 | push @vals, '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row{@$cols}).')'; | 
| 581 |  |  |  |  |  |  | } | 
| 582 |  |  |  |  |  |  | } | 
| 583 |  |  |  |  |  |  |  | 
| 584 | 0 |  |  |  |  | 0 | $sql .= join(",\n", @vals); | 
| 585 | 0 |  |  |  |  | 0 | $class->_do($me, $sql, undef, @bind); | 
| 586 |  |  |  |  |  |  | } | 
| 587 |  |  |  |  |  |  |  | 
| 588 |  |  |  |  |  |  | sub _safe_bulk_insert { | 
| 589 | 4 |  |  | 4 |  | 13 | my($class, $me, $sql, $cols, %opt) = @_; | 
| 590 |  |  |  |  |  |  |  | 
| 591 |  |  |  |  |  |  | # TODO: Wrap in a transaction | 
| 592 | 4 |  |  |  |  | 7 | my $rv; | 
| 593 |  |  |  |  |  |  | my $sth; | 
| 594 | 4 |  |  |  |  | 9 | my $prev_vals = ''; | 
| 595 | 4 | 100 |  |  |  | 16 | if (ref $opt{rows}[0] eq 'ARRAY') { | 
| 596 | 2 |  |  |  |  | 3 | for my $row (@{$opt{rows}}) { | 
|  | 2 |  |  |  |  | 5 |  | 
| 597 | 8 |  |  |  |  | 11 | my @bind; | 
| 598 | 8 |  |  |  |  | 36 | my $vals = '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row).')'; | 
| 599 | 8 |  |  |  |  | 34 | $class->_sql($me, $sql.$vals, @bind); | 
| 600 | 8 | 100 |  |  |  | 23 | if ($prev_vals ne $vals) { | 
| 601 | 2 | 50 |  |  |  | 9 | $sth = $me->dbh->prepare($sql.$vals) or return undef; | 
| 602 | 2 |  |  |  |  | 176 | $prev_vals = $vals; | 
| 603 |  |  |  |  |  |  | } | 
| 604 | 8 | 50 |  |  |  | 954 | $rv += $sth->execute(@bind) or return undef; | 
| 605 |  |  |  |  |  |  | } | 
| 606 |  |  |  |  |  |  | } else { | 
| 607 | 2 |  |  |  |  | 5 | for my $row (@{$opt{rows}}) { | 
|  | 2 |  |  |  |  | 5 |  | 
| 608 | 8 |  |  |  |  | 12 | my @bind; | 
| 609 | 8 |  |  |  |  | 48 | my $vals = '('.join(', ', map $class->_build_val($me, \@bind, $class->_parse_val($me, $_)), @$row{@$cols}).')'; | 
| 610 | 8 |  |  |  |  | 42 | $class->_sql($me, $sql.$vals, @bind); | 
| 611 | 8 | 100 |  |  |  | 31 | if ($prev_vals ne $vals) { | 
| 612 | 2 | 50 |  |  |  | 9 | $sth = $me->dbh->prepare($sql.$vals) or return undef; | 
| 613 | 2 |  |  |  |  | 125 | $prev_vals = $vals; | 
| 614 |  |  |  |  |  |  | } | 
| 615 | 8 | 50 |  |  |  | 1113 | $rv += $sth->execute(@bind) or return undef; | 
| 616 |  |  |  |  |  |  | } | 
| 617 |  |  |  |  |  |  | } | 
| 618 |  |  |  |  |  |  |  | 
| 619 | 4 |  | 50 |  |  | 96 | return $rv || '0E0'; | 
| 620 |  |  |  |  |  |  | } | 
| 621 |  |  |  |  |  |  | *_bulk_insert = \&_safe_bulk_insert; | 
| 622 |  |  |  |  |  |  |  | 
| 623 |  |  |  |  |  |  |  | 
| 624 |  |  |  |  |  |  | # Row methods | 
| 625 |  |  |  |  |  |  | sub _reset_row_on_update { | 
| 626 | 4 |  |  | 4 |  | 14 | my($class, $me, @update) = @_; | 
| 627 | 4 |  | 50 |  |  | 15 | my $on_row_update = $me->config('OnRowUpdate') || 'simple'; | 
| 628 |  |  |  |  |  |  |  | 
| 629 | 4 | 50 |  |  |  | 13 | if ($on_row_update ne 'empty') { | 
| 630 |  |  |  |  |  |  | # Set the row values if they are simple expressions | 
| 631 | 4 |  |  |  |  | 7 | my @cant_update; | 
| 632 | 4 |  |  |  |  | 21 | for (my $i = 0; $i < @update; $i += 2) { | 
| 633 |  |  |  |  |  |  | # Keep a list of columns we can't update, and skip them | 
| 634 |  |  |  |  |  |  | next if $cant_update[ $me->_column_idx($update[0]) ] = ( | 
| 635 | 5 | 100 | 66 |  |  | 25 | defined $update[1][1] or @{$update[1][0]} != 1 or ( | 
| 636 |  |  |  |  |  |  | ref $update[1][0][0] and ( | 
| 637 |  |  |  |  |  |  | not _isa($update[1][0][0], 'DBIx::DBO::Column') | 
| 638 |  |  |  |  |  |  | or $cant_update[ $me->_column_idx($update[1][0][0]) ] | 
| 639 |  |  |  |  |  |  | ) | 
| 640 |  |  |  |  |  |  | ) | 
| 641 |  |  |  |  |  |  | ); | 
| 642 | 4 |  |  |  |  | 14 | my($col, $val) = splice @update, $i, 2; | 
| 643 | 4 |  |  |  |  | 11 | $val = $val->[0][0]; | 
| 644 | 4 | 50 |  |  |  | 10 | $val = $$me->{array}[ $me->_column_idx($val) ] if ref $val; | 
| 645 | 4 |  |  |  |  | 17 | $$me->{array}[ $me->_column_idx($col) ] = $val; | 
| 646 | 4 |  |  |  |  | 15 | $i -= 2; | 
| 647 |  |  |  |  |  |  | } | 
| 648 |  |  |  |  |  |  | # If we were able to update all the columns then return | 
| 649 | 4 | 100 |  |  |  | 21 | grep $_, @cant_update or return; | 
| 650 |  |  |  |  |  |  |  | 
| 651 | 1 | 50 |  |  |  | 6 | if ($on_row_update eq 'reload') { | 
| 652 |  |  |  |  |  |  | # Attempt reload | 
| 653 | 1 |  |  |  |  | 3 | my @cols = map $$me->{build_data}{Quick_Where}[$_ << 1], 0 .. $#{$$me->{build_data}{Quick_Where}} >> 1; | 
|  | 1 |  |  |  |  | 8 |  | 
| 654 | 1 |  |  |  |  | 6 | my @cidx = map $me->_column_idx($_), @cols; | 
| 655 | 1 | 50 |  |  |  | 6 | unless (grep $cant_update[$_], @cidx) { | 
| 656 | 1 |  |  |  |  | 2 | my %bd = %{$$me->{build_data}}; | 
|  | 1 |  |  |  |  | 14 |  | 
| 657 | 1 |  |  |  |  | 4 | delete $bd{Where_Data}; | 
| 658 | 1 |  |  |  |  | 2 | delete $bd{where}; | 
| 659 | 1 |  |  |  |  | 3 | $bd{Quick_Where} = [map { $cols[$_] => $$me->{array}[ $cidx[$_] ] } 0 .. $#cols]; | 
|  | 1 |  |  |  |  | 4 |  | 
| 660 | 1 |  |  |  |  | 2 | my($sql, @bind) = do { | 
| 661 | 1 |  |  |  |  | 3 | local $$me->{build_data} = \%bd; | 
| 662 | 1 |  |  |  |  | 5 | ($class->_build_sql_select($me), $class->_bind_params_select($me)); | 
| 663 |  |  |  |  |  |  | }; | 
| 664 | 1 |  |  |  |  | 5 | return $me->_load($sql, @bind); | 
| 665 |  |  |  |  |  |  | } | 
| 666 |  |  |  |  |  |  | } | 
| 667 |  |  |  |  |  |  | } | 
| 668 |  |  |  |  |  |  | # If we can't update or reload then empty the Row | 
| 669 | 0 |  |  |  |  | 0 | undef $$me->{array}; | 
| 670 | 0 |  |  |  |  | 0 | $$me->{hash} = {}; | 
| 671 |  |  |  |  |  |  | } | 
| 672 |  |  |  |  |  |  |  | 
| 673 |  |  |  |  |  |  | sub _build_data_matching_this_row { | 
| 674 | 5 |  |  | 5 |  | 13 | my($class, $me) = @_; | 
| 675 |  |  |  |  |  |  | # Identify the row by the PrimaryKeys if any, otherwise by all Columns | 
| 676 | 5 |  |  |  |  | 20 | my @quick_where; | 
| 677 | 5 |  |  |  |  | 7 | for my $tbl (@{$$me->{Tables}}) { | 
|  | 5 |  |  |  |  | 14 |  | 
| 678 | 5 | 50 |  |  |  | 10 | for my $col (map $tbl ** $_, @{$tbl->{ @{$tbl->{PrimaryKeys}} ? 'PrimaryKeys' : 'Columns' }}) { | 
|  | 5 |  |  |  |  | 7 |  | 
|  | 5 |  |  |  |  | 36 |  | 
| 679 | 5 |  |  |  |  | 21 | my $i = $me->_column_idx($col); | 
| 680 | 5 | 50 |  |  |  | 23 | defined $i or croak 'The '.$class->_qi($me, $tbl->{Name}, $col->[1]).' field needed to identify this row, was not included in this query'; | 
| 681 | 5 |  |  |  |  | 25 | push @quick_where, $col => $$me->{array}[$i]; | 
| 682 |  |  |  |  |  |  | } | 
| 683 |  |  |  |  |  |  | } | 
| 684 | 5 |  |  |  |  | 33 | my %h = ( | 
| 685 |  |  |  |  |  |  | Showing => $$me->{build_data}{Showing}, | 
| 686 |  |  |  |  |  |  | from => $$me->{build_data}{from}, | 
| 687 |  |  |  |  |  |  | Quick_Where => \@quick_where | 
| 688 |  |  |  |  |  |  | ); | 
| 689 | 5 | 100 |  |  |  | 17 | $h{From_Bind} = $$me->{build_data}{From_Bind} if exists $$me->{build_data}{From_Bind}; | 
| 690 | 5 |  |  |  |  | 23 | return \%h; | 
| 691 |  |  |  |  |  |  | } | 
| 692 |  |  |  |  |  |  |  | 
| 693 |  |  |  |  |  |  |  | 
| 694 |  |  |  |  |  |  | # require the DBD module if it exists | 
| 695 |  |  |  |  |  |  | my %inheritance; | 
| 696 |  |  |  |  |  |  | sub _require_dbd_class { | 
| 697 | 22 |  |  | 22 |  | 64 | my($class, $dbd) = @_; | 
| 698 | 22 |  |  |  |  | 65 | my $dbd_class = $class.'::'.$dbd; | 
| 699 |  |  |  |  |  |  |  | 
| 700 | 22 |  |  |  |  | 49 | my $rv; | 
| 701 |  |  |  |  |  |  | my @warn; | 
| 702 |  |  |  |  |  |  | { | 
| 703 | 22 |  |  | 1 |  | 36 | local $SIG{__WARN__} = sub { push @warn, join '', @_ }; | 
|  | 22 |  |  |  |  | 214 |  | 
|  | 1 |  |  |  |  | 7 |  | 
| 704 | 22 |  |  |  |  | 1677 | $rv = eval "require $dbd_class"; | 
| 705 |  |  |  |  |  |  | } | 
| 706 | 22 | 100 |  |  |  | 117 | if ($rv) { | 
| 707 | 12 | 50 |  |  |  | 44 | warn @warn if @warn; | 
| 708 |  |  |  |  |  |  | } else { | 
| 709 | 10 |  |  |  |  | 69 | (my $file = $dbd_class.'.pm') =~ s'::'/'g; | 
| 710 | 10 | 100 |  |  |  | 226 | if ($@ !~ / \Q$file\E in \@INC /) { | 
| 711 | 1 |  |  |  |  | 7 | (my $err = $@) =~ s/\n.*$//; # Remove the last line | 
| 712 | 1 |  |  |  |  | 2 | chomp @warn; | 
| 713 | 1 |  |  |  |  | 3 | chomp $err; | 
| 714 | 1 |  |  |  |  | 3400 | croak join "\n", @warn, $err, "Can't load $dbd driver"; | 
| 715 |  |  |  |  |  |  | } | 
| 716 |  |  |  |  |  |  |  | 
| 717 | 9 |  |  |  |  | 26 | $@ = ''; | 
| 718 | 9 |  |  |  |  | 25 | delete $INC{$file}; | 
| 719 | 9 |  |  |  |  | 71 | $INC{$file} = 1; | 
| 720 |  |  |  |  |  |  | } | 
| 721 |  |  |  |  |  |  |  | 
| 722 |  |  |  |  |  |  | # Set the derived DBD class' inheritance | 
| 723 | 21 | 100 |  |  |  | 99 | unless (exists $inheritance{$class}{$dbd}) { | 
| 724 | 11 |  |  | 11 |  | 94 | no strict 'refs'; | 
|  | 11 |  |  |  |  | 26 |  | 
|  | 11 |  |  |  |  | 3225 |  | 
| 725 | 10 | 50 |  |  |  | 149 | unless (@{$dbd_class.'::ISA'}) { | 
|  | 10 |  |  |  |  | 89 |  | 
| 726 | 10 |  |  |  |  | 21 | my @isa = map $_->_require_dbd_class($dbd), grep $_->isa(__PACKAGE__), @{$class.'::ISA'}; | 
|  | 10 |  |  |  |  | 71 |  | 
| 727 | 10 |  |  |  |  | 23 | @{$dbd_class.'::ISA'} = ($class, @isa); | 
|  | 10 |  |  |  |  | 173 |  | 
| 728 | 10 | 100 |  |  |  | 137 | if (@isa) { | 
| 729 | 1 |  |  |  |  | 7 | mro::set_mro($dbd_class, 'c3'); | 
| 730 | 1 | 50 |  |  |  | 6 | Class::C3::initialize() if $] < 5.009_005; | 
| 731 |  |  |  |  |  |  | } | 
| 732 |  |  |  |  |  |  | } | 
| 733 | 10 |  |  |  |  | 29 | push @CARP_NOT, $dbd_class; | 
| 734 | 10 |  |  |  |  | 29 | $inheritance{$class}{$dbd} = $dbd_class; | 
| 735 |  |  |  |  |  |  | } | 
| 736 |  |  |  |  |  |  |  | 
| 737 | 21 |  |  |  |  | 116 | return $inheritance{$class}{$dbd}; | 
| 738 |  |  |  |  |  |  | } | 
| 739 |  |  |  |  |  |  |  | 
| 740 |  |  |  |  |  |  | 1; |