File Coverage

blib/lib/DBIx/Simple.pm
Criterion Covered Total %
statement 25 284 8.8
branch 0 168 0.0
condition 0 36 0.0
subroutine 7 66 10.6
pod 17 17 100.0
total 49 571 8.5


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