line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
2
|
|
|
2
|
|
24824
|
use 5.006; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
77
|
|
2
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
69
|
|
3
|
2
|
|
|
2
|
|
5228
|
use DBI; |
|
2
|
|
|
|
|
66962
|
|
|
2
|
|
|
|
|
157
|
|
4
|
2
|
|
|
2
|
|
25
|
use Carp (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
3675
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
$DBIx::Simple::VERSION = '1.35'; |
7
|
|
|
|
|
|
|
$Carp::Internal{$_} = 1 |
8
|
|
|
|
|
|
|
for qw(DBIx::Simple DBIx::Simple::Result DBIx::Simple::DeadObject); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my $no_raiseerror = $ENV{PERL_DBIX_SIMPLE_NO_RAISEERROR}; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $quoted = qr/(?:'[^']*'|"[^"]*")*/; # 'foo''bar' simply matches the (?:) twice |
13
|
|
|
|
|
|
|
my $quoted_mysql = qr/(?:(?:[^\\']*(?:\\.[^\\']*)*)'|"(?:[^\\"]*(?:\\.[^\\"]*)*)")*/; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my %statements; # "$db" => { "$st" => $st, ... } |
16
|
|
|
|
|
|
|
my %old_statements; # "$db" => [ [ $query, $st ], ... ] |
17
|
|
|
|
|
|
|
my %keep_statements; # "$db" => $int |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $err_message = '%s no longer usable (because of %%s)'; |
20
|
|
|
|
|
|
|
my $err_cause = '%s at %s line %d'; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
package DBIx::Simple; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
### private helper subs |
25
|
|
|
|
|
|
|
|
26
|
0
|
|
|
0
|
|
0
|
sub _dummy { bless \my $dummy, 'DBIx::Simple::Dummy' } |
27
|
|
|
|
|
|
|
sub _swap { |
28
|
1
|
|
|
1
|
|
768
|
my ($hash1, $hash2) = @_; |
29
|
1
|
|
|
|
|
4
|
my $tempref = ref $hash1; |
30
|
1
|
|
|
|
|
7
|
my $temphash = { %$hash1 }; |
31
|
1
|
|
|
|
|
5
|
%$hash1 = %$hash2; |
32
|
1
|
|
|
|
|
4
|
bless $hash1, ref $hash2; |
33
|
1
|
|
|
|
|
4
|
%$hash2 = %$temphash; |
34
|
1
|
|
|
|
|
4
|
bless $hash2, $tempref; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
### constructor |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub connect { |
40
|
0
|
|
|
0
|
1
|
|
my ($class, @arguments) = @_; |
41
|
0
|
|
|
|
|
|
my $self = { lc_columns => 1, result_class => 'DBIx::Simple::Result' }; |
42
|
0
|
0
|
0
|
|
|
|
if (defined $arguments[0] and UNIVERSAL::isa($arguments[0], 'DBI::db')) { |
43
|
0
|
|
|
|
|
|
$self->{dont_disconnect} = 1; |
44
|
0
|
|
|
|
|
|
$self->{dbh} = shift @arguments; |
45
|
0
|
0
|
|
|
|
|
Carp::carp("Additional arguments for $class->connect are ignored") |
46
|
|
|
|
|
|
|
if @arguments; |
47
|
|
|
|
|
|
|
} else { |
48
|
0
|
0
|
0
|
|
|
|
$arguments[3]->{PrintError} = 0 |
49
|
|
|
|
|
|
|
unless defined $arguments[3] and exists $arguments[3]{PrintError}; |
50
|
0
|
0
|
0
|
|
|
|
$arguments[3]->{RaiseError} = 1 |
|
|
|
0
|
|
|
|
|
51
|
|
|
|
|
|
|
unless $no_raiseerror |
52
|
|
|
|
|
|
|
or defined $arguments[3] and exists $arguments[3]{RaiseError}; |
53
|
0
|
|
|
|
|
|
$self->{dbh} = DBI->connect(@arguments); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
0
|
0
|
|
|
|
|
return undef unless $self->{dbh}; |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
$self->{dbd} = $self->{dbh}->{Driver}->{Name}; |
59
|
0
|
|
|
|
|
|
bless $self, $class; |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
$statements{$self} = {}; |
62
|
0
|
|
|
|
|
|
$old_statements{$self} = []; |
63
|
0
|
|
|
|
|
|
$keep_statements{$self} = 16; |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
return $self; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub new { |
69
|
0
|
|
|
0
|
1
|
|
my ($class) = shift; |
70
|
0
|
|
|
|
|
|
$class->connect(@_); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
### properties |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
0
|
1
|
|
sub keep_statements : lvalue { $keep_statements{ $_[0] } } |
76
|
0
|
|
|
0
|
1
|
|
sub lc_columns : lvalue { $_[0]->{lc_columns} } |
77
|
0
|
|
|
0
|
1
|
|
sub result_class : lvalue { $_[0]->{result_class} } |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub abstract : lvalue { |
80
|
0
|
|
|
0
|
1
|
|
require SQL::Abstract; |
81
|
0
|
|
0
|
|
|
|
$_[0]->{abstract} ||= SQL::Abstract->new; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub error { |
85
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
86
|
0
|
0
|
|
|
|
|
return 'DBI error: ' . (ref $self ? $self->{dbh}->errstr : $DBI::errstr); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
0
|
|
|
0
|
1
|
|
sub dbh { $_[0]->{dbh} } |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
### private methods |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Replace (??) with (?, ?, ?, ...) |
94
|
|
|
|
|
|
|
sub _replace_omniholder { |
95
|
0
|
|
|
0
|
|
|
my ($self, $query, $binds) = @_; |
96
|
0
|
0
|
|
|
|
|
return if $$query !~ /\(\?\?\)/; |
97
|
0
|
|
|
|
|
|
my $omniholders = 0; |
98
|
0
|
0
|
|
|
|
|
my $q = $self->{dbd} =~ /mysql/ ? $quoted_mysql : $quoted; |
99
|
0
|
|
|
|
|
|
$$query =~ s[($q|\(\?\?\))] { |
100
|
|
|
|
|
|
|
$1 eq '(??)' |
101
|
0
|
0
|
|
|
|
|
? do { |
102
|
0
|
0
|
|
|
|
|
Carp::croak('There can be only one omniholder') |
103
|
|
|
|
|
|
|
if $omniholders++; |
104
|
0
|
|
|
|
|
|
'(' . join(', ', ('?') x @$binds) . ')' |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
: $1 |
107
|
|
|
|
|
|
|
}eg; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Invalidate and clean up |
111
|
|
|
|
|
|
|
sub _die { |
112
|
0
|
|
|
0
|
|
|
my ($self, $cause) = @_; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
defined and $_->_die($cause, 0) |
115
|
0
|
|
0
|
|
|
|
for values %{ $statements{$self} }, |
|
0
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
map $$_[1], @{ $old_statements{$self} }; |
117
|
0
|
|
|
|
|
|
delete $statements{$self}; |
118
|
0
|
|
|
|
|
|
delete $old_statements{$self}; |
119
|
0
|
|
|
|
|
|
delete $keep_statements{$self}; |
120
|
|
|
|
|
|
|
|
121
|
0
|
0
|
|
|
|
|
unless ($self->{dont_disconnect}) { |
122
|
|
|
|
|
|
|
# Conditional, because destruction order is not guaranteed |
123
|
|
|
|
|
|
|
# during global destruction. |
124
|
0
|
0
|
|
|
|
|
$self->{dbh}->disconnect() if defined $self->{dbh}; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
_swap( |
128
|
0
|
0
|
|
|
|
|
$self, |
129
|
|
|
|
|
|
|
bless { |
130
|
|
|
|
|
|
|
what => 'Database object', |
131
|
|
|
|
|
|
|
cause => $cause |
132
|
|
|
|
|
|
|
}, 'DBIx::Simple::DeadObject' |
133
|
|
|
|
|
|
|
) unless $cause =~ /DESTROY/; # Let's not cause infinite loops :) |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
### public methods |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub query { |
139
|
0
|
|
|
0
|
1
|
|
my ($self, $query, @binds) = @_; |
140
|
0
|
|
|
|
|
|
$self->{success} = 0; |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
$self->_replace_omniholder(\$query, \@binds); |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
my $st; |
145
|
|
|
|
|
|
|
my $sth; |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
my $old = $old_statements{$self}; |
148
|
|
|
|
|
|
|
|
149
|
0
|
0
|
|
|
|
|
if (defined( my $i = (grep $old->[$_][0] eq $query, 0..$#$old)[0] )) { |
150
|
0
|
|
|
|
|
|
$st = splice(@$old, $i, 1)->[1]; |
151
|
0
|
|
|
|
|
|
$sth = $st->{sth}; |
152
|
|
|
|
|
|
|
} else { |
153
|
0
|
0
|
|
|
|
|
eval { $sth = $self->{dbh}->prepare($query) } or do { |
|
0
|
|
|
|
|
|
|
154
|
0
|
0
|
|
|
|
|
if ($@) { |
155
|
0
|
|
|
|
|
|
$@ =~ s/ at \S+ line \d+\.\n\z//; |
156
|
0
|
|
|
|
|
|
Carp::croak($@); |
157
|
|
|
|
|
|
|
} |
158
|
0
|
|
|
|
|
|
$self->{reason} = "Prepare failed ($DBI::errstr)"; |
159
|
0
|
|
|
|
|
|
return _dummy; |
160
|
|
|
|
|
|
|
}; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# $self is quoted on purpose, to pass along the stringified version, |
163
|
|
|
|
|
|
|
# and avoid increasing reference count. |
164
|
0
|
|
|
|
|
|
$st = bless { |
165
|
|
|
|
|
|
|
db => "$self", |
166
|
|
|
|
|
|
|
sth => $sth, |
167
|
|
|
|
|
|
|
query => $query |
168
|
|
|
|
|
|
|
}, 'DBIx::Simple::Statement'; |
169
|
0
|
|
|
|
|
|
$statements{$self}{$st} = $st; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
0
|
0
|
|
|
|
|
eval { $sth->execute(@binds) } or do { |
|
0
|
|
|
|
|
|
|
173
|
0
|
0
|
|
|
|
|
if ($@) { |
174
|
0
|
|
|
|
|
|
$@ =~ s/ at \S+ line \d+\.\n\z//; |
175
|
0
|
|
|
|
|
|
Carp::croak($@); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
|
$self->{reason} = "Execute failed ($DBI::errstr)"; |
179
|
0
|
|
|
|
|
|
return _dummy; |
180
|
|
|
|
|
|
|
}; |
181
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
$self->{success} = 1; |
183
|
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
|
return bless { st => $st, lc_columns => $self->{lc_columns} }, $self->{result_class}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
0
|
1
|
|
sub begin_work { $_[0]->{dbh}->begin_work } |
188
|
0
|
|
|
0
|
1
|
|
sub begin { $_[0]->begin_work } |
189
|
0
|
|
|
0
|
1
|
|
sub commit { $_[0]->{dbh}->commit } |
190
|
0
|
|
|
0
|
1
|
|
sub rollback { $_[0]->{dbh}->rollback } |
191
|
0
|
|
|
0
|
1
|
|
sub func { shift->{dbh}->func(@_) } |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub last_insert_id { |
194
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
0
|
|
|
|
($self->{dbi_version} ||= DBI->VERSION) >= 1.38 or Carp::croak( |
197
|
|
|
|
|
|
|
"DBI v1.38 required for last_insert_id" . |
198
|
|
|
|
|
|
|
"--this is only $self->{dbi_version}, stopped" |
199
|
|
|
|
|
|
|
); |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
return shift->{dbh}->last_insert_id(@_); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub disconnect { |
205
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
206
|
0
|
|
|
|
|
|
$self->_die(sprintf($err_cause, "$self->disconnect", (caller)[1, 2])); |
207
|
0
|
|
|
|
|
|
return 1; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub DESTROY { |
211
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
212
|
0
|
|
|
|
|
|
$self->_die(sprintf($err_cause, "$self->DESTROY", (caller)[1, 2])); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
### public methods wrapping SQL::Abstract |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
for my $method (qw/select insert update delete/) { |
218
|
2
|
|
|
2
|
|
14
|
no strict 'refs'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
368
|
|
219
|
|
|
|
|
|
|
*$method = sub { |
220
|
0
|
|
|
0
|
|
|
my $self = shift; |
221
|
0
|
|
|
|
|
|
return $self->query($self->abstract->$method(@_)); |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
### public method wrapping SQL::Interp |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub iquery { |
228
|
0
|
|
|
0
|
1
|
|
require SQL::Interp; |
229
|
0
|
|
|
|
|
|
my $self = shift; |
230
|
0
|
|
|
|
|
|
return $self->query( SQL::Interp::sql_interp(@_) ); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
package DBIx::Simple::Dummy; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
use overload |
236
|
0
|
|
|
0
|
|
0
|
'""' => sub { shift }, |
237
|
2
|
|
|
2
|
|
1735
|
bool => sub { 0 }; |
|
2
|
|
|
0
|
|
1110
|
|
|
2
|
|
|
|
|
23
|
|
|
0
|
|
|
|
|
0
|
|
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
0
|
|
|
sub new { bless \my $dummy, shift } |
240
|
0
|
|
|
0
|
|
|
sub AUTOLOAD { return } |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
package DBIx::Simple::DeadObject; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub _die { |
245
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
246
|
0
|
|
|
|
|
|
Carp::croak( |
247
|
|
|
|
|
|
|
sprintf( |
248
|
|
|
|
|
|
|
"(This should NEVER happen!) " . |
249
|
|
|
|
|
|
|
sprintf($err_message, $self->{what}), |
250
|
|
|
|
|
|
|
$self->{cause} |
251
|
|
|
|
|
|
|
) |
252
|
|
|
|
|
|
|
); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub AUTOLOAD { |
256
|
0
|
|
|
0
|
|
|
my ($self) = @_; |
257
|
0
|
|
|
|
|
|
Carp::croak( |
258
|
|
|
|
|
|
|
sprintf( |
259
|
|
|
|
|
|
|
sprintf($err_message, $self->{what}), |
260
|
|
|
|
|
|
|
$self->{cause} |
261
|
|
|
|
|
|
|
) |
262
|
|
|
|
|
|
|
); |
263
|
|
|
|
|
|
|
} |
264
|
0
|
|
|
0
|
|
|
sub DESTROY { } |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
package DBIx::Simple::Statement; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub _die { |
269
|
0
|
|
|
0
|
|
|
my ($self, $cause, $save) = @_; |
270
|
|
|
|
|
|
|
|
271
|
0
|
0
|
|
|
|
|
$self->{sth}->finish() if defined $self->{sth}; |
272
|
0
|
|
|
|
|
|
$self->{dead} = 1; |
273
|
|
|
|
|
|
|
|
274
|
0
|
|
|
|
|
|
my $stringy_db = "$self->{db}"; |
275
|
0
|
|
|
|
|
|
my $stringy_self = "$self"; |
276
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
|
my $foo = bless { |
278
|
|
|
|
|
|
|
what => 'Statement object', |
279
|
|
|
|
|
|
|
cause => $cause |
280
|
|
|
|
|
|
|
}, 'DBIx::Simple::DeadObject'; |
281
|
|
|
|
|
|
|
|
282
|
0
|
|
|
|
|
|
DBIx::Simple::_swap($self, $foo); |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
my $old = $old_statements{ $foo->{db} }; |
285
|
0
|
|
|
|
|
|
my $keep = $keep_statements{ $foo->{db} }; |
286
|
|
|
|
|
|
|
|
287
|
0
|
0
|
0
|
|
|
|
if ($save and $keep) { |
288
|
0
|
|
|
|
|
|
$foo->{dead} = 0; |
289
|
0
|
|
|
|
|
|
shift @$old until @$old + 1 <= $keep; |
290
|
0
|
|
|
|
|
|
push @$old, [ $foo->{query}, $foo ]; |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
|
delete $statements{ $stringy_db }{ $stringy_self }; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub DESTROY { |
297
|
|
|
|
|
|
|
# This better only happen during global destruction... |
298
|
0
|
0
|
|
0
|
|
|
return if $_[0]->{dead}; |
299
|
0
|
|
|
|
|
|
$_[0]->_die('Ehm', 0); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
package DBIx::Simple::Result; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub _die { |
305
|
0
|
|
|
0
|
|
|
my ($self, $cause) = @_; |
306
|
0
|
0
|
|
|
|
|
if ($cause) { |
307
|
0
|
|
|
|
|
|
$self->{st}->_die($cause, 1); |
308
|
0
|
|
|
|
|
|
DBIx::Simple::_swap( |
309
|
|
|
|
|
|
|
$self, |
310
|
|
|
|
|
|
|
bless { |
311
|
|
|
|
|
|
|
what => 'Result object', |
312
|
|
|
|
|
|
|
cause => $cause, |
313
|
|
|
|
|
|
|
}, 'DBIx::Simple::DeadObject' |
314
|
|
|
|
|
|
|
); |
315
|
|
|
|
|
|
|
} else { |
316
|
0
|
|
|
|
|
|
$cause = $self->{st}->{cause}; |
317
|
0
|
|
|
|
|
|
DBIx::Simple::_swap( |
318
|
|
|
|
|
|
|
$self, |
319
|
|
|
|
|
|
|
bless { |
320
|
|
|
|
|
|
|
what => 'Result object', |
321
|
|
|
|
|
|
|
cause => $cause |
322
|
|
|
|
|
|
|
}, 'DBIx::Simple::DeadObject' |
323
|
|
|
|
|
|
|
); |
324
|
0
|
|
|
|
|
|
Carp::croak( |
325
|
|
|
|
|
|
|
sprintf( |
326
|
|
|
|
|
|
|
sprintf($err_message, $self->{what}), |
327
|
|
|
|
|
|
|
$cause |
328
|
|
|
|
|
|
|
) |
329
|
|
|
|
|
|
|
); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
0
|
|
|
sub func { shift->{st}->{sth}->func(@_) } |
334
|
0
|
|
|
0
|
|
|
sub attr { my $dummy = $_[0]->{st}->{sth}->{$_[1]} } |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
sub columns { |
337
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
338
|
0
|
0
|
|
|
|
|
my $c = $_[0]->{st}->{sth}->{ $_[0]->{lc_columns} ? 'NAME_lc' : 'NAME' }; |
339
|
0
|
0
|
|
|
|
|
return wantarray ? @$c : $c; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub bind { |
343
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
344
|
0
|
|
|
|
|
|
$_[0]->{st}->{sth}->bind_columns(\@_[1..$#_]); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
### Single |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub fetch { |
351
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
352
|
0
|
|
|
|
|
|
return $_[0]->{st}->{sth}->fetch; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub into { |
356
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
357
|
0
|
|
|
|
|
|
my $sth = $_[0]->{st}->{sth}; |
358
|
0
|
0
|
|
|
|
|
$sth->bind_columns(\@_[1..$#_]) if @_ > 1; |
359
|
0
|
|
|
|
|
|
return $sth->fetch; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub list { |
363
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
364
|
0
|
0
|
|
|
|
|
return $_[0]->{st}->{sth}->fetchrow_array if wantarray; |
365
|
0
|
|
|
|
|
|
return($_[0]->{st}->{sth}->fetchrow_array)[-1]; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub array { |
369
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
370
|
0
|
0
|
|
|
|
|
my $row = $_[0]->{st}->{sth}->fetchrow_arrayref or return; |
371
|
0
|
|
|
|
|
|
return [ @$row ]; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub hash { |
375
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
376
|
0
|
0
|
|
|
|
|
return $_[0]->{st}->{sth}->fetchrow_hashref( |
377
|
|
|
|
|
|
|
$_[0]->{lc_columns} ? 'NAME_lc' : 'NAME' |
378
|
|
|
|
|
|
|
); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub kv_list { |
382
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
383
|
0
|
|
|
|
|
|
my @keys = $_[0]->columns; |
384
|
0
|
0
|
|
|
|
|
my $values = $_[0]->array or return; |
385
|
0
|
0
|
|
|
|
|
Carp::croak("Different numbers of column names and values") |
386
|
|
|
|
|
|
|
if @keys != @$values; |
387
|
0
|
0
|
|
|
|
|
return map { $keys[$_], $values->[$_] } 0 .. $#keys if wantarray; |
|
0
|
|
|
|
|
|
|
388
|
0
|
|
|
|
|
|
return [ map { $keys[$_], $values->[$_] } 0 .. $#keys ]; |
|
0
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
sub kv_array { |
392
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
393
|
0
|
|
|
|
|
|
scalar shift->kv_list(@_); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub object { |
397
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
398
|
0
|
|
|
|
|
|
my $self = shift; |
399
|
0
|
|
0
|
|
|
|
my $class = shift || ':RowObject'; |
400
|
0
|
0
|
|
|
|
|
if ($class =~ /^:/) { |
401
|
0
|
|
|
|
|
|
$class = "DBIx::Simple::Result:$class"; |
402
|
0
|
|
|
|
|
|
(my $package = "$class.pm") =~ s[::][/]g; |
403
|
0
|
|
|
|
|
|
require $package; |
404
|
|
|
|
|
|
|
} |
405
|
0
|
0
|
|
|
|
|
if ($class->can('new_from_dbix_simple')) { |
406
|
0
|
|
|
|
|
|
return scalar $class->new_from_dbix_simple($self, @_); |
407
|
|
|
|
|
|
|
} |
408
|
0
|
0
|
|
|
|
|
if ($class->can('new')) { |
409
|
0
|
|
|
|
|
|
return $class->new( $self->kv_list ); |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
Carp::croak( |
412
|
0
|
|
|
|
|
|
qq(Can't locate object method "new_from_dbix_simple" or "new" ) . |
413
|
|
|
|
|
|
|
qq(via package "$class" (perhaps you forgot to load "$class"?)) |
414
|
|
|
|
|
|
|
); |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
### Slurp |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub flat { |
420
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
421
|
0
|
0
|
|
|
|
|
return map @$_, $_[0]->arrays if wantarray; |
422
|
0
|
|
|
|
|
|
return [ map @$_, $_[0]->arrays ]; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub arrays { |
426
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
427
|
0
|
0
|
|
|
|
|
return @{ $_[0]->{st}->{sth}->fetchall_arrayref } if wantarray; |
|
0
|
|
|
|
|
|
|
428
|
0
|
|
|
|
|
|
return $_[0]->{st}->{sth}->fetchall_arrayref; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub hashes { |
432
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
433
|
0
|
|
|
|
|
|
my @return; |
434
|
|
|
|
|
|
|
my $dummy; |
435
|
0
|
|
|
|
|
|
push @return, $dummy while $dummy = $_[0]->hash; |
436
|
0
|
0
|
|
|
|
|
return wantarray ? @return : \@return; |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub kv_flat { |
440
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
441
|
0
|
0
|
|
|
|
|
return map @$_, $_[0]->kv_arrays if wantarray; |
442
|
0
|
|
|
|
|
|
return [ map @$_, $_[0]->kv_arrays ]; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub kv_arrays { |
446
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
447
|
0
|
|
|
|
|
|
my @return; |
448
|
|
|
|
|
|
|
my $dummy; |
449
|
0
|
|
|
|
|
|
push @return, $dummy while $dummy = $_[0]->kv_array; |
450
|
0
|
0
|
|
|
|
|
return wantarray ? @return : \@return; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
sub objects { |
454
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
455
|
0
|
|
|
|
|
|
my $self = shift; |
456
|
0
|
|
0
|
|
|
|
my $class = shift || ':RowObject'; |
457
|
0
|
0
|
|
|
|
|
if ($class =~ /^:/) { |
458
|
0
|
|
|
|
|
|
$class = "DBIx::Simple::Result:$class"; |
459
|
0
|
|
|
|
|
|
(my $package = "$class.pm") =~ s[::][/]g; |
460
|
0
|
|
|
|
|
|
require $package; |
461
|
|
|
|
|
|
|
} |
462
|
0
|
0
|
|
|
|
|
if ($class->can('new_from_dbix_simple')) { |
463
|
0
|
0
|
|
|
|
|
return $class->new_from_dbix_simple($self, @_) if wantarray; |
464
|
0
|
|
|
|
|
|
return [ $class->new_from_dbix_simple($self, @_) ]; |
465
|
|
|
|
|
|
|
} |
466
|
0
|
0
|
|
|
|
|
if ($class->can('new')) { |
467
|
0
|
0
|
|
|
|
|
return map { $class->new( @$_ ) } $self->kv_arrays if wantarray; |
|
0
|
|
|
|
|
|
|
468
|
0
|
|
|
|
|
|
return [ map { $class->new( @$_ ) } $self->kv_arrays ]; |
|
0
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
Carp::croak( |
471
|
0
|
|
|
|
|
|
qq(Can't locate object method "new_from_dbix_simple" or "new" ) . |
472
|
|
|
|
|
|
|
qq(via package "$class" (perhaps you forgot to load "$class"?)) |
473
|
|
|
|
|
|
|
); |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub map_hashes { |
477
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
478
|
0
|
|
|
|
|
|
my ($self, $keyname) = @_; |
479
|
0
|
0
|
|
|
|
|
Carp::croak('Key column name not optional') if not defined $keyname; |
480
|
0
|
|
|
|
|
|
my @rows = $self->hashes; |
481
|
0
|
|
|
|
|
|
my @keys; |
482
|
0
|
|
|
|
|
|
push @keys, delete $_->{$keyname} for @rows; |
483
|
0
|
|
|
|
|
|
my %return; |
484
|
0
|
|
|
|
|
|
@return{@keys} = @rows; |
485
|
0
|
0
|
|
|
|
|
return wantarray ? %return : \%return; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
sub map_arrays { |
489
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
490
|
0
|
|
|
|
|
|
my ($self, $keyindex) = @_; |
491
|
0
|
|
|
|
|
|
$keyindex += 0; |
492
|
0
|
|
|
|
|
|
my @rows = $self->arrays; |
493
|
0
|
|
|
|
|
|
my @keys; |
494
|
0
|
|
|
|
|
|
push @keys, splice @$_, $keyindex, 1 for @rows; |
495
|
0
|
|
|
|
|
|
my %return; |
496
|
0
|
|
|
|
|
|
@return{@keys} = @rows; |
497
|
0
|
0
|
|
|
|
|
return wantarray ? %return : \%return; |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
sub map { |
501
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
502
|
0
|
0
|
|
|
|
|
return map @$_, @{ $_[0]->{st}->{sth}->fetchall_arrayref } if wantarray; |
|
0
|
|
|
|
|
|
|
503
|
0
|
|
|
|
|
|
return { map @$_, @{ $_[0]->{st}->{sth}->fetchall_arrayref } }; |
|
0
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
sub rows { |
507
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
508
|
0
|
|
|
|
|
|
$_[0]->{st}->{sth}->rows; |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub xto { |
512
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
513
|
0
|
|
|
|
|
|
require DBIx::XHTML_Table; |
514
|
0
|
|
|
|
|
|
my $self = shift; |
515
|
0
|
0
|
|
|
|
|
my $attr = ref $_[0] ? $_[0] : { @_ }; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# Old DBD::SQLite (.29) spits out garbage if done *after* fetching. |
518
|
0
|
|
|
|
|
|
my $columns = $self->{st}->{sth}->{NAME}; |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
|
return DBIx::XHTML_Table->new( |
521
|
|
|
|
|
|
|
scalar $self->arrays, |
522
|
|
|
|
|
|
|
$columns, |
523
|
|
|
|
|
|
|
$attr |
524
|
|
|
|
|
|
|
); |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
sub html { |
528
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
529
|
0
|
|
|
|
|
|
my $self = shift; |
530
|
0
|
0
|
|
|
|
|
my $attr = ref $_[0] ? $_[0] : { @_ }; |
531
|
0
|
|
|
|
|
|
return $self->xto($attr)->output($attr); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub text { |
535
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
536
|
0
|
|
|
|
|
|
my ($self, $type) = @_; |
537
|
|
|
|
|
|
|
my $text_table = defined $type && length $type |
538
|
|
|
|
|
|
|
? 0 |
539
|
0
|
0
|
0
|
|
|
|
: eval { require Text::Table; $type = 'table'; 1 }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
540
|
0
|
|
0
|
|
|
|
$type ||= 'neat'; |
541
|
0
|
0
|
0
|
|
|
|
if ($type eq 'box' or $type eq 'table') { |
542
|
0
|
|
|
|
|
|
my $box = $type eq 'box'; |
543
|
0
|
0
|
|
|
|
|
$text_table or require Text::Table; |
544
|
0
|
|
|
|
|
|
my @columns = map +{ title => $_, align_title => 'center' }, |
545
|
0
|
|
|
|
|
|
@{ $self->{st}->{sth}->{NAME} }; |
546
|
0
|
|
|
|
|
|
my $c = 0; |
547
|
0
|
|
|
|
|
|
splice @columns, $_ + $c++, 0, \' | ' for 1 .. $#columns; |
548
|
0
|
0
|
|
|
|
|
my $table = Text::Table->new( |
|
|
0
|
|
|
|
|
|
549
|
|
|
|
|
|
|
($box ? \'| ' : ()), |
550
|
|
|
|
|
|
|
@columns, |
551
|
|
|
|
|
|
|
($box ? \' |' : ()) |
552
|
|
|
|
|
|
|
); |
553
|
0
|
|
|
|
|
|
$table->load($self->arrays); |
554
|
0
|
|
|
|
|
|
my $rule = $table->rule(qw/- +/); |
555
|
0
|
0
|
|
|
|
|
return join '', |
|
|
0
|
|
|
|
|
|
556
|
|
|
|
|
|
|
($box ? $rule : ()), |
557
|
|
|
|
|
|
|
$table->title, $rule, $table->body, |
558
|
|
|
|
|
|
|
($box ? $rule : ()); |
559
|
|
|
|
|
|
|
} |
560
|
0
|
0
|
|
|
|
|
Carp::carp("Unknown type '$type'; using 'neat'") if $type ne 'neat'; |
561
|
0
|
|
|
|
|
|
return join '', map DBI::neat_list($_) . "\n", $self->arrays; |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub finish { |
565
|
0
|
0
|
|
0
|
|
|
$_[0]->_die if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
566
|
0
|
|
|
|
|
|
my ($self) = @_; |
567
|
0
|
|
|
|
|
|
$self->_die( |
568
|
|
|
|
|
|
|
sprintf($err_cause, "$self->finish", (caller)[1, 2]) |
569
|
|
|
|
|
|
|
); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub DESTROY { |
573
|
0
|
0
|
|
0
|
|
|
return if ref $_[0]->{st} eq 'DBIx::Simple::DeadObject'; |
574
|
0
|
|
|
|
|
|
my ($self) = @_; |
575
|
0
|
|
|
|
|
|
$self->_die( |
576
|
|
|
|
|
|
|
sprintf($err_cause, "$self->DESTROY", (caller)[1, 2]) |
577
|
|
|
|
|
|
|
); |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
1; |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
__END__ |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=head1 NAME |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
DBIx::Simple - Very complete easy-to-use OO interface to DBI |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=head1 SYNOPSIS |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=head2 DBIx::Simple |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
$db = DBIx::Simple->connect(...) # or ->new |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
$db->keep_statements = 16 |
595
|
|
|
|
|
|
|
$db->lc_columns = 1 |
596
|
|
|
|
|
|
|
$db->result_class = 'DBIx::Simple::Result'; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
$db->begin_work $db->commit |
599
|
|
|
|
|
|
|
$db->rollback $db->disconnect |
600
|
|
|
|
|
|
|
$db->func(...) $db->last_insert_id |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
$result = $db->query(...) |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=head2 DBIx::SImple + SQL::Interp |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
$result = $db->iquery(...) |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=head2 DBIx::Simple + SQL::Abstract |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
$db->abstract = SQL::Abstract->new(...) |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
$result = $db->select(...) |
613
|
|
|
|
|
|
|
$result = $db->insert(...) |
614
|
|
|
|
|
|
|
$result = $db->update(...) |
615
|
|
|
|
|
|
|
$result = $db->delete(...) |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=head2 DBIx::Simple::Result |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
@columns = $result->columns |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
$result->into($foo, $bar, $baz) |
622
|
|
|
|
|
|
|
$row = $result->fetch |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
@row = $result->list @rows = $result->flat |
625
|
|
|
|
|
|
|
$row = $result->array @rows = $result->arrays |
626
|
|
|
|
|
|
|
$row = $result->hash @rows = $result->hashes |
627
|
|
|
|
|
|
|
@row = $result->kv_list @rows = $result->kv_flat |
628
|
|
|
|
|
|
|
$row = $result->kv_array @rows = $result->kv_arrays |
629
|
|
|
|
|
|
|
$obj = $result->object @objs = $result->objects |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
%map = $result->map_arrays(...) |
632
|
|
|
|
|
|
|
%map = $result->map_hashes(...) |
633
|
|
|
|
|
|
|
%map = $result->map |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
$rows = $result->rows |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
$dump = $result->text |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
$result->finish |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
=head2 DBIx::Simple::Result + DBIx::XHTML_Table |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
$html = $result->html(...) |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
$table_object = $result->xto(...) |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=head2 Examples |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Please read L<DBIx::Simple::Examples> for code examples. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=head1 DESCRIPTION |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
DBIx::Simple provides a simplified interface to DBI, Perl's powerful database |
654
|
|
|
|
|
|
|
module. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
This module is aimed at rapid development and easy maintenance. Query |
657
|
|
|
|
|
|
|
preparation and execution are combined in a single method, the result object |
658
|
|
|
|
|
|
|
(which is a wrapper around the statement handle) provides easy row-by-row and |
659
|
|
|
|
|
|
|
slurping methods. |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
The C<query> method returns either a result object, or a dummy object. The |
662
|
|
|
|
|
|
|
dummy object returns undef (or an empty list) for all methods and when used in |
663
|
|
|
|
|
|
|
boolean context, is false. The dummy object lets you postpone (or skip) error |
664
|
|
|
|
|
|
|
checking, but it also makes immediate error checking simply C<< |
665
|
|
|
|
|
|
|
$db->query(...) or die $db->error >>. |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
=head2 DBIx::Simple methods |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
=head3 Class methods |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=over 14 |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=item C<connect($dbh)>, C<connect($dsn, $user, $pass, \%options)> |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=item C<new($dbh)>, C<new($dsn, $user, $pass, \%options)> |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
The C<connect> or C<new> class method takes either an existing DBI object |
678
|
|
|
|
|
|
|
($dbh), or a list of arguments to pass to C<< DBI->connect >>. See L<DBI> for a |
679
|
|
|
|
|
|
|
detailed description. |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
You cannot use this method to clone a DBIx::Simple object: the $dbh passed |
682
|
|
|
|
|
|
|
should be a DBI::db object, not a DBIx::Simple object. |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
For new connections, PrintError is disabled by default. If you enable it, |
685
|
|
|
|
|
|
|
beware that it will report line numbers in DBIx/Simple.pm. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
For new connections, B<RaiseError is enabled by default> unless the environment |
688
|
|
|
|
|
|
|
variable C<PERL_DBIX_SIMPLE_NO_RAISEERROR> is set to a non-empty non-0 value. |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
This method is the constructor and returns a DBIx::Simple object on success. On |
691
|
|
|
|
|
|
|
failure, it returns undef. |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=back |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=head3 Object methods |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=over 14 |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=item C<query($query, @values)> |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
Prepares and executes the query and returns a result object. |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
If the string C<(??)> is present in the query, it is replaced with a list of as |
704
|
|
|
|
|
|
|
many question marks as @values. |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
The database drivers substitute placeholders (question marks that do not appear |
707
|
|
|
|
|
|
|
in quoted literals) in the query with the given @values, after them escaping |
708
|
|
|
|
|
|
|
them. You should always use placeholders, and never use raw user input in |
709
|
|
|
|
|
|
|
database queries. |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
On success, returns a DBIx::Simple::Result object. On failure, returns a |
712
|
|
|
|
|
|
|
DBIx::Simple::Dummy object. |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=item C<iquery(...)> |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
Uses SQL::Interp to interpolate values into a query, and uses the resulting |
717
|
|
|
|
|
|
|
generated query and bind arguments with C<query>. See SQL::Interp's |
718
|
|
|
|
|
|
|
documentation for usage information. |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
Requires Mark Storberg's SQL::Interp, which is available from CPAN. SQL::Interp |
721
|
|
|
|
|
|
|
is a fork from David Manura's SQL::Interpolate. |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=item C<select>, C<insert>, C<update>, C<delete> |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
Calls the respective method on C<abstract>, and uses the resulting generated |
726
|
|
|
|
|
|
|
query and bind arguments with C<query>. See SQL::Abstract's documentation for |
727
|
|
|
|
|
|
|
usage information. You can override the object by assigning to the C<abstract> |
728
|
|
|
|
|
|
|
property. |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
Requires Nathan Wiger's SQL::Abstract, which is available from CPAN. |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=item C<begin_work>, C<begin>, C<commit>, C<rollback> |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
These transaction related methods call the DBI respective methods and |
735
|
|
|
|
|
|
|
Do What You Mean. See L<DBI> for details. |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
C<begin> is an alias for C<begin_work>. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=item C<func(...)> |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Calls the C<func> method of DBI. See L<DBI> for details. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=item C<last_insert_id(...)> |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Calls the C<last_insert_id> method of DBI. See L<DBI> for details. Note that |
746
|
|
|
|
|
|
|
this feature requires DBI 1.38 or newer. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=item C<disconnect> |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Destroys (finishes) active statements and disconnects. Whenever the database |
751
|
|
|
|
|
|
|
object is destroyed, this happens automatically if DBIx::Simple handled the |
752
|
|
|
|
|
|
|
connection (i.e. you didn't use an existing DBI handle). After disconnecting, |
753
|
|
|
|
|
|
|
you can no longer use the database object or any of its result objects. |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
=back |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
=head3 Object properties |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
=over 14 |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=item C<dbh> |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Exposes the internal database handle. Use this only if you know what you are |
764
|
|
|
|
|
|
|
doing. Keeping a reference or doing queries can interfere with DBIx::Simple's |
765
|
|
|
|
|
|
|
garbage collection and error reporting. |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=item C<lc_columns = $bool> |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
When true at time of query execution, makes several result object methods use |
770
|
|
|
|
|
|
|
lower cased column names. C<lc_columns> is true by default. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=item C<keep_statements = $integer> |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
Sets the number of statement objects that DBIx::Simple can keep for reuse. This |
775
|
|
|
|
|
|
|
can dramatically speed up repeated queries (like when used in a loop). |
776
|
|
|
|
|
|
|
C<keep_statements> is 16 by default. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
A query is only reused if it equals a previously used one literally. This means |
779
|
|
|
|
|
|
|
that to benefit from this caching mechanism, you must use placeholders and |
780
|
|
|
|
|
|
|
never interpolate variables yourself. |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# Wrong: |
783
|
|
|
|
|
|
|
$db->query("INSERT INTO foo VALUES ('$foo', '$bar', '$baz')"); |
784
|
|
|
|
|
|
|
$db->query("SELECT FROM foo WHERE foo = '$foo' OR bar = '$bar'"); |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
# Right: |
787
|
|
|
|
|
|
|
$db->query('INSERT INTO foo VALUES (??)', $foo, $bar, $baz); |
788
|
|
|
|
|
|
|
$db->query('SELECT FROM foo WHERE foo = ? OR bar = ?', $foo, $baz); |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
Of course, automatic value escaping is a much better reason for using |
791
|
|
|
|
|
|
|
placeholders. |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
=item C<result_class = $string> |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
Class to use for result objects. Defaults to DBIx::Simple::Result. A |
796
|
|
|
|
|
|
|
constructor is not used. |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=item C<error> |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
Returns the error string of the last DBI method. See the discussion of "C<err>" |
801
|
|
|
|
|
|
|
and "C<errstr>" in L<DBI>. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=item C<< abstract = SQL::Abstract->new(...) >> |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
Sets the object to use with the C<select>, C<insert>, C<update> and C<delete> |
806
|
|
|
|
|
|
|
methods. On first access, will create one with SQL::Abstract's default options. |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
Requires Nathan Wiger's SQL::Abstract, which is available from CPAN. |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
In theory, you can assign any object to this property, as long as that object |
811
|
|
|
|
|
|
|
has these four methods, and they return a list suitable for use with the |
812
|
|
|
|
|
|
|
C<query> method. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=back |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head2 DBIx::Simple::Dummy |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
The C<query> method of DBIx::Simple returns a dummy object on failure. Its |
819
|
|
|
|
|
|
|
methods all return an empty list or undef, depending on context. When used in |
820
|
|
|
|
|
|
|
boolean context, a dummy object evaluates to false. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head2 DBIx::Simple::Result methods |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Methods documented to return "a list" return a reference to an array of the |
825
|
|
|
|
|
|
|
same in scalar context, unless something else is explicitly mentioned. |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=over 14 |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item C<columns> |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Returns a list of column names. Affected by C<lc_columns>. |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=item C<bind(LIST)> |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Binds the given LIST of variables to the columns. Unlike with DBI's |
836
|
|
|
|
|
|
|
C<bind_columns>, passing references is not needed. |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
Bound variables are very efficient. Binding a tied variable doesn't work. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=item C<attr(...)> |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
Returns a copy of an sth attribute (property). See L<DBI/"Statement Handle |
843
|
|
|
|
|
|
|
Attributes"> for details. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=item C<func(...)> |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
This calls the C<func> method on the sth of DBI. See L<DBI> for details. |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item C<rows> |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
Returns the number of rows affected by the last row affecting command, or -1 if |
852
|
|
|
|
|
|
|
the number of rows is not known or not available. |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
For SELECT statements, it is generally not possible to know how many rows are |
855
|
|
|
|
|
|
|
returned. MySQL does provide this information. See L<DBI> for a detailed |
856
|
|
|
|
|
|
|
explanation. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=item C<finish> |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
Finishes the statement. After finishing a statement, it can no longer be used. |
861
|
|
|
|
|
|
|
When the result object is destroyed, its statement handle is automatically |
862
|
|
|
|
|
|
|
finished and destroyed. There should be no reason to call this method |
863
|
|
|
|
|
|
|
explicitly; just let the result object go out of scope. |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=back |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=head3 Fetching a single row at a time |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=over 14 |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=item C<fetch> |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
Returns a reference to the array that holds the values. This is the same array |
874
|
|
|
|
|
|
|
every time. |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
Subsequent fetches (using any method) may change the values in the variables |
877
|
|
|
|
|
|
|
passed and the returned reference's array. |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=item C<into(LIST)> |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
Combines C<bind> with C<fetch>. Returns what C<fetch> returns. |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=item C<list> |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
Returns a list of values, or (in scalar context), only the last value. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=item C<array> |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Returns a reference to an array. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item C<hash> |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Returns a reference to a hash, keyed by column name. Affected by C<lc_columns>. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=item C<kv_list> |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
Returns an ordered list of interleaved keys and values. Affected by |
898
|
|
|
|
|
|
|
C<lc_columns>. |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=item C<kv_array> |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
Returns a reference to an array of interleaved column names and values. Like |
903
|
|
|
|
|
|
|
kv, but returns an array reference even in list context. Affected by |
904
|
|
|
|
|
|
|
C<lc_columns>. |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item C<object($class, ...)> |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
Returns an instance of $class. See "Object construction". Possibly affected by |
909
|
|
|
|
|
|
|
C<lc_columns>. |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=back |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=head3 Fetching all remaining rows |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=over 14 |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=item C<flat> |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
Returns a flattened list. |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
=item C<arrays> |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
Returns a list of references to arrays |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=item C<hashes> |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
Returns a list of references to hashes, keyed by column name. Affected by |
928
|
|
|
|
|
|
|
C<lc_columns>. |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=item C<kv_flat> |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Returns an flattened list of interleaved column names and values. Affected by |
933
|
|
|
|
|
|
|
C<lc_columns>. |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=item C<kv_arrays> |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
Returns a list of references to arrays of interleaved column names and values. |
938
|
|
|
|
|
|
|
Affected by C<lc_columns>. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
=item C<objects($class, ...)> |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
Returns a list of instances of $class. See "Object construction". Possibly |
943
|
|
|
|
|
|
|
affected by C<lc_columns>. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=item C<map_arrays($column_number)> |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
Constructs a hash of array references keyed by the values in the chosen column, |
948
|
|
|
|
|
|
|
and returns a list of interleaved keys and values, or (in scalar context), a |
949
|
|
|
|
|
|
|
reference to a hash. |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=item C<map_hashes($column_name)> |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
Constructs a hash of hash references keyed by the values in the chosen column, |
954
|
|
|
|
|
|
|
and returns a list of interleaved keys and values, or (in scalar context), a |
955
|
|
|
|
|
|
|
reference to a hash. Affected by C<lc_columns>. |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=item C<map> |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
Constructs a simple hash, using the two columns as key/value pairs. Should |
960
|
|
|
|
|
|
|
only be used with queries that return two columns. Returns a list of interleaved |
961
|
|
|
|
|
|
|
keys and values, or (in scalar context), a reference to a hash. |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
=item C<xto(%attr)> |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
Returns a DBIx::XHTML_Table object, passing the constructor a reference to |
966
|
|
|
|
|
|
|
C<%attr>. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
Requires Jeffrey Hayes Anderson's DBIx::XHTML_Table, which is available from |
969
|
|
|
|
|
|
|
CPAN. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
In general, using the C<html> method (described below) is much easier. C<xto> |
972
|
|
|
|
|
|
|
is available in case you need more flexibility. Not affected by C<lc_columns>. |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=item C<html(%attr)> |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
Returns an (X)HTML formatted table, using the DBIx::XHTML_Table module. Passes |
977
|
|
|
|
|
|
|
a reference to C<%attr> to both the constructor and the C<output> method. |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
Requires Jeffrey Hayes Anderson's DBIx::XHTML_Table, which is available from |
980
|
|
|
|
|
|
|
CPAN. |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
This method is a shortcut method. That means that |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
$result->html |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
$result->html( |
987
|
|
|
|
|
|
|
tr => { bgcolor => [ 'silver', 'white' ] }, |
988
|
|
|
|
|
|
|
no_ucfirst => 1 |
989
|
|
|
|
|
|
|
) |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
do the same as: |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
$result->xto->output |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
$result->xto( |
996
|
|
|
|
|
|
|
tr => { bgcolor => [ 'silver', 'white' ] } |
997
|
|
|
|
|
|
|
)->output( |
998
|
|
|
|
|
|
|
no_ucfirst => 1 |
999
|
|
|
|
|
|
|
); |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=item C<text($type)> |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
Returns a string with a simple text representation of the data. C<$type> |
1004
|
|
|
|
|
|
|
can be any of: C<neat>, C<table>, C<box>. It defaults to C<table> if |
1005
|
|
|
|
|
|
|
Text::Table is installed, to C<neat> if it isn't. |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
C<table> and C<box> require Anno Siegel's Text::Table, which is available from |
1008
|
|
|
|
|
|
|
CPAN. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=back |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=head2 Object construction |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
DBIx::Simple has basic support for returning results as objects. The actual |
1015
|
|
|
|
|
|
|
construction method has to be provided by the chosen class, making this |
1016
|
|
|
|
|
|
|
functionality rather advanced and perhaps unsuited for beginning programmers. |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
When the C<object> or C<objects> method is called on the result object returned |
1019
|
|
|
|
|
|
|
by one of the query methods, two approaches are tried. In either case, pass the |
1020
|
|
|
|
|
|
|
name of a class as the first argument. A prefix of a single colon can be used |
1021
|
|
|
|
|
|
|
as an alias for C<DBIx::Simple::Result::>, e.g. C<":Example"> is short for |
1022
|
|
|
|
|
|
|
C<"DBIx::Simple::Result::Example">. When this shortcut is used, the |
1023
|
|
|
|
|
|
|
corresponding module is loaded automatically. |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
The default class when no class is given, is C<:RowObject>. It requires Jos |
1026
|
|
|
|
|
|
|
Boumans' Object::Accessor, which is available from CPAN. |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=head3 Simple object construction |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
When C<object> is given a class that provides a C<new> method, but not a |
1031
|
|
|
|
|
|
|
C<new_from_dbix_simple> method, C<new> is called with a list of interleaved |
1032
|
|
|
|
|
|
|
column names and values, like a flattened hash, but ordered. C<objects> causes |
1033
|
|
|
|
|
|
|
C<new> to be called multiple times, once for each remaining row. |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
Example: |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
{ |
1038
|
|
|
|
|
|
|
package DBIx::Simple::Result::ObjectExample; |
1039
|
|
|
|
|
|
|
sub new { |
1040
|
|
|
|
|
|
|
my ($class, %args) = @_; |
1041
|
|
|
|
|
|
|
return bless $class, \%args; |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
sub foo { ... } |
1045
|
|
|
|
|
|
|
sub bar { ... } |
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
$db->query('SELECT foo, bar FROM baz')->object(':ObjectExample')->foo(); |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=head3 Advanced object construction |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
When C<object> or C<objects> is given a class that provides a |
1054
|
|
|
|
|
|
|
C<new_from_dbix_simple> method, any C<new> is ignored, and |
1055
|
|
|
|
|
|
|
C<new_from_dbix_simple> is called with a list of the DBIx::Simple::Result |
1056
|
|
|
|
|
|
|
object and any arguments passed to C<object> or C<objects>. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
C<new_from_dbix_simple> is called in scalar context for C<object>, and in list |
1059
|
|
|
|
|
|
|
context for C<objects>. In scalar context, it should fetch I<exactly one row>, |
1060
|
|
|
|
|
|
|
and in list context, it should fetch I<all remaining rows>. |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
Example: |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
{ |
1065
|
|
|
|
|
|
|
package DBIx::Simple::Result::ObjectExample; |
1066
|
|
|
|
|
|
|
sub new_from_dbix_simple { |
1067
|
|
|
|
|
|
|
my ($class, $result, @args) = @_; |
1068
|
|
|
|
|
|
|
return map { bless $class, $_ } $result->hashes if wantarray; |
1069
|
|
|
|
|
|
|
return bless $class, $result->hash; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
sub foo { ... } |
1073
|
|
|
|
|
|
|
sub bar { ... } |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
$db->query('SELECT foo, bar FROM baz')->object(':ObjectExample')->foo(); |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head1 MISCELLANEOUS |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
The mapping methods do not check whether the keys are unique. Rows that are |
1081
|
|
|
|
|
|
|
fetched later overwrite earlier ones. |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
=head1 LICENSE |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
Pick your favourite OSI approved license :) |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
http://www.opensource.org/licenses/alphabetical |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
=head1 AUTHOR |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
Juerd Waalboer <#####@juerd.nl> <http://juerd.nl/> |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=head1 SEE ALSO |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
L<perl>, L<perlref> |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
L<DBI>, L<DBIx::Simple::Examples>, L<SQL::Abstract>, L<DBIx::XHTML_Table> |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=cut |
1101
|
|
|
|
|
|
|
|