File Coverage

blib/lib/Rose/DB.pm
Criterion Covered Total %
statement 469 1175 39.9
branch 188 580 32.4
condition 112 330 33.9
subroutine 81 209 38.7
pod 69 157 43.9
total 919 2451 37.4


line stmt bran cond sub pod time code
1             package Rose::DB;
2              
3 16     16   2454261 use strict;
  16         145  
  16         480  
4              
5 16     16   25059 use DBI;
  16         283887  
  16         950  
6 16     16   139 use Carp();
  16         30  
  16         238  
7 16     16   8479 use Clone::PP();
  16         12867  
  16         376  
8 16     16   8792 use Bit::Vector::Overload;
  16         188106  
  16         850  
9 16     16   9329 use SQL::ReservedWords();
  16         217376  
  16         539  
10              
11 16     16   8645 use Time::Clock;
  16         80706  
  16         660  
12 16     16   7463 use Rose::DateTime::Util();
  16         6992385  
  16         524  
13              
14 16     16   9496 use Rose::DB::Cache;
  16         57  
  16         489  
15 16     16   7779 use Rose::DB::Registry;
  16         47  
  16         526  
16 16     16   111 use Rose::DB::Registry::Entry;
  16         33  
  16         393  
17 16     16   7721 use Rose::DB::Constants qw(IN_TRANSACTION);
  16         36  
  16         1007  
18              
19 16     16   98 use Rose::Object;
  16         32  
  16         1244  
20             our @ISA = qw(Rose::Object);
21              
22             our $Error;
23              
24             our $VERSION = '0.783';
25              
26             our $Debug = 0;
27              
28             #
29             # Class data
30             #
31              
32             use Rose::Class::MakeMethods::Generic
33             (
34 16         198 inheritable_scalar =>
35             [
36             'default_domain',
37             'default_type',
38             'registry',
39             'max_array_characters',
40             'max_interval_characters',
41             '_db_cache',
42             'db_cache_class',
43             'parent_class',
44             ],
45              
46             inheritable_boolean =>
47             [
48             'default_keyword_function_calls',
49             ]
50 16     16   156 );
  16         29  
51              
52             use Rose::Class::MakeMethods::Generic
53             (
54 16         205 inheritable_hash =>
55             [
56             driver_classes => { interface => 'get_set_all' },
57             _driver_class => { interface => 'get_set', hash_key => 'driver_classes' },
58             delete_driver_class => { interface => 'delete', hash_key => 'driver_classes' },
59              
60             default_connect_options => { interface => 'get_set_all', },
61             default_connect_option => { interface => 'get_set', hash_key => 'default_connect_options' },
62             delete_connect_option => { interface => 'delete', hash_key => 'default_connect_options' },
63             ],
64 16     16   10307 );
  16         40  
65              
66             __PACKAGE__->db_cache_class('Rose::DB::Cache');
67             __PACKAGE__->default_domain('default');
68             __PACKAGE__->default_type('default');
69              
70             __PACKAGE__->max_array_characters(255); # Used for array type emulation
71             __PACKAGE__->max_interval_characters(255); # Used for interval type emulation
72              
73             __PACKAGE__->default_keyword_function_calls(
74             defined $ENV{'ROSE_DB_KEYWORD_FUNCTION_CALLS'} ? $ENV{'ROSE_DB_KEYWORD_FUNCTION_CALLS'} : 0);
75              
76             __PACKAGE__->driver_classes
77             (
78             mysql => 'Rose::DB::MySQL',
79             mariadb => 'Rose::DB::MariaDB',
80             pg => 'Rose::DB::Pg',
81             informix => 'Rose::DB::Informix',
82             oracle => 'Rose::DB::Oracle',
83             sqlite => 'Rose::DB::SQLite',
84             generic => 'Rose::DB::Generic',
85             );
86              
87             __PACKAGE__->default_connect_options
88             (
89             AutoCommit => 1,
90             RaiseError => 1,
91             PrintError => 1,
92             ChopBlanks => 1,
93             Warn => 0,
94             );
95              
96 16     16   9551 BEGIN { __PACKAGE__->registry(Rose::DB::Registry->new(parent => __PACKAGE__)) }
97              
98             my %Class_Loaded;
99              
100             # Load on demand instead
101             # LOAD_SUBCLASSES:
102             # {
103             # my %seen;
104             #
105             # my $map = __PACKAGE__->driver_classes;
106             #
107             # foreach my $class (values %$map)
108             # {
109             # eval qq(require $class) unless($seen{$class}++);
110             # die "Could not load $class - $@" if($@);
111             # }
112             # }
113              
114             #
115             # Object data
116             #
117              
118             use Rose::Object::MakeMethods::Generic
119             (
120 16         261 'scalar' =>
121             [
122             qw(dbi_driver username _dbh_refcount id)
123             ],
124              
125             'boolean' =>
126             [
127             'auto_create' => { default => 1 },
128             'european_dates' => { default => 0 },
129             ],
130              
131             'scalar --get_set_init' =>
132             [
133             'domain',
134             'type',
135             'date_handler',
136             'server_time_zone',
137             'keyword_function_calls',
138             ],
139              
140             'array' =>
141             [
142             'post_connect_sql',
143             'pre_disconnect_sql',
144             ],
145              
146             'hash' =>
147             [
148             connect_options => { interface => 'get_set_init' },
149             ]
150 16     16   2164 );
  16         36  
151              
152             #
153             # Class methods
154             #
155              
156             sub register_db
157             {
158 224     224 1 312433 my $class = shift;
159              
160             # Smuggle parent/caller in with an otherwise nonsensical arrayref arg
161 224         623 my $entry = $class->registry->add_entry([ $class ], @_);
162              
163 224 50       900 if($entry)
164             {
165 224         659 my $driver = $entry->driver;
166              
167 224 50       493 Carp::confess "No driver found for registry entry $entry"
168             unless(defined $driver);
169              
170 224         519 $class->setup_dynamic_class_for_driver($driver);
171             }
172              
173 224         3272 return $entry;
174             }
175              
176             our %Rebless;
177              
178             sub setup_dynamic_class_for_driver
179             {
180 306     306 0 625 my($class, $driver) = @_;
181              
182 306   33     765 my $driver_class = $class->driver_class($driver) ||
183             $class->driver_class('generic') || Carp::croak
184             "No driver class found for drivers '$driver' or 'generic'";
185              
186 306 100       5811 unless($Rebless{$class,$driver_class})
187             {
188 16     16   29347 no strict 'refs';
  16         53  
  16         2279  
189 184 100 100     538 unless($Class_Loaded{$driver_class} || @{"${driver_class}::ISA"})
  164         1233  
190             {
191 82         149 my $error;
192              
193             TRY:
194             {
195 82         120 local $@;
  82         126  
196 82         4734 eval "require $driver_class";
197 82         413 $error = $@;
198             }
199              
200 82 50       297 Carp::croak "Could not load driver class '$driver_class' - $error" if($error);
201             }
202              
203 184         420 $Class_Loaded{$driver_class}++;
204              
205             # Make a new driver class based on the current class
206 184         568 my $new_class = $class . '::__RoseDBPrivate__::' . $driver_class;
207              
208 16     16   115 no strict 'refs';
  16         38  
  16         24818  
209 184         299 @{"${new_class}::ISA"} = ($driver_class, $class);
  184         5000  
210 184         742 *{"${new_class}::STORABLE_thaw"} = \&STORABLE_thaw;
  184         1302  
211 184         359 *{"${new_class}::STORABLE_freeze"} = \&STORABLE_freeze;
  184         657  
212              
213 184         1670 $new_class->parent_class($class);
214              
215             # Cache result
216 184         2164 $Rebless{$class,$driver_class} = $new_class;
217             }
218              
219 306         774 return $Rebless{$class,$driver_class};
220             }
221              
222 0     0 1 0 sub unregister_db { shift->registry->delete_entry(@_) }
223              
224 0     0 0 0 sub default_implicit_schema { undef }
225 0     0 0 0 sub registration_schema { undef }
226              
227 19     19 1 1949 sub use_private_registry { $_[0]->registry(Rose::DB::Registry->new(parent => $_[0])) }
228              
229             sub modify_db
230             {
231 4     4 1 13665 my($class, %args) = @_;
232              
233 4   33     22 my $domain = delete $args{'domain'} || $class->default_domain ||
234             Carp::croak "Missing domain";
235              
236 4   33     19 my $type = delete $args{'type'} || $class->default_type ||
237             Carp::croak "Missing type";
238              
239 4 50       16 my $entry = $class->registry->entry(domain => $domain, type => $type) or
240             Carp::croak "No db defined for domain '$domain' and type '$type'";
241              
242 4         48 while(my($key, $val) = each(%args))
243             {
244 8         54 $entry->$key($val);
245             }
246              
247 4         26 return $entry;
248             }
249              
250             sub db_exists
251             {
252 14     14 1 7437 my($class) = shift;
253              
254 14 100       60 my %args = (@_ == 1) ? (type => $_[0]) : @_;
255              
256 14   33     58 my $domain = $args{'domain'} || $class->default_domain ||
257             Carp::croak "Missing domain";
258              
259 14   33     188 my $type = $args{'type'} || $class->default_type ||
260             Carp::croak "Missing type";
261              
262 14         42 return $class->registry->entry_exists(domain => $domain, type => $type);
263             }
264              
265             sub alias_db
266             {
267 2     2 1 28 my($class, %args) = @_;
268              
269 2 50       9 my $source = $args{'source'} or Carp::croak "Missing source";
270              
271 2 50       10 my $src_domain = $source->{'domain'} or Carp::croak "Missing source domain";
272 2 50       9 my $src_type = $source->{'type'} or Carp::croak "Missing source type";
273              
274 2 50       9 my $alias = $args{'alias'} or Carp::croak "Missing alias";
275              
276 2 50       9 my $alias_domain = $alias->{'domain'} or Carp::croak "Missing source domain";
277 2 50       7 my $alias_type = $alias->{'type'} or Carp::croak "Missing source type";
278              
279 2         6 my $registry = $class->registry;
280              
281 2 50       44 my $entry = $registry->entry(domain => $src_domain, type => $src_type) or
282             Carp::croak "No db defined for domain '$src_domain' and type '$src_type'";
283              
284 2         25 $registry->add_entry(domain => $alias_domain,
285             type => $alias_type,
286             entry => $entry);
287             }
288              
289 0     0 1 0 sub unregister_domain { shift->registry->delete_domain(@_) }
290              
291             sub driver_class
292             {
293 546     546 1 6707 my($class, $driver) = (shift, lc shift);
294              
295 546 100       1105 if(@_)
296             {
297 82         309 $class->_driver_class($driver, @_);
298 82         2383 $class->setup_dynamic_class_for_driver($driver);
299             }
300              
301 546         1363 return $class->_driver_class($driver);
302             }
303              
304             sub db_cache
305             {
306 0     0 1 0 my($class) = shift;
307              
308 0 0       0 if(@_)
309             {
310 0         0 return $class->_db_cache(@_);
311             }
312              
313 0 0       0 if(my $cache = $class->_db_cache)
314             {
315 0         0 return $cache;
316             }
317              
318 0         0 my $cache_class = $class->db_cache_class;
319              
320 0         0 my $error;
321              
322             TRY:
323             {
324 0         0 local $@;
  0         0  
325 0         0 eval "use $cache_class";
326 0         0 $error = $@;
327             }
328              
329 0 0       0 die "Could not load db cache class '$cache_class' - $error" if($error);
330              
331 0         0 return $class->_db_cache($cache_class->new);
332             }
333              
334             sub use_cache_during_apache_startup
335             {
336 0     0 1 0 shift->db_cache->use_cache_during_apache_startup(@_);
337             }
338              
339             sub prepare_cache_for_apache_fork
340             {
341 0     0 1 0 shift->db_cache->prepare_for_apache_fork(@_);
342             }
343              
344             sub new_or_cached
345             {
346 0     0 1 0 my($class) = shift;
347              
348 0 0       0 @_ = (type => $_[0]) if(@_ == 1);
349              
350 0         0 my %args = @_;
351              
352 0 0       0 $args{'domain'} = $class->default_domain unless(exists $args{'domain'});
353 0 0       0 $args{'type'} = $class->default_type unless(exists $args{'type'});
354              
355             #$Debug && warn "New or cached db type: $args{'type'}, domain: $args{'domain'}\n";
356              
357 0         0 my $cache = $class->db_cache;
358              
359 0 0       0 if(my $db = $cache->get_db(%args))
360             {
361 0 0       0 $Debug && warn "$$ $class Returning cached db (", $db->domain, ', ', $db->type,
362             ") $db from ", $cache, "\n";
363 0         0 return $db;
364             }
365              
366 0 0       0 if($Debug)
367             {
368 0         0 my $db = $class->new(@_);
369             $Debug && warn "$$ $class Setting cached db $db (",
370 0 0       0 join(', ', map { $args{$_} } qw(domain type)),
  0         0  
371             ") in ", $cache, "\n";
372              
373             # The set_db() call may refuse to set, so call get_db() to properly
374             # register clean-up handlers, etc., but fall back to the db returned
375             # by set_db() in the case where the db was never cached.
376 0         0 $db = $cache->set_db($class->new(@_));
377 0   0     0 return $cache->get_db(%args) || $db;
378             }
379             else
380             {
381             # The set_db() call may refuse to set, so call get_db() to properly
382             # register clean-up handlers, etc., but fall back to the db returned
383             # by set_db() in the case where the db was never cached.
384 0         0 my $db = $cache->set_db($class->new(@_));
385 0   0     0 return $cache->get_db(%args) || $db;
386             }
387             }
388              
389 0     0 0 0 sub clear_db_cache { shift->db_cache->clear(@_) }
390              
391             #
392             # Object methods
393             #
394              
395             sub new
396             {
397 86     86 1 99086 my($class) = shift;
398              
399 86 100       356 @_ = (type => $_[0]) if(@_ == 1);
400              
401 86         247 my %args = @_;
402              
403 86   33     249 my $allow_empty = $args{'driver'} && !($args{'type'} || $args{'domain'});
404              
405             my $domain =
406 86 100       412 exists $args{'domain'} ? delete $args{'domain'} : $class->default_domain;
407              
408             my $type =
409 86 100       1177 exists $args{'type'} ? delete $args{'type'} : $class->default_type;
410              
411 86         278 my $db_info;
412              
413             # I'm being bad here for speed purposes, digging into private hashes instead
414             # of using object methods. I'll fix it when the first person emails me to
415             # complain that I'm breaking their Rose::DB or Rose::DB::Registry[::Entry]
416             # subclass by doing this. Call it "demand-paged programming" :)
417 86         252 my $registry = $class->registry->hash;
418              
419 86 100 100     2065 if(exists $registry->{$domain} && exists $registry->{$domain}{$type})
    50          
420             {
421 68         161 $db_info = $registry->{$domain}{$type}
422             }
423             elsif(!$allow_empty)
424             {
425 18         2649 Carp::croak "No database information found for domain '$domain' and ",
426             "type '$type' and no driver type specified in call to ",
427             "$class->new(...)";
428             }
429              
430 68   33     249 my $driver = $db_info->{'driver'} || $args{'driver'};
431              
432 68 50       158 Carp::croak "No driver found for domain '$domain' and type '$type'"
433             unless(defined $driver);
434              
435 68   33     177 my $driver_class = $class->driver_class($driver) ||
436             $class->driver_class('generic') || Carp::croak
437             "No driver class found for drivers '$driver' or 'generic'";
438              
439 68 50       1264 unless($Class_Loaded{$driver_class})
440             {
441 0         0 $class->load_driver_class($driver_class);
442             }
443              
444 68         106 my $self;
445              
446             REBLESS: # Do slightly evil re-blessing magic
447             {
448             # Check cache
449 68 50       128 if(my $new_class = $Rebless{$class,$driver_class})
  68         314  
450             {
451 68         357 $self = bless {}, $new_class;
452             }
453             else
454             {
455             # Make a new driver class based on the current class
456 0         0 my $new_class = $class . '::__RoseDBPrivate__::' . $driver_class;
457              
458 16     16   130 no strict 'refs';
  16         37  
  16         4831  
459 0         0 @{"${new_class}::ISA"} = ($driver_class, $class);
  0         0  
460              
461 0         0 $self = bless {}, $new_class;
462              
463 0         0 $new_class->parent_class($class);
464              
465             # Cache result
466 0         0 $Rebless{$class,$driver_class} = ref $self;
467             }
468             }
469              
470 68         540 $self->class($class);
471              
472 68         224 $self->{'id'} = "$domain\0$type";
473 68         124 $self->{'type'} = $type;
474 68         139 $self->{'domain'} = $domain;
475              
476 68         411 $self->init(@_);
477              
478 68         1131 $self->init_db_info;
479              
480 68         310 return $self;
481             }
482              
483             sub class
484             {
485 140     140 0 238 my($self) = shift;
486 140 100       647 return $self->{'_origin_class'} = shift if(@_);
487 72   33     313 return $self->{'_origin_class'} || ref $self;
488             }
489              
490 6     6 0 103 sub init_keyword_function_calls { ref($_[0])->default_keyword_function_calls }
491              
492             # sub init
493             # {
494             # my($self) = shift;
495             # $self->SUPER::init(@_);
496             # $self->init_db_info;
497             # }
498              
499             sub load_driver_class
500             {
501 80     80 0 146 my($class, $arg) = @_;
502              
503 80   33     188 my $driver_class = $class->driver_class($arg) || $arg;
504              
505 16     16   130 no strict 'refs';
  16         32  
  16         40188  
506 80 100       1106 unless(defined ${"${driver_class}::VERSION"})
  80         342  
507             {
508 16         38 my $error;
509              
510             TRY:
511             {
512 16         39 local $@;
  16         36  
513 16         908 eval "require $driver_class";
514 16         91 $error = $@;
515             }
516              
517 16 50       76 Carp::croak "Could not load driver class '$driver_class' - $error" if($error);
518             }
519              
520 80         227 $Class_Loaded{$driver_class}++;
521             }
522              
523 0     0 0 0 sub driver_class_is_loaded { $Class_Loaded{$_[1]} }
524              
525             sub load_driver_classes
526             {
527 16     16 0 12148 my($class) = shift;
528              
529 16         96 my $map = $class->driver_classes;
530              
531 16 50       264 foreach my $arg (@_ ? @_ : keys %$map)
532             {
533 80         186 $class->load_driver_class($arg);
534             }
535              
536 16         56 return;
537             }
538              
539             sub database
540             {
541 75     75 1 205 my($self) = shift;
542              
543 75 100       168 if(@_)
544             {
545 73 100       168 $self->{'dsn'} = undef if($self->{'dsn'});
546 73         285 return $self->{'database'} = shift;
547             }
548              
549 2         12 return $self->{'database'};
550             }
551              
552             sub schema
553             {
554 0     0 1 0 my($self) = shift;
555              
556 0 0       0 if(@_)
557             {
558 0 0       0 $self->{'dsn'} = undef if($self->{'dsn'});
559 0         0 return $self->{'schema'} = shift;
560             }
561              
562 0         0 return $self->{'schema'};
563             }
564              
565             sub catalog
566             {
567 0     0 1 0 my($self) = shift;
568              
569 0 0       0 if(@_)
570             {
571 0 0       0 $self->{'dsn'} = undef if($self->{'dsn'});
572 0         0 return $self->{'catalog'} = shift;
573             }
574              
575 0         0 return $self->{'catalog'};
576             }
577              
578             sub host
579             {
580 62     62 1 133 my($self) = shift;
581              
582 62 50       146 if(@_)
583             {
584 62 50       157 $self->{'dsn'} = undef if($self->{'dsn'});
585 62         237 return $self->{'host'} = shift;
586             }
587              
588 0         0 return $self->{'host'};
589             }
590              
591             sub port
592             {
593 9     9 1 23 my($self) = shift;
594              
595 9 50       21 if(@_)
596             {
597 9 50       20 $self->{'dsn'} = undef if($self->{'dsn'});
598 9         21 return $self->{'port'} = shift;
599             }
600              
601 0         0 return $self->{'port'};
602             }
603              
604             sub database_version
605             {
606 0     0 0 0 my($self) = shift;
607 0 0       0 return $self->{'database_version'} if(defined $self->{'database_version'});
608 0         0 return $self->{'database_version'} = $self->dbh->get_info(18); # SQL_DBMS_VER
609             }
610              
611             # Use a closure to keep the password from appearing when the
612             # object is dumped using Data::Dumper
613             sub password
614             {
615 95     95 1 181 my($self) = shift;
616              
617 95 100       232 if(@_)
618             {
619 54         98 my $password = shift;
620 54     31   263 $self->{'password_closure'} = sub { $password };
  31         210  
621 54         228 return $password;
622             }
623              
624 41 100       183 return $self->{'password_closure'} ? $self->{'password_closure'}->() : undef;
625             }
626              
627             # These have to "cheat" to get the right values by going through
628             # the real origin class because they may be called after the
629             # re-blessing magic takes place.
630 0     0 0 0 sub init_domain { shift->{'_origin_class'}->default_domain }
631 0     0 0 0 sub init_type { shift->{'_origin_class'}->default_type }
632              
633 2     2 0 53 sub init_date_handler { Rose::DateTime::Format::Generic->new }
634 0     0 0 0 sub init_server_time_zone { 'floating' }
635              
636             sub init_db_info
637             {
638 72     72 1 154 my($self, %args) = @_;
639              
640 72 100       181 return 1 if($self->{'dsn'});
641              
642 70         147 my $class = ref $self;
643              
644 70         293 my $domain = $self->domain;
645 70         516 my $type = $self->type;
646              
647 70         350 my $db_info;
648              
649             # I'm being bad here for speed purposes, digging into private hashes instead
650             # of using object methods. I'll fix it when the first person emails me to
651             # complain that I'm breaking their Rose::DB or Rose::DB::Registry[::Entry]
652             # subclass by doing this. Call it "demand-paged programming" :)
653 70         132 my $registry = $self->class->registry->hash;
654              
655 70 50 33     1462 if(exists $registry->{$domain} && exists $registry->{$domain}{$type})
656             {
657 70         147 $db_info = $registry->{$domain}{$type}
658             }
659             else
660             {
661 0 0       0 return 1 if($self->{'driver'});
662 0         0 Carp::croak "No database information found for domain '$domain' and type '$type'";
663             }
664              
665 70 50 33     334 unless($args{'refresh'} || ($self->{'connect_options_for'}{$domain} &&
      66        
666             $self->{'connect_options_for'}{$domain}{$type}))
667             {
668 66 100       179 if(my $custom_options = $db_info->{'connect_options'})
669             {
670 28         116 my $options = $self->connect_options;
671 28         2352 @$options{keys %$custom_options} = values %$custom_options;
672             }
673              
674 66         256 $self->{'connect_options_for'} = { $domain => { $type => 1 } };
675             }
676              
677 70         413 $self->driver($db_info->{'driver'});
678              
679 70         320 while(my($field, $value) = each(%$db_info))
680             {
681 573 100 66     2868 if($field ne 'connect_options' && defined $value && !defined $self->{$field})
      100        
682             {
683 317         1706 $self->$field($value);
684             }
685             }
686              
687 70         208 return 1;
688             }
689              
690             sub init_connect_options
691             {
692 57     57 0 648 my($class) = ref $_[0];
693 57         281 return Clone::PP::clone(scalar $class->default_connect_options);
694             }
695              
696             sub connect_option
697             {
698 50     50 1 114 my($self, $param) = (shift, shift);
699              
700 50         187 my $options = $self->connect_options;
701              
702 50 100       2174 return $options->{$param} = shift if(@_);
703 25         78 return $options->{$param};
704             }
705              
706             sub dsn
707             {
708 51     51 1 18132 my($self) = shift;
709              
710 51 100       128 unless(@_)
711             {
712 45   66     527 return $self->{'dsn'} || $self->build_dsn(%$self);
713             }
714              
715 6 50       18 if(my $dsn = shift)
716             {
717 6         14 foreach my $method (qw(database host port))
718             {
719 18         81 $self->$method(undef);
720             }
721              
722 6         21 $self->init($self->parse_dsn($dsn));
723 4         19 return $self->{'dsn'} = $dsn;
724             }
725             else
726             {
727 0         0 $self->{'dsn'} = undef;
728 0         0 return $self->build_dsn(%$self);
729             }
730             }
731              
732             my %DSN_Attr_Method =
733             (
734             db => 'database',
735             dbname => 'database',
736             user => 'username',
737             hostname => 'host',
738             hostaddr => 'host',
739             sid => 'database',
740             );
741              
742 16     16 0 69 sub dsn_attribute_to_db_method { $DSN_Attr_Method{$_[1]} }
743              
744             sub parse_dsn
745             {
746 6     6 0 16 my($self, $dsn) = @_;
747              
748 6         10 my($scheme, $driver, $attr_string, $attr_hash, $driver_dsn);
749              
750             # x DBI->parse_dsn('dbi:mysql:database=test;host=localhost')
751             # 0 'dbi'
752             # 1 'mysql'
753             # 2 undef
754             # 3 undef
755             # 4 'database=test;host=localhost'
756              
757 6 50       53 if(DBI->can('parse_dsn'))
758             {
759 6         24 ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) =
760             DBI->parse_dsn($dsn);
761             }
762             else
763             {
764 0         0 ($scheme, $driver, $attr_string, $driver_dsn) =
765             ($dsn =~ /^((?i)dbi) : (\w+) : (?: \( ([^)]+) \) : )? (.*)/x);
766             }
767              
768 6         156 my %init =
769             (
770             dbi_driver => $driver,
771             driver => $driver,
772             );
773              
774 6         45 while($driver_dsn =~ /\G(\w+)=([^;]+)(?:;|$)?/g)
775             {
776 16         43 my($name, $value) = ($1, $2);
777              
778 16 100       43 if(my $method = $self->dsn_attribute_to_db_method($name))
    50          
779             {
780 4         24 $init{$method} = $value;
781             }
782             elsif($self->can($name))
783             {
784 12         56 $init{$name} = $value;
785             }
786             }
787              
788 6 50       17 unless($init{'database'})
789             {
790 0         0 $init{'database'} = $driver_dsn;
791             }
792              
793 6         51 return %init;
794             }
795              
796             sub database_from_dsn
797             {
798 0     0 0 0 my($self_or_class, $dsn) = @_;
799 0         0 my %attrs = $self_or_class->parse_dsn($dsn);
800 0         0 return $attrs{'database'};
801             }
802              
803             sub dbh
804             {
805 41     41 1 77 my($self) = shift;
806              
807 41 50       116 unless(@_)
808             {
809 41 50       143 if(my $dbh = $self->{'dbh'})
810             {
811             # If this db connection wasn't created in another process or thread, return it
812 0 0 0     0 if((!$INC{'threads.pm'} || $dbh->{'private_tid'} == threads->tid) &&
      0        
813             $dbh->{'private_pid'} == $$)
814             {
815 0         0 return $dbh;
816             }
817              
818             # This $dbh wasn't created here, so disable destroy actions,
819             # undef it, and create a new one by falling through to the
820             # init_dbh() call below.
821 0         0 $dbh->{'InactiveDestroy'} = 1;
822 0         0 $self->{'dbh'} = undef;
823             }
824              
825 41         226 return $self->init_dbh;
826             }
827              
828 0 0       0 unless(defined($_[0]))
829             {
830 0         0 return $self->{'dbh'} = undef;
831             }
832              
833 0         0 $self->driver($_[0]->{'Driver'}{'Name'});
834              
835 0         0 $self->{'_dbh_refcount'}++;
836 0         0 return $self->{'dbh'} = $_[0];
837             }
838              
839             sub driver
840             {
841 76 50   76 1 277 if(@_ > 1)
842             {
843 76         160 my $driver = lc $_[1];
844              
845 76 100 66     494 if(defined $driver && defined $_[0]->{'driver'} && $_[0]->{'driver'} ne $driver)
      100        
846             {
847 2         286 Carp::croak "Attempt to change driver from '$_[0]->{'driver'}' to ",
848             "'$driver' detected. The driver cannot be changed after ",
849             "object creation.";
850             }
851              
852 74         204 return $_[0]->{'driver'} = $driver;
853             }
854              
855 0         0 return $_[0]->{'driver'};
856             }
857              
858             sub retain_dbh
859             {
860 41     41 1 221 my($self) = shift;
861 41 0       176 my $dbh = $self->dbh or return undef;
862             #$Debug && warn "$self->{'_dbh_refcount'} -> ", ($self->{'_dbh_refcount'} + 1), " $dbh\n";
863 0         0 $self->{'_dbh_refcount'}++;
864 0         0 return $dbh;
865             }
866              
867             sub release_dbh
868             {
869 68     68 1 160 my($self, %args) = @_;
870              
871 68 50       1206 my $dbh = $self->{'dbh'} or return 0;
872              
873 0 0       0 if($args{'force'})
874             {
875 0         0 $self->{'_dbh_refcount'} = 0;
876              
877             # Account for possible Apache::DBI magic
878 0 0       0 if(UNIVERSAL::isa($dbh, 'Apache::DBI::db'))
879             {
880 0         0 return $dbh->DBI::db::disconnect; # bypass Apache::DBI
881             }
882             else
883             {
884 0         0 return $dbh->disconnect;
885             }
886             }
887              
888             #$Debug && warn "$self->{'_dbh_refcount'} -> ", ($self->{'_dbh_refcount'} - 1), " $dbh\n";
889 0         0 $self->{'_dbh_refcount'}--;
890              
891 0 0 0     0 unless($self->{'_dbh_refcount'} || $self->{'_dbh_has_foreign_owner'})
892             {
893 0 0       0 if(my $sqls = $self->pre_disconnect_sql)
894             {
895 0         0 my $error;
896              
897             TRY:
898             {
899 0         0 local $@;
  0         0  
900              
901             eval
902 0         0 {
903 0         0 foreach my $sql (@$sqls)
904             {
905 0 0       0 $dbh->do($sql) or die "$sql - " . $dbh->errstr;
906 0         0 return undef;
907             }
908             };
909              
910 0         0 $error = $@;
911             }
912              
913 0 0       0 if($error)
914             {
915 0         0 $self->error("Could not do pre-disconnect SQL: $error");
916 0         0 return undef;
917             }
918             }
919              
920             #$Debug && warn "DISCONNECT $dbh ", join(':', (caller(3))[0,2]), "\n";
921 0         0 return $dbh->disconnect;
922             }
923             #else { $Debug && warn "DISCONNECT NOOP $dbh ", join(':', (caller(2))[0,2]), "\n"; }
924              
925 0         0 return 1;
926             }
927              
928             sub dbh_attribute
929             {
930 0     0 0 0 my($self, $name) = (shift, shift);
931              
932 0 0       0 if(@_)
933             {
934 0 0       0 if(my $dbh = $self->{'dbh'})
935             {
936 0         0 return $self->{'dbh'}{$name} = $self->{'__dbh_attributes'}{$name} = shift;
937             }
938             else
939             {
940 0         0 return $self->{'__dbh_attributes'}{$name} = shift;
941             }
942             }
943              
944 0 0       0 if(my $dbh = $self->{'dbh'})
945             {
946 0         0 return $self->{'dbh'}{$name};
947             }
948             else
949             {
950 0         0 return $self->{'__dbh_attributes'}{$name};
951             }
952             }
953              
954             sub dbh_attribute_boolean
955             {
956 0     0 0 0 my($self, $name) = (shift, shift);
957 0 0       0 return $self->dbh_attribute($name, (@_ ? ($_[0] ? 1 : 0) : ()));
    0          
958             }
959              
960 2     2 1 14 sub has_dbh { defined shift->{'dbh'} }
961              
962             sub dbi_connect
963             {
964 41     41 1 71 shift;
965 41 50       109 $Debug && warn "DBI->connect('$_[1]', '$_[2]', ...)\n";
966 41         318 DBI->connect(@_);
967             }
968              
969 16     16   147 use constant DID_PCSQL_KEY => 'private_rose_db_did_post_connect_sql';
  16         37  
  16         13607  
970              
971             sub init_dbh
972             {
973 41     41 0 125 my($self) = shift;
974              
975 41         152 my $options = $self->connect_options;
976              
977 41         1707 $options->{'private_pid'} = $$;
978 41 50       135 $options->{'private_tid'} = threads->tid if($INC{'threads.pm'});
979              
980 41         229 my $dsn = $self->dsn;
981              
982 41         106 $self->{'error'} = undef;
983 41         82 $self->{'database_version'} = undef;
984 41         89 $self->{'_dbh_refcount'} = 0;
985 41         128 $self->{'_dbh_has_foreign_owner'} = undef;
986              
987 41         257 my $dbh = $self->dbi_connect($dsn, $self->username, $self->password, $options);
988              
989 0 0       0 unless($dbh)
990             {
991 0         0 $self->error("Could not connect to database: $DBI::errstr");
992 0         0 return undef;
993             }
994              
995 0 0       0 if($dbh->{'private_rose_db_inited'})
996             {
997             # Someone else owns this dbh
998 0         0 $self->{'_dbh_has_foreign_owner'} = 1;
999             }
1000             else # Only initialize if this is really a new connection
1001             {
1002 0         0 $dbh->{'private_rose_db_inited'} = 1;
1003              
1004 0 0       0 if($self->{'__dbh_attributes'})
1005             {
1006 0         0 foreach my $attr (keys %{$self->{'__dbh_attributes'}})
  0         0  
1007             {
1008 0         0 my $val = $self->dbh_attribute($attr);
1009 0 0       0 next unless(defined $val);
1010 0         0 $dbh->{$attr} = $val;
1011             }
1012             }
1013              
1014 0 0 0     0 if((my $sqls = $self->post_connect_sql) && !$dbh->{DID_PCSQL_KEY()})
1015             {
1016 0         0 my $error;
1017              
1018             TRY:
1019             {
1020 0         0 local $@;
  0         0  
1021              
1022             eval
1023 0         0 {
1024 0         0 foreach my $sql (@$sqls)
1025             {
1026             #$Debug && warn "$dbh DO: $sql\n";
1027 0 0       0 $dbh->do($sql) or die "$sql - " . $dbh->errstr;
1028             }
1029             };
1030              
1031 0         0 $error = $@;
1032             }
1033              
1034 0 0       0 if($error)
1035             {
1036 0         0 $self->error("Could not do post-connect SQL: $error");
1037 0         0 $dbh->disconnect;
1038 0         0 return undef;
1039             }
1040              
1041 0         0 $dbh->{DID_PCSQL_KEY()} = 1;
1042             }
1043             }
1044              
1045 0         0 $self->{'_dbh_refcount'} = 1;
1046              
1047 0         0 return $self->{'dbh'} = $dbh;
1048             }
1049              
1050 25     25 1 282 sub print_error { shift->_dbh_and_connect_option('PrintError', @_) }
1051 0     0 1 0 sub raise_error { shift->_dbh_and_connect_option('RaiseError', @_) }
1052 0     0 1 0 sub autocommit { shift->_dbh_and_connect_option('AutoCommit', @_) }
1053 0     0 1 0 sub handle_error { shift->_dbh_and_connect_option('HandleError', @_) }
1054              
1055             sub _dbh_and_connect_option
1056             {
1057 25     25   65 my($self, $param) = (shift, shift);
1058              
1059 25 50       84 if(@_)
1060             {
1061 25 50       81 my $val = $_[0] ? 1 : 0;
1062 25         140 $self->connect_option($param => $val);
1063              
1064 25 50       82 $self->{'dbh'}{$param} = $val if($self->{'dbh'});
1065             }
1066              
1067 25 50       114 return $self->{'dbh'} ? $self->{'dbh'}{$param} :
1068             $self->connect_option($param);
1069             }
1070              
1071             sub connect
1072             {
1073 0     0 1 0 my($self) = shift;
1074              
1075 0 0       0 $self->dbh or return 0;
1076 0         0 return 1;
1077             }
1078              
1079             sub disconnect
1080             {
1081 68     68 1 155 my($self) = shift;
1082              
1083 68 50       282 $self->release_dbh(@_) or return undef;
1084              
1085 0         0 $self->{'dbh'} = undef;
1086             }
1087              
1088             sub begin_work
1089             {
1090 0     0 1 0 my($self) = shift;
1091              
1092 0 0       0 my $dbh = $self->dbh or return undef;
1093              
1094 0 0       0 if($dbh->{'AutoCommit'})
1095             {
1096 0         0 my $ret;
1097              
1098             #$Debug && warn "BEGIN TRX\n";
1099              
1100             my $error;
1101              
1102             TRY:
1103             {
1104 0         0 local $@;
  0         0  
1105              
1106             eval
1107 0         0 {
1108 0         0 local $dbh->{'RaiseError'} = 1;
1109              
1110             # XXX: Detect DBD::mysql bug (in some versions before 4.012) that
1111             # XXX: fails to set Active back to 1 when mysql_auto_reconnect
1112             # XXX: is in use.
1113 0 0       0 unless($dbh->{'Active'})
1114             {
1115 0 0 0     0 if($dbh->{'Driver'}{'Name'} eq 'mysql' && $dbh->{'Driver'}{'Version'} < 4.012)
1116             {
1117 0         0 die 'Database handle does not have Active set to a true value. DBD::mysql ',
1118             'versions before 4.012 may fail to set Active back to 1 when the ',
1119             'mysql_auto_reconnect is set. Try upgrading to DBD::mysql 4.012 or later';
1120             }
1121             else
1122             {
1123 0         0 die "Cannot start transaction on inactive database handle ($dbh)";
1124             }
1125             }
1126              
1127 0         0 $ret = $dbh->begin_work
1128             };
1129              
1130 0         0 $error = $@;
1131             }
1132              
1133 0 0       0 if($error)
1134             {
1135 16     16   155 no warnings 'uninitialized';
  16         42  
  16         4511  
1136 0         0 $self->error("begin_work() - $error " . $dbh->errstr);
1137 0         0 return undef;
1138             }
1139              
1140 0 0       0 unless($ret)
1141             {
1142 0         0 $self->error('begin_work() failed - ' . $dbh->errstr);
1143 0         0 return undef;
1144             }
1145              
1146 0         0 return 1;
1147             }
1148              
1149 0         0 return IN_TRANSACTION;
1150             }
1151              
1152             sub in_transaction
1153             {
1154 0 0   0 1 0 my $dbh = shift->{'dbh'} or return undef;
1155 0 0       0 return ($dbh->{'AutoCommit'}) ? 0 : 1;
1156             }
1157              
1158             sub commit
1159             {
1160 0     0 1 0 my($self) = shift;
1161              
1162 0 0 0     0 my $is_active = (defined $self->{'dbh'} && $self->{'dbh'}{'Active'}) ? 1 : 0;
1163              
1164 0 0       0 unless(defined $self->{'dbh'})
1165             {
1166 0         0 $self->error("Could not commit transaction: database handle is undefined");
1167 0         0 return 0;
1168             }
1169              
1170 0 0       0 my $dbh = $self->dbh or return undef;
1171              
1172 0 0       0 unless($dbh->{'AutoCommit'})
1173             {
1174 0         0 my $ret;
1175              
1176             #$Debug && warn "COMMIT TRX\n";
1177              
1178             my $error;
1179              
1180             TRY:
1181             {
1182 0         0 local $@;
  0         0  
1183              
1184             eval
1185 0         0 {
1186 0         0 local $dbh->{'RaiseError'} = 1;
1187 0         0 $ret = $dbh->commit;
1188             };
1189              
1190 0         0 $error = $@;
1191             }
1192              
1193 0 0       0 if($error)
1194             {
1195 16     16   138 no warnings 'uninitialized';
  16         44  
  16         5082  
1196 0         0 $self->error("commit() $error - " . $dbh->errstr);
1197              
1198 0 0       0 unless($is_active)
1199             {
1200 0 0 0     0 if($dbh->{'Driver'}{'Name'} eq 'mysql' && $dbh->{'Driver'}{'Version'} < 4.012)
1201             {
1202 0         0 $self->error($self->error . '; Also, the database handle did not ' .
1203             'have Active set to a true value. DBD::mysql versions before 4.012 ' .
1204             'may fail to set Active back to 1 when the mysql_auto_reconnect is ' .
1205             'set. Try upgrading to DBD::mysql 4.012 or later');
1206             }
1207              
1208 0         0 return 0;
1209             }
1210              
1211 0         0 return undef;
1212             }
1213              
1214 0 0       0 unless($ret)
1215             {
1216 0   0     0 $self->error('Could not commit transaction: ' .
1217             ($dbh->errstr || $DBI::errstr ||
1218             'Possibly a referential integrity violation. ' .
1219             'Check the database error log for more information.'));
1220 0         0 return undef;
1221             }
1222              
1223 0         0 return 1;
1224             }
1225              
1226 0         0 return -1;
1227             }
1228              
1229             sub rollback
1230             {
1231 0     0 1 0 my($self) = shift;
1232              
1233 0 0 0     0 my $is_active = (defined $self->{'dbh'} && $self->{'dbh'}{'Active'}) ? 1 : 0;
1234              
1235 0 0       0 unless(defined $self->{'dbh'})
1236             {
1237 0         0 $self->error("Could not roll back transaction: database handle is undefined");
1238 0         0 return 0;
1239             }
1240              
1241 0 0       0 my $dbh = $self->dbh or return undef;
1242              
1243 0         0 my $ac = $dbh->{'AutoCommit'};
1244              
1245 0 0       0 return 1 if($ac);
1246              
1247 0         0 my $ret;
1248              
1249             #$Debug && warn "ROLLBACK TRX\n";
1250              
1251             my $error;
1252              
1253             TRY:
1254             {
1255 0         0 local $@;
  0         0  
1256              
1257             eval
1258 0         0 {
1259 0         0 local $dbh->{'RaiseError'} = 1;
1260 0         0 $ret = $dbh->rollback;
1261             };
1262              
1263 0         0 $error = $@;
1264             }
1265              
1266 0 0       0 if($error)
1267             {
1268 16     16   467 no warnings 'uninitialized';
  16         44  
  16         9634  
1269 0         0 $self->error("rollback() - $error " . $dbh->errstr);
1270              
1271 0 0       0 unless($is_active)
1272             {
1273 0 0 0     0 if($dbh->{'Driver'}{'Name'} eq 'mysql' && $dbh->{'Driver'}{'Version'} < 4.012)
1274             {
1275 0         0 $self->error($self->error . '; Also, the database handle did not ' .
1276             'have Active set to a true value. DBD::mysql versions before 4.012 ' .
1277             'may fail to set Active back to 1 when the mysql_auto_reconnect is ' .
1278             'set. Try upgrading to DBD::mysql 4.012 or later');
1279             }
1280              
1281 0         0 return 0;
1282             }
1283              
1284 0         0 return undef;
1285             }
1286              
1287 0 0 0     0 unless($ret || $ac)
1288             {
1289 0         0 $self->error('rollback() failed - ' . $dbh->errstr);
1290 0         0 return undef;
1291             }
1292              
1293             # DBI does this for me...
1294             #$dbh->{'AutoCommit'} = 1;
1295              
1296 0         0 return 1;
1297             }
1298              
1299             sub do_transaction
1300             {
1301 0     0 1 0 my($self, $code) = (shift, shift);
1302              
1303 0 0       0 my $dbh = $self->dbh or return undef;
1304              
1305 0         0 my $error;
1306              
1307             TRY:
1308             {
1309 0         0 local $@;
  0         0  
1310              
1311             eval
1312 0         0 {
1313 0 0       0 $self->begin_work or die $self->error;
1314 0         0 $code->(@_);
1315 0 0       0 $self->commit or die $self->error;
1316             };
1317              
1318 0         0 $error = $@;
1319             }
1320              
1321 0 0       0 if($error)
1322             {
1323 0 0       0 $error = ref $error ? $error : "do_transaction() failed - $error";
1324              
1325 0 0       0 if($self->rollback)
1326             {
1327 0         0 $self->error($error);
1328             }
1329             else
1330             {
1331 0         0 $self->error("$error. rollback() also failed - " . $self->error)
1332             }
1333              
1334 0         0 return undef;
1335             }
1336              
1337 0         0 return 1;
1338             }
1339              
1340             sub auto_quote_table_name
1341             {
1342 0     0 0 0 my($self, $name) = @_;
1343              
1344 0 0 0     0 if($name =~ /\W/ || $self->is_reserved_word($name))
1345             {
1346 0         0 return $self->quote_table_name($name, @_);
1347             }
1348              
1349 0         0 return $name;
1350             }
1351              
1352             sub auto_quote_column_name
1353             {
1354 0     0 0 0 my($self, $name) = @_;
1355              
1356 0 0 0     0 if($name =~ /\W/ || $self->is_reserved_word($name))
1357             {
1358 0         0 return $self->quote_column_name($name, @_);
1359             }
1360              
1361 0         0 return $name;
1362             }
1363              
1364             sub quote_column_name
1365             {
1366 0     0 1 0 my $name = $_[1];
1367 0         0 $name =~ s/"/""/g;
1368 0         0 return qq("$name");
1369             }
1370              
1371             sub quote_table_name
1372             {
1373 0     0 0 0 my $name = $_[1];
1374 0         0 $name =~ s/"/""/g;
1375 0         0 return qq("$name");
1376             }
1377              
1378             sub unquote_column_name
1379             {
1380 0     0 0 0 my($self_or_class, $name) = @_;
1381              
1382 16     16   161 no warnings 'uninitialized';
  16         36  
  16         4665  
1383              
1384             # handle quoted strings with quotes doubled inside them
1385 0 0       0 if($name =~ /^(['"`])(.+)\1$/)
1386             {
1387 0         0 my $q = $1;
1388 0         0 $name = $2;
1389 0         0 $name =~ s/$q$q/$q/g;
1390             }
1391              
1392 0         0 return $name;
1393             }
1394              
1395             *unquote_table_name = \&unquote_column_name;
1396              
1397             #sub is_reserved_word { 0 }
1398              
1399             *is_reserved_word = \&SQL::ReservedWords::is_reserved;
1400              
1401             BEGIN
1402             {
1403             sub quote_identifier_dbi
1404             {
1405 0     0 0 0 my($self) = shift;
1406 0 0       0 my $dbh = $self->dbh or die $self->error;
1407 0         0 return $dbh->quote_identifier(@_);
1408             }
1409              
1410             sub quote_identifier_fallback
1411             {
1412 0     0 0 0 my($self, $catalog, $schema, $table) = @_;
1413 0         0 return join('.', map { qq("$_") } grep { defined } ($schema, $table));
  0         0  
  0         0  
1414             }
1415              
1416 16 50   16   129 if($DBI::VERSION >= 1.21)
1417             {
1418 16         6166 *quote_identifier = \&quote_identifier_dbi;
1419             }
1420             else
1421             {
1422 0         0 *quote_identifier = \&quote_identifier_fallback;
1423             }
1424             }
1425              
1426             *quote_identifier_for_sequence = \&quote_identifier;
1427              
1428             sub quote_column_with_table
1429             {
1430 0     0 0 0 my($self, $column, $table) = @_;
1431              
1432 0 0       0 return $table ?
1433             $self->quote_table_name($table) . '.' .
1434             $self->quote_column_name($column) :
1435             $self->quote_column_name($column);
1436             }
1437              
1438             sub auto_quote_column_with_table
1439             {
1440 0     0 0 0 my($self, $column, $table) = @_;
1441              
1442 0 0       0 return $table ?
1443             $self->auto_quote_table_name($table) . '.' .
1444             $self->auto_quote_column_name($column) :
1445             $self->auto_quote_column_name($column);
1446             }
1447              
1448             sub has_primary_key
1449             {
1450 0     0 1 0 my($self) = shift;
1451 0         0 my $columns = $self->primary_key_column_names(@_);
1452 0 0 0     0 return (ref $columns && @$columns) ? 1 : 0;
1453             }
1454              
1455             sub primary_key_column_names
1456             {
1457 0     0 1 0 my($self) = shift;
1458              
1459 0 0       0 my %args = @_ == 1 ? (table => @_) : @_;
1460              
1461 0 0       0 my $table = $args{'table'} or Carp::croak "Missing table name parameter";
1462 0   0     0 my $catalog = $args{'catalog'} || $self->catalog;
1463 0   0     0 my $schema = $args{'schema'} || $self->schema;
1464              
1465 0 0       0 $schema = $self->default_implicit_schema unless(defined $schema);
1466              
1467 0 0       0 $table = lc $table if($self->likes_lowercase_table_names);
1468              
1469 0 0 0     0 $schema = lc $schema
1470             if(defined $schema && $self->likes_lowercase_schema_names);
1471              
1472 0 0 0     0 $catalog = lc $catalog
1473             if(defined $catalog && $self->likes_lowercase_catalog_names);
1474              
1475 0         0 my $table_unquoted = $self->unquote_table_name($table);
1476              
1477 0         0 my $columns;
1478              
1479             my $error;
1480              
1481             TRY:
1482             {
1483 0         0 local $@;
  0         0  
1484              
1485             eval
1486 0         0 {
1487 0         0 $columns =
1488             $self->_get_primary_key_column_names($catalog, $schema, $table_unquoted);
1489             };
1490              
1491 0         0 $error = $@;
1492             }
1493              
1494 0 0 0     0 if($error || !$columns)
1495             {
1496 16     16   157 no warnings 'uninitialized'; # undef strings okay
  16         43  
  16         2719  
1497 0 0       0 $error = 'no primary key columns found' unless(defined $error);
1498 0         0 Carp::croak "Could not get primary key columns for catalog '" .
1499             $catalog . "' schema '" . $schema . "' table '" .
1500             $table_unquoted . "' - " . $error;
1501             }
1502              
1503 0 0       0 return wantarray ? @$columns : $columns;
1504             }
1505              
1506             sub _get_primary_key_column_names
1507             {
1508 0     0   0 my($self, $catalog, $schema, $table) = @_;
1509              
1510 0 0       0 my $dbh = $self->dbh or die $self->error;
1511              
1512 0         0 local $dbh->{'FetchHashKeyName'} = 'NAME';
1513              
1514 0         0 my $sth = $dbh->primary_key_info($catalog, $schema, $table);
1515              
1516 0 0       0 unless(defined $sth)
1517             {
1518 16     16   141 no warnings 'uninitialized'; # undef strings okay
  16         45  
  16         1395  
1519 0         0 $self->error("No primary key information found for catalog '", $catalog,
1520             "' schema '", $schema, "' table '", $table, "'");
1521 0         0 return [];
1522             }
1523              
1524 0         0 my @columns;
1525              
1526 0         0 my $supports_catalog = $self->supports_catalog;
1527              
1528 0         0 PK: while(my $pk_info = $sth->fetchrow_hashref)
1529             {
1530             CHECK_TABLE: # Make sure this column is from the right table
1531             {
1532 16     16   112 no warnings; # Allow undef coercion to empty string
  16         50  
  16         13486  
  0         0  
1533              
1534             $pk_info->{'TABLE_NAME'} =
1535 0         0 $self->unquote_table_name($pk_info->{'TABLE_NAME'});
1536              
1537             next PK unless((!$supports_catalog || $pk_info->{'TABLE_CAT'} eq $catalog) &&
1538             $pk_info->{'TABLE_SCHEM'} eq $schema &&
1539 0 0 0     0 $pk_info->{'TABLE_NAME'} eq $table);
      0        
      0        
1540             }
1541              
1542 0 0       0 unless(defined $pk_info->{'COLUMN_NAME'})
1543             {
1544 0         0 Carp::croak "Could not extract column name from DBI primary_key_info()";
1545             }
1546              
1547 0         0 push(@columns, $self->unquote_column_name($pk_info->{'COLUMN_NAME'}));
1548             }
1549              
1550 0         0 return \@columns;
1551             }
1552              
1553             #
1554             # These methods could/should be overridden in driver-specific subclasses
1555             #
1556              
1557 0     0 1 0 sub insertid_param { undef }
1558 0     0 0 0 sub null_date { '0000-00-00' }
1559 0     0 0 0 sub null_datetime { '0000-00-00 00:00:00' }
1560 0     0 0 0 sub null_timestamp { '00000000000000' }
1561 0     0 0 0 sub min_timestamp { '00000000000000' }
1562 0     0 0 0 sub max_timestamp { '00000000000000' }
1563              
1564 0     0 1 0 sub last_insertid_from_sth { $_[1]->{$_[0]->insertid_param} }
1565 0   0 0 0 0 sub generate_primary_key_values { (undef) x ($_[1] || 1) }
1566 0   0 0 0 0 sub generate_primary_key_placeholders { (undef) x ($_[1] || 1) }
1567              
1568 0     0 0 0 sub max_column_name_length { 255 }
1569 0     0 0 0 sub max_column_alias_length { 255 }
1570              
1571             # Boolean formatting and parsing
1572              
1573 0 0   0 1 0 sub format_boolean { $_[1] ? 1 : 0 }
1574              
1575             sub parse_boolean
1576             {
1577 0     0 1 0 my($self, $value) = @_;
1578              
1579 0 0 0     0 return $value if($self->validate_boolean_keyword($_[1]) ||
      0        
1580             ($self->keyword_function_calls && $_[1] =~ /^\w+\(.*\)$/));
1581 0 0       0 return 1 if($value =~ /^(?:t(?:rue)?|y(?:es)?|1)$/i);
1582 0 0       0 return 0 if($value =~ /^(?:f(?:alse)?|no?|0)$/i);
1583              
1584 0         0 $self->error("Invalid boolean value: '$value'");
1585 0         0 return undef;
1586             }
1587              
1588             # Date formatting
1589              
1590             sub format_date
1591             {
1592 0     0 1 0 my($self, $date) = @_;
1593 0 0 0     0 return $date
      0        
1594             if($self->validate_date_keyword($date) ||
1595             ($self->keyword_function_calls && $date =~ /^\w+\(.*\)$/));
1596 0         0 return $self->date_handler->format_date($date);
1597             }
1598              
1599             sub format_datetime
1600             {
1601 0     0 1 0 my($self, $date) = @_;
1602 0 0 0     0 return $date if($self->validate_datetime_keyword($date) ||
      0        
1603             ($self->keyword_function_calls && $date =~ /^\w+\(.*\)$/));
1604 0         0 return $self->date_handler->format_datetime($date);
1605             }
1606              
1607 16     16   124 use constant HHMMSS_PRECISION => 6;
  16         1964  
  16         915  
1608 16     16   98 use constant HHMM_PRECISION => 4;
  16         29  
  16         65864  
1609              
1610             sub format_time
1611             {
1612 24     24 1 16032 my($self, $time, $precision) = @_;
1613 24 50 33     66 return $time if($self->validate_time_keyword($time) ||
      33        
1614             ($self->keyword_function_calls && $time =~ /^\w+\(.*\)$/));
1615              
1616 24 50       218 if(defined $precision)
1617             {
1618 0 0       0 if($precision > HHMMSS_PRECISION)
    0          
    0          
1619             {
1620 0         0 my $scale = $precision - HHMMSS_PRECISION;
1621 0         0 return $time->format("%H:%M:%S%${scale}n");
1622             }
1623             elsif($precision == HHMMSS_PRECISION)
1624             {
1625 0         0 return $time->format("%H:%M:%S");
1626             }
1627             elsif($precision == HHMM_PRECISION)
1628             {
1629 0         0 return $time->format("%H:%M");
1630             }
1631             }
1632              
1633             # Punt
1634 24         76 return $time->as_string;
1635             }
1636              
1637             sub format_timestamp
1638             {
1639 0     0 1 0 my($self, $date) = @_;
1640 0 0 0     0 return $date if($self->validate_timestamp_keyword($date) ||
      0        
1641             ($self->keyword_function_calls && $date =~ /^\w+\(.*\)$/));
1642 0         0 return $self->date_handler->format_timestamp($date);
1643             }
1644              
1645             sub format_timestamp_with_time_zone
1646             {
1647 0     0 1 0 my($self, $date) = @_;
1648 0 0 0     0 return $date if($self->validate_timestamp_keyword($date) ||
      0        
1649             ($self->keyword_function_calls && $date =~ /^\w+\(.*\)$/));
1650 0         0 return $self->date_handler->format_timestamp_with_time_zone($date);
1651             }
1652              
1653             # Date parsing
1654              
1655             sub parse_date
1656             {
1657 0     0 1 0 my($self, $value) = @_;
1658              
1659 0 0 0     0 if(UNIVERSAL::isa($value, 'DateTime') || $self->validate_date_keyword($value))
1660             {
1661 0         0 return $value;
1662             }
1663              
1664 0         0 my($dt, $error);
1665              
1666             TRY:
1667             {
1668 0         0 local $@;
  0         0  
1669 0         0 eval { $dt = $self->date_handler->parse_date($value) };
  0         0  
1670 0         0 $error = $@;
1671             }
1672              
1673 0 0       0 if($error)
1674             {
1675 0         0 $self->error("Could not parse date '$value' - $error");
1676 0         0 return undef;
1677             }
1678              
1679 0         0 return $dt;
1680             }
1681              
1682             sub parse_datetime
1683             {
1684 0     0 1 0 my($self, $value) = @_;
1685              
1686 0 0 0     0 if(UNIVERSAL::isa($value, 'DateTime') ||
1687             $self->validate_datetime_keyword($value))
1688             {
1689 0         0 return $value;
1690             }
1691              
1692 0         0 my($dt, $error);
1693              
1694             TRY:
1695             {
1696 0         0 local $@;
  0         0  
1697 0         0 eval { $dt = $self->date_handler->parse_datetime($value) };
  0         0  
1698 0         0 $error = $@;
1699             }
1700              
1701 0 0       0 if($error)
1702             {
1703 0         0 $self->error("Could not parse datetime '$value' - $error");
1704 0         0 return undef;
1705             }
1706              
1707 0         0 return $dt;
1708             }
1709              
1710             sub parse_timestamp
1711             {
1712 0     0 1 0 my($self, $value) = @_;
1713              
1714 0 0 0     0 if(UNIVERSAL::isa($value, 'DateTime') ||
1715             $self->validate_timestamp_keyword($value))
1716             {
1717 0         0 return $value;
1718             }
1719              
1720 0         0 my($dt, $error);
1721              
1722             TRY:
1723             {
1724 0         0 local $@;
  0         0  
1725 0         0 eval { $dt = $self->date_handler->parse_timestamp($value) };
  0         0  
1726 0         0 $error = $@;
1727             }
1728              
1729 0 0       0 if($error)
1730             {
1731 0         0 $self->error("Could not parse timestamp '$value' - $error");
1732 0         0 return undef;
1733             }
1734              
1735 0         0 return $dt;
1736             }
1737              
1738             sub parse_timestamp_with_time_zone
1739             {
1740 0     0 1 0 my($self, $value) = @_;
1741              
1742 0 0 0     0 if(UNIVERSAL::isa($value, 'DateTime') ||
1743             $self->validate_timestamp_keyword($value))
1744             {
1745 0         0 return $value;
1746             }
1747              
1748 0         0 my($dt, $error);
1749              
1750             TRY:
1751             {
1752 0         0 local $@;
  0         0  
1753 0         0 eval { $dt = $self->date_handler->parse_timestamp_with_time_zone($value) };
  0         0  
1754 0         0 $error = $@;
1755             }
1756              
1757 0 0       0 if($error)
1758             {
1759 0         0 $self->error("Could not parse timestamp with time zone '$value' - $error");
1760 0         0 return undef;
1761             }
1762              
1763 0         0 return $dt;
1764             }
1765              
1766             sub parse_time
1767             {
1768 30     30 1 16256 my($self, $value) = @_;
1769              
1770 30 50 33     298 if(!defined $value || UNIVERSAL::isa($value, 'Time::Clock') ||
      33        
      33        
      33        
1771             $self->validate_time_keyword($value) ||
1772             ($self->keyword_function_calls && $value =~ /^\w+\(.*\)$/))
1773             {
1774 0         0 return $value;
1775             }
1776              
1777 30         213 my($time, $error);
1778              
1779             TRY:
1780             {
1781 30         43 local $@;
  30         38  
1782 30         56 eval { $time = Time::Clock->new->parse($value) };
  30         98  
1783 30         3258 $error = $@;
1784             }
1785              
1786 30 100       74 if($error)
1787             {
1788 6         13 my $second_error;
1789              
1790             TRY:
1791             {
1792 6         9 local $@;
  6         11  
1793              
1794             eval
1795 6         11 {
1796 6         32 my $dt = $self->date_handler->parse_time($value);
1797             # Using parse()/strftime() is faster than using the
1798             # Time::Clock constructor and the DateTime accessors.
1799 0         0 $time = Time::Clock->new->parse($dt->strftime('%H:%M:%S.%N'));
1800             };
1801              
1802 6         119 $second_error = $@;
1803             }
1804              
1805 6 50       18 if($second_error)
1806             {
1807 6         39 $self->error("Could not parse time '$value' - Time::Clock::parse() failed " .
1808             "($error) and $second_error");
1809 6         32 return undef;
1810             }
1811             }
1812              
1813 24         144 return $time;
1814             }
1815              
1816             sub parse_bitfield
1817             {
1818 0     0 1 0 my($self, $val, $size) = @_;
1819              
1820 0 0       0 return undef unless(defined $val);
1821              
1822 0 0       0 if(ref $val)
1823             {
1824 0 0 0     0 if($size && $val->Size != $size)
1825             {
1826 0         0 return Bit::Vector->new_Bin($size, $val->to_Bin);
1827             }
1828              
1829 0         0 return $val;
1830             }
1831              
1832 0 0 0     0 if($val =~ /^[10]+$/)
    0 0        
    0          
    0          
1833             {
1834 0   0     0 return Bit::Vector->new_Bin($size || length $val, $val);
1835             }
1836             elsif($val =~ /^\d*[2-9]\d*$/)
1837             {
1838 0   0     0 return Bit::Vector->new_Dec($size || (length($val) * 4), $val);
1839             }
1840             elsif($val =~ s/^0x// || $val =~ s/^X'(.*)'$/$1/ || $val =~ /^[0-9a-f]+$/i)
1841             {
1842 0   0     0 return Bit::Vector->new_Hex($size || (length($val) * 4), $val);
1843             }
1844             elsif($val =~ s/^B'([10]+)'$/$1/i)
1845             {
1846 0   0     0 return Bit::Vector->new_Bin($size || length $val, $val);
1847             }
1848             else
1849             {
1850 0         0 $self->error("Could not parse bitfield value '$val'");
1851 0         0 return undef;
1852             #return Bit::Vector->new_Bin($size || length($val), $val);
1853             }
1854             }
1855              
1856             sub format_bitfield
1857             {
1858 0     0 1 0 my($self, $vec, $size) = @_;
1859              
1860 0 0       0 if($size)
1861             {
1862 0         0 $vec = Bit::Vector->new_Bin($size, $vec->to_Bin);
1863 0         0 return sprintf('%0*b', $size, hex($vec->to_Hex));
1864             }
1865              
1866 0         0 return sprintf('%b', hex($vec->to_Hex));
1867             }
1868              
1869 0     0 0 0 sub select_bitfield_column_sql { shift->auto_quote_column_with_table(@_) }
1870              
1871             sub parse_array
1872             {
1873 0     0 0 0 my($self) = shift;
1874              
1875 0 0       0 return $_[0] if(ref $_[0]);
1876 0 0       0 return [ @_ ] if(@_ > 1);
1877              
1878 0         0 my $val = $_[0];
1879              
1880 0 0       0 return undef unless(defined $val);
1881              
1882 0         0 $val =~ s/^ (?:\[.+\]=)? \{ (.*) \} $/$1/sx;
1883              
1884 0         0 my @array;
1885              
1886 0         0 while($val =~ s/(?:"((?:[^"\\]+|\\.)*)"|([^",]+))(?:,|$)//)
1887             {
1888 0 0       0 my($item) = map { $_ eq 'NULL' ? undef : $_ } (defined $1 ? $1 : $2);
  0 0       0  
1889 0 0       0 $item =~ s{\\(.)}{$1}g if(defined $item);
1890 0         0 push(@array, $item);
1891             }
1892              
1893 0         0 return \@array;
1894             }
1895              
1896             sub format_array
1897             {
1898 0     0 0 0 my($self) = shift;
1899              
1900 0 0 0     0 return undef unless(ref $_[0] || defined $_[0]);
1901              
1902 0 0       0 my @array = (ref $_[0]) ? @{$_[0]} : @_;
  0         0  
1903              
1904             my $str = '{' . join(',', map
1905             {
1906 0 0       0 if(!defined $_)
  0 0       0  
1907             {
1908 0         0 'NULL'
1909             }
1910             elsif(/^[-+]?\d+(?:\.\d*)?$/)
1911             {
1912 0         0 $_
1913             }
1914             else
1915             {
1916 0         0 s/\\/\\\\/g;
1917 0         0 s/"/\\"/g;
1918 0         0 qq("$_")
1919             }
1920             } @array) . '}';
1921              
1922 0 0       0 if(length($str) > $self->max_array_characters)
1923             {
1924 0         0 Carp::croak "Array string is longer than ", ref($self),
1925             "->max_array_characters (", $self->max_array_characters,
1926             ") characters long: $str";
1927             }
1928              
1929 0         0 return $str;
1930             }
1931              
1932             my $Interval_Regex = qr{
1933             (?:\@\s*)?
1934             (?:
1935             (?: (?: \s* ([+-]?) (\d+) : ([0-5]?\d)? (?:: ([0-5]?\d (?:\.\d+)? )? )?)) # (sign)hhh:mm:ss
1936             |
1937             (?: \s* ( [+-]? \d+ (?:\.\d+(?=\s+s))? ) \s+ # quantity
1938             (?: # unit
1939             (?:\b(dec) (?:ades?\b | s?\b)?\b) # decades
1940             | (?:\b(d) (?:ays?\b)?\b) # days
1941             | (?:\b(y) (?:ears?\b)?\b) # years
1942             | (?:\b(h) (?:ours?\b)?\b) # hours
1943             | (?:\b(mon) (?:s\b | ths?\b)?\b) # months
1944             | (?:\b(mil) (?:s\b | lenniums?\b)?\b) # millenniums
1945             | (?:\b(m) (?:inutes?\b | ins?\b)?\b) # minutes
1946             | (?:\b(s) (?:ec(?:s | onds?)?)?\b) # seconds
1947             | (?:\b(w) (?:eeks?\b)?\b) # weeks
1948             | (?:\b(c) (?:ent(?:s | ury | uries)?\b)?\b) # centuries
1949             )
1950             )
1951             )
1952             (?: \s+ (ago) \b)? # direction
1953             | (.+)
1954             }ix;
1955              
1956             sub parse_interval
1957             {
1958 76     76 1 39001 my($self, $value, $end_of_month_mode) = @_;
1959              
1960 76 100 33     680 if(!defined $value || UNIVERSAL::isa($value, 'DateTime::Duration') ||
      33        
      100        
      66        
1961             $self->validate_interval_keyword($value) ||
1962             ($self->keyword_function_calls && $value =~ /^\w+\(.*\)$/))
1963             {
1964 2         35 return $value;
1965             }
1966              
1967 74         794 for($value)
1968             {
1969 74         124 s/\A //;
1970 74         111 s/ \z//;
1971 74         549 s/\s+/ /g;
1972             }
1973              
1974 74         180 my(%units, $is_ago, $sign, $error, $dt_duration);
1975              
1976 74         0 my $value_pos;
1977              
1978 74   66     675 while(!$error && $value =~ /$Interval_Regex/go)
1979             {
1980 218         361 $value_pos = pos($value);
1981              
1982 218 100       439 $is_ago = 1 if($16);
1983              
1984 218 100 100     1509 if($2 || $3 || $4)
    100 66        
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
1985             {
1986 22 100 100     121 if($sign || defined $units{'hours'} || defined $units{'minutes'} ||
      66        
      100        
1987             defined $units{'seconds'})
1988             {
1989 10         15 $error = 1;
1990 10         16 last;
1991             }
1992              
1993 12 100 66     43 $sign = ($1 && $1 eq '-') ? -1 : 1;
1994              
1995 12         25 my $secs = $4;
1996              
1997 12 50 33     29 if(defined $secs && $secs != int($secs))
1998             {
1999 0         0 my $fsecs = substr($secs, index($secs, '.') + 1);
2000 0         0 $secs = int($secs);
2001              
2002 0         0 my $len = length $fsecs;
2003              
2004 0 0       0 if($len < 9)
    0          
2005             {
2006 0         0 $fsecs .= ('0' x (9 - length $fsecs));
2007             }
2008             elsif($len > 9)
2009             {
2010 0         0 $fsecs = substr($fsecs, 0, 9);
2011             }
2012              
2013 0         0 $units{'nanoseconds'} = $sign * $fsecs;
2014             }
2015              
2016 12   100     45 $units{'hours'} = $sign * ($2 || 0);
2017 12   100     44 $units{'minutes'} = $sign * ($3 || 0);
2018 12   50     107 $units{'seconds'} = $sign * ($secs || 0);
2019             }
2020             elsif($6)
2021             {
2022 10 50       23 if($units{'decades'}) { $error = 1; last }
  0         0  
  0         0  
2023 10         71 $units{'decades'} = $5;
2024             }
2025             elsif(defined $7)
2026             {
2027 28 100       63 if($units{'days'}) { $error = 1; last }
  2         5  
  2         5  
2028 26         156 $units{'days'} = $5;
2029             }
2030             elsif(defined $8)
2031             {
2032 20 50       47 if($units{'years'}) { $error = 1; last }
  0         0  
  0         0  
2033 20         164 $units{'years'} = $5;
2034             }
2035             elsif(defined $9)
2036             {
2037 18 50       39 if($units{'hours'}) { $error = 1; last }
  0         0  
  0         0  
2038 18         146 $units{'hours'} = $5;
2039             }
2040             elsif(defined $10)
2041             {
2042 14 50       34 if($units{'months'}) { $error = 1; last }
  0         0  
  0         0  
2043 14         100 $units{'months'} = $5;
2044             }
2045             elsif(defined $11)
2046             {
2047 14 50       37 if($units{'millenniums'}) { $error = 1; last }
  0         0  
  0         0  
2048 14         123 $units{'millenniums'} = $5;
2049             }
2050             elsif(defined $12)
2051             {
2052 22 50       47 if($units{'minutes'}) { $error = 1; last }
  0         0  
  0         0  
2053 22         171 $units{'minutes'} = $5;
2054             }
2055             elsif(defined $13)
2056             {
2057 26 50       58 if($units{'seconds'}) { $error = 1; last }
  0         0  
  0         0  
2058              
2059 26         50 my $secs = $5;
2060              
2061 26         63 $units{'seconds'} = int($secs);
2062              
2063 26 100       127 if($units{'seconds'} != $secs)
2064             {
2065 2         11 my $fsecs = substr($secs, index($secs, '.') + 1);
2066              
2067 2         6 my $len = length $fsecs;
2068              
2069 2 50       8 if($len < 9)
    0          
2070             {
2071 2         10 $fsecs .= ('0' x (9 - length $fsecs));
2072             }
2073             elsif($len > 9)
2074             {
2075 0         0 $fsecs = substr($fsecs, 0, 9);
2076             }
2077              
2078 2         10 $units{'nanoseconds'} = $fsecs;
2079             }
2080             }
2081             elsif(defined $14)
2082             {
2083 10 50       23 if($units{'weeks'}) { $error = 1; last }
  0         0  
  0         0  
2084 10         69 $units{'weeks'} = $5;
2085             }
2086             elsif(defined $15)
2087             {
2088 10 50       23 if($units{'centuries'}) { $error = 1; last }
  0         0  
  0         0  
2089 10         77 $units{'centuries'} = $5;
2090             }
2091             elsif(defined $17)
2092             {
2093 22         37 $error = 1;
2094 22         33 last;
2095             }
2096             }
2097              
2098 74 100       149 if($error)
2099             {
2100 34         157 $self->error("Could not parse interval '$value' - found overlaping time units");
2101 34         123 return undef;
2102             }
2103              
2104 40 50       84 if($value_pos != length($value))
2105             {
2106 0         0 $self->error("Could not parse interval '$value' - could not interpret all tokens");
2107 0         0 return undef;
2108             }
2109              
2110 40 100       75 if(defined $units{'millenniums'})
2111             {
2112 14         34 $units{'years'} += 1000 * $units{'millenniums'};
2113 14         28 delete $units{'millenniums'};
2114             }
2115              
2116 40 100       87 if(defined $units{'centuries'})
2117             {
2118 10         22 $units{'years'} += 100 * $units{'centuries'};
2119 10         16 delete $units{'centuries'};
2120             }
2121              
2122 40 100       77 if(defined $units{'decades'})
2123             {
2124 10         19 $units{'years'} += 10 * $units{'decades'};
2125 10         13 delete $units{'decades'};
2126             }
2127              
2128 40 100 100     164 if($units{'hours'} || $units{'minutes'} || $units{'seconds'})
      100        
2129             {
2130             my $seconds = ($units{'hours'} || 0) * 60 * 60 +
2131             ($units{'minutes'} || 0) * 60 +
2132 24   100     113 ($units{'seconds'} || 0);
      100        
      100        
2133 24         57 $units{'hours'} = int($seconds / 3600);
2134 24         37 $seconds -= $units{'hours'} * 3600;
2135 24         39 $units{'minutes'} = int($seconds / 60);
2136 24         41 $units{'seconds'} = $seconds - $units{'minutes'} * 60;
2137             }
2138              
2139 40 50       76 $units{'end_of_month'} = $end_of_month_mode if(defined $end_of_month_mode);
2140              
2141 40 100       225 $dt_duration = $is_ago ?
2142             DateTime::Duration->new(%units)->inverse :
2143             DateTime::Duration->new(%units);
2144              
2145             # XXX: Ugly hack workaround for DateTime::Duration bug (RT 53985)
2146 40 50 66     5969 if($is_ago && defined $end_of_month_mode &&
      33        
2147             $dt_duration->end_of_month_mode ne $end_of_month_mode)
2148             {
2149 0         0 $dt_duration->{'end_of_month'} = $end_of_month_mode;
2150             }
2151              
2152 40         176 return $dt_duration;
2153             }
2154              
2155             sub format_interval
2156             {
2157 74     74 1 1365 my($self, $dur) = @_;
2158              
2159 74 50 66     207 if(!defined $dur || $self->validate_interval_keyword($dur) ||
      66        
      66        
2160             ($self->keyword_function_calls && $dur =~ /^\w+\(.*\)$/))
2161             {
2162 34         115 return $dur;
2163             }
2164              
2165 40         487 my $output = '';
2166              
2167 40         56 my(%deltas, %unit, $neg);
2168              
2169 40         122 @deltas{qw/years mons days h m s/} =
2170             $dur->in_units(qw/years months days hours minutes seconds/);
2171              
2172 40         2178 foreach (qw/years mons days/)
2173             {
2174 120         191 $unit{$_} = $_;
2175 120 100       422 $unit{$_} =~ s/s\z// if $deltas{$_} == 1;
2176             }
2177              
2178 40 100       120 $output .= "$deltas{'years'} $unit{'years'} " if($deltas{'years'});
2179 40 100       80 $neg = 1 if($deltas{'years'} < 0);
2180              
2181 40 50 66     92 $output .= '+' if ($neg && $deltas{'mons'} > 0);
2182 40 100       89 $output .= "$deltas{'mons'} $unit{'mons'} " if($deltas{'mons'});
2183             $neg = $deltas{'mons'} < 0 ? 1 :
2184 40 100       101 $deltas{'mons'} ? 0 :
    100          
2185             $neg;
2186              
2187 40 100 100     100 $output .= '+' if($neg && $deltas{'days'} > 0);
2188 40 100       99 $output .= "$deltas{'days'} $unit{'days'} " if($deltas{'days'});
2189              
2190 40 100 100     168 if($deltas{'h'} || $deltas{'m'} || $deltas{'s'} || $dur->nanoseconds)
      100        
      100        
2191             {
2192             $neg = $deltas{'days'} < 0 ? 1 :
2193 26 100       164 $deltas{'days'} ? 0 :
    100          
2194             $neg;
2195              
2196 26 100 66     97 if($neg && (($deltas{'h'} > 0) || (!$deltas{'h'} && $deltas{'m'} > 0) ||
      100        
2197             (!$deltas{'h'} && !$deltas{'m'} && $deltas{'s'} > 0)))
2198             {
2199 4         7 $output .= '+';
2200             }
2201              
2202 26         71 my $nsec = $dur->nanoseconds;
2203              
2204 26 100 66     947 $output .= '-' if(!$deltas{'h'} && ($deltas{'m'} < 0 || $deltas{'s'} < 0));
      66        
2205 26         61 @deltas{qw/m s/} = (abs($deltas{'m'}), abs($deltas{'s'}));
2206 52         261 $deltas{'hms'} = join(':', map { sprintf('%.2d', $deltas{$_}) } (qw/h m/)) .
2207             ($nsec ? sprintf(':%02d.%09d', $deltas{'s'}, $nsec) :
2208 26 100       40 sprintf(':%02d', $deltas{'s'}));
2209              
2210 26 50       95 $output .= "$deltas{'hms'}" if($deltas{'hms'});
2211             }
2212              
2213 40         583 $output =~ s/ \z//;
2214              
2215 40 100       134 if(length($output) > $self->max_interval_characters)
2216             {
2217 2         61 Carp::croak "Interval string is longer than ", ref($self),
2218             "->max_interval_characters (", $self->max_interval_characters,
2219             ") characters long: $output";
2220             }
2221              
2222 38         1866 return $output;
2223             }
2224              
2225 0     0 0 0 sub build_dsn { 'override in subclass' }
2226              
2227 0     0 0 0 sub validate_integer_keyword { 0 }
2228 0     0 0 0 sub validate_float_keyword { 0 }
2229 0     0 0 0 sub validate_numeric_keyword { 0 }
2230 0     0 0 0 sub validate_decimal_keyword { 0 }
2231 0     0 0 0 sub validate_double_precision_keyword { 0 }
2232 0     0 0 0 sub validate_bigint_keyword { 0 }
2233 0     0 1 0 sub validate_date_keyword { 0 }
2234 0     0 1 0 sub validate_datetime_keyword { 0 }
2235 54     54 1 272 sub validate_time_keyword { 0 }
2236 0     0 1 0 sub validate_timestamp_keyword { 0 }
2237 116     116 1 520 sub validate_interval_keyword { 0 }
2238 0     0 0 0 sub validate_set_keyword { 0 }
2239 0     0 0 0 sub validate_array_keyword { 0 }
2240 0     0 0 0 sub validate_bitfield_keyword { 0 }
2241              
2242             sub validate_boolean_keyword
2243             {
2244 16     16   156 no warnings 'uninitialized';
  16         56  
  16         1729  
2245 0     0 1 0 $_[1] =~ /^(?:TRUE|FALSE)$/;
2246             }
2247              
2248             sub should_inline_keyword
2249             {
2250 16     16   122 no warnings 'uninitialized';
  16         38  
  16         4438  
2251 0 0   0 0 0 ($_[1] =~ /^\w+\(.*\)$/) ? 1 : 0;
2252             }
2253              
2254             BEGIN
2255             {
2256 16     16   91 *should_inline_integer_keyword = \&should_inline_keyword;
2257 16         43 *should_inline_float_keyword = \&should_inline_keyword;
2258 16         30 *should_inline_decimal_keyword = \&should_inline_keyword;
2259 16         37 *should_inline_numeric_keyword = \&should_inline_keyword;
2260 16         26 *should_inline_double_precision_keyword = \&should_inline_keyword;
2261 16         30 *should_inline_bigint_keyword = \&should_inline_keyword;
2262 16         36 *should_inline_date_keyword = \&should_inline_keyword;
2263 16         48 *should_inline_datetime_keyword = \&should_inline_keyword;
2264 16         42 *should_inline_time_keyword = \&should_inline_keyword;
2265 16         51 *should_inline_timestamp_keyword = \&should_inline_keyword;
2266 16         41 *should_inline_interval_keyword = \&should_inline_keyword;
2267 16         32 *should_inline_set_keyword = \&should_inline_keyword;
2268 16         53 *should_inline_array_keyword = \&should_inline_keyword;
2269 16         28 *should_inline_boolean_keyword = \&should_inline_keyword;
2270 16         34930 *should_inline_bitfield_value = \&should_inline_keyword;
2271             }
2272              
2273             sub next_value_in_sequence
2274             {
2275 0     0 0 0 my($self, $seq) = @_;
2276 0         0 $self->error("Don't know how to select next value in sequence '$seq' " .
2277             "for database driver " . $self->driver);
2278 0         0 return undef;
2279             }
2280              
2281             sub current_value_in_sequence
2282             {
2283 0     0 0 0 my($self, $seq) = @_;
2284 0         0 $self->error("Don't know how to select current value in sequence '$seq' " .
2285             "for database driver " . $self->driver);
2286 0         0 return undef;
2287             }
2288              
2289             sub sequence_exists
2290             {
2291 0     0 0 0 my($self, $seq) = @_;
2292 0         0 $self->error("Don't know how to tell if sequence '$seq' exists " .
2293             "for database driver " . $self->driver);
2294 0         0 return undef;
2295             }
2296              
2297 0     0 0 0 sub auto_sequence_name { undef }
2298              
2299 0     0 0 0 sub supports_multi_column_count_distinct { 1 }
2300 0     0 0 0 sub supports_nested_joins { 1 }
2301 0     0 0 0 sub supports_limit_with_offset { 1 }
2302 0     0 0 0 sub supports_arbitrary_defaults_on_insert { 0 }
2303 0     0 0 0 sub supports_select_from_subselect { 0 }
2304 0     0 0 0 sub format_select_from_subselect { "(\n$_[1]\n )" }
2305              
2306 0     0 0 0 sub likes_redundant_join_conditions { 0 }
2307 0     0 0 0 sub likes_lowercase_table_names { 0 }
2308 0     0 0 0 sub likes_uppercase_table_names { 0 }
2309 0     0 0 0 sub likes_lowercase_schema_names { 0 }
2310 0     0 0 0 sub likes_uppercase_schema_names { 0 }
2311 0     0 0 0 sub likes_lowercase_catalog_names { 0 }
2312 0     0 0 0 sub likes_uppercase_catalog_names { 0 }
2313 0     0 0 0 sub likes_lowercase_sequence_names { 0 }
2314 0     0 0 0 sub likes_uppercase_sequence_names { 0 }
2315 0     0 0 0 sub likes_implicit_joins { 0 }
2316              
2317 0     0 0 0 sub supports_schema { 0 }
2318 0     0 0 0 sub supports_catalog { 0 }
2319              
2320 0     0 0 0 sub use_auto_sequence_name { 0 }
2321              
2322             sub format_limit_with_offset
2323             {
2324 0     0 0 0 my($self, $limit, $offset, $args) = @_;
2325              
2326 0         0 delete $args->{'limit'};
2327 0         0 delete $args->{'offset'};
2328              
2329 0 0       0 if(defined $offset)
2330             {
2331 0         0 $args->{'limit_suffix'} = "LIMIT $limit OFFSET $offset";
2332             }
2333             else
2334             {
2335 0         0 $args->{'limit_suffix'} = "LIMIT $limit";
2336             }
2337             }
2338              
2339             sub format_table_with_alias
2340             {
2341             #my($self, $table, $alias, $hints) = @_;
2342 0     0 0 0 return "$_[1] $_[2]";
2343             }
2344              
2345             sub format_select_start_sql
2346             {
2347 0     0 0 0 my($self, $hints) = @_;
2348 0 0       0 return 'SELECT' unless($hints);
2349 0 0       0 return 'SELECT ' . ($hints->{'comment'} ? "/* $hints->{'comment'} */" : '');
2350             }
2351              
2352 0     0 0 0 sub format_select_lock { '' }
2353              
2354             sub column_sql_from_lock_on_value
2355             {
2356 0     0 0 0 my($self, $object_or_class, $name, $tables) = @_;
2357              
2358 0         0 my %map;
2359              
2360 0 0       0 if($tables)
2361             {
2362 0         0 my $tn = 1;
2363              
2364 0         0 foreach my $table (@$tables)
2365             {
2366 0         0 (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
2367 0         0 $map{$table_key} = 't' . $tn++;
2368             }
2369             }
2370              
2371 0         0 my $table;
2372 0         0 my $chase_meta = $object_or_class->meta;
2373              
2374             # Chase down multi-level keys: e.g., products.vendor.name
2375 0         0 while($name =~ /\G([^.]+)(\.|$)/g)
2376             {
2377 0         0 my($sub_name, $more) = ($1, $2);
2378              
2379 0   0     0 my $key = $chase_meta->foreign_key($sub_name) ||
2380             $chase_meta->relationship($sub_name);
2381              
2382 0 0       0 if($key)
2383             {
2384 0 0       0 $chase_meta = $key->can('foreign_class') ?
2385             $key->foreign_class->meta : $key->class->meta;
2386              
2387 0         0 $table = $chase_meta->table;
2388             }
2389             else
2390             {
2391 0 0       0 if($more)
2392             {
2393 0         0 Carp::confess 'Invalid lock => { on => ... } argument: ',
2394             "no foreign key or relationship named '$sub_name' ",
2395             'found in ', $chase_meta->class;
2396             }
2397             else
2398             {
2399 0         0 my $column = $sub_name;
2400              
2401 0 0       0 if($table)
2402             {
2403 0 0       0 $table = $map{$table} if(defined $map{$table});
2404 0         0 return $self->auto_quote_column_with_table($column, $table);
2405             }
2406             else
2407             {
2408 0         0 return $self->auto_quote_column_name($column);
2409             }
2410             }
2411             }
2412             }
2413              
2414 0         0 Carp::confess "Invalid lock => { on => ... } argument: $name";
2415             }
2416              
2417             sub table_sql_from_lock_on_value
2418             {
2419 0     0 0 0 my($self, $object_or_class, $name, $tables) = @_;
2420              
2421 0         0 my %map;
2422              
2423 0 0       0 if($tables)
2424             {
2425 0         0 my $tn = 1;
2426              
2427 0         0 foreach my $table (@$tables)
2428             {
2429 0         0 (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
2430 0         0 $map{$table_key} = 't' . $tn++;
2431             }
2432             }
2433              
2434 0         0 my $table;
2435 0         0 my $chase_meta = $object_or_class->meta;
2436              
2437             # Chase down multi-level keys: e.g., products.vendor.location
2438 0         0 while($name =~ /\G([^.]+)(\.|$)/g)
2439             {
2440 0         0 my($sub_name, $more) = ($1, $2);
2441              
2442 0   0     0 my $key = $chase_meta->foreign_key($sub_name) ||
2443             $chase_meta->relationship($sub_name);
2444              
2445 0 0 0     0 if($key || !$more)
2446             {
2447 0 0       0 if($key)
2448             {
2449 0 0       0 $chase_meta = $key->can('foreign_class') ?
2450             $key->foreign_class->meta : $key->class->meta;
2451              
2452 0         0 $table = $chase_meta->table;
2453             }
2454             else
2455             {
2456 0         0 $table = $sub_name;
2457             }
2458              
2459 0 0       0 next if($more);
2460              
2461 0 0       0 $table = $map{$table} if(defined $map{$table});
2462 0         0 return $self->auto_quote_table_name($table);
2463             }
2464             else
2465             {
2466 0         0 Carp::confess 'Invalid lock => { on => ... } argument: ',
2467             "no foreign key or relationship named '$sub_name' ",
2468             'found in ', $chase_meta->class;
2469             }
2470             }
2471              
2472 0         0 Carp::confess "Invalid lock => { on => ... } argument: $name";
2473             }
2474              
2475 0     0 0 0 sub supports_on_duplicate_key_update { 0 }
2476              
2477             #
2478             # DBI introspection
2479             #
2480              
2481             sub refine_dbi_column_info
2482             {
2483 0     0 0 0 my($self, $col_info) = @_;
2484              
2485             # Parse odd default value syntaxes
2486             $col_info->{'COLUMN_DEF'} =
2487 0         0 $self->parse_dbi_column_info_default($col_info->{'COLUMN_DEF'}, $col_info);
2488              
2489             # Make sure the data type name is lowercase
2490 0         0 $col_info->{'TYPE_NAME'} = lc $col_info->{'TYPE_NAME'};
2491              
2492             # Unquote column name
2493 0         0 $col_info->{'COLUMN_NAME'} = $self->unquote_column_name($col_info->{'COLUMN_NAME'});
2494              
2495 0         0 return;
2496             }
2497              
2498             sub refine_dbi_foreign_key_info
2499             {
2500 0     0 0 0 my($self, $fk_info) = @_;
2501              
2502             # Unquote names
2503 0         0 foreach my $name (qw(NAME COLUMN_NAME DATA_TYPE TABLE_NAME TABLE_CAT TABLE_SCHEM))
2504             {
2505 0         0 foreach my $prefix (qw(FK_ UK_))
2506             {
2507 0         0 my $param = $prefix . $name;
2508             $fk_info->{$param} = $self->unquote_column_name($fk_info->{$param})
2509 0 0       0 if(exists $fk_info->{$param});
2510             }
2511             }
2512              
2513 0         0 return;
2514             }
2515              
2516 0     0 0 0 sub parse_dbi_column_info_default { $_[1] }
2517              
2518             sub list_tables
2519             {
2520 0     0 1 0 my($self, %args) = @_;
2521              
2522 0 0       0 my $types = $args{'include_views'} ? "'TABLE','VIEW'" : 'TABLE';
2523              
2524 0         0 my(@tables, $error);
2525              
2526             TRY:
2527             {
2528 0         0 local $@;
  0         0  
2529              
2530             eval
2531 0         0 {
2532 0 0       0 my $dbh = $self->dbh or die $self->error;
2533              
2534 0         0 local $dbh->{'RaiseError'} = 1;
2535 0         0 local $dbh->{'FetchHashKeyName'} = 'NAME';
2536              
2537 0         0 my $sth = $dbh->table_info($self->catalog, $self->schema, '%', $types);
2538              
2539 0         0 $sth->execute;
2540              
2541 0         0 while(my $table_info = $sth->fetchrow_hashref)
2542             {
2543 0         0 push(@tables, $table_info->{'TABLE_NAME'})
2544             }
2545             };
2546              
2547 0         0 $error = $@;
2548             }
2549              
2550 0 0       0 if($error)
2551             {
2552 0         0 Carp::croak "Could not list tables from ", $self->dsn, " - $error";
2553             }
2554              
2555 0 0       0 return wantarray ? @tables : \@tables;
2556             }
2557              
2558             #
2559             # Setup overrides
2560             #
2561              
2562             # - Rose::DB development init file - Perl code
2563             # - Rose::DB fixup rc file - YAML format
2564              
2565             sub auto_load_fixups
2566             {
2567 0     0 1 0 my($class) = shift;
2568              
2569             # Load a file full of fix-ups for the data sources (usually just passwords)
2570             # from a "well-known" (or at least "well-specified") location.
2571 0         0 my $fixup_file = $ENV{'ROSEDBRC'};
2572 0 0 0     0 $fixup_file = '/etc/rosedbrc' unless(defined $fixup_file && -e $fixup_file);
2573              
2574 0 0       0 if(-e $fixup_file)
2575             {
2576 0 0       0 if(-r $fixup_file)
2577             {
2578 0         0 $class->load_yaml_fixup_file($fixup_file);
2579             }
2580             else
2581             {
2582 0         0 warn "Cannot read Rose::DB fixup file '$fixup_file'";
2583             }
2584             }
2585              
2586             # Load a file or package full of arbitrary Perl used to alter the data
2587             # source registry. This is intended for use in development only.
2588 0         0 my $rosedb_devinit = $ENV{'ROSEDB_DEVINIT'};
2589              
2590 0         0 my $error;
2591              
2592 0 0       0 if(defined $rosedb_devinit)
2593             {
2594 0 0       0 if(-e $rosedb_devinit)
2595             {
2596             TRY:
2597             {
2598 0         0 local $@;
  0         0  
2599 0         0 do $rosedb_devinit;
2600 0         0 $error = $@;
2601             }
2602             }
2603             else
2604             {
2605             TRY:
2606             {
2607 0         0 local $@;
  0         0  
2608 0         0 eval qq(require $rosedb_devinit);
2609 0         0 $error = $@;
2610             }
2611              
2612 0 0       0 if($rosedb_devinit->can('fixup'))
2613             {
2614 0         0 $rosedb_devinit->fixup($class);
2615             }
2616             }
2617             }
2618              
2619 0 0 0     0 if($error || !defined $rosedb_devinit)
2620             {
2621 0         0 my $username;
2622              
2623             # The getpwuid() function is often(?) unimplemented in perl on Windows
2624             TRY:
2625             {
2626 0         0 local $@;
  0         0  
2627 0         0 eval { $username = lc getpwuid($<) };
  0         0  
2628 0         0 $error = $@;
2629             }
2630              
2631 0 0       0 unless($error)
2632             {
2633 0         0 $rosedb_devinit = "Rose::DB::Devel::Init::$username";
2634              
2635             TRY:
2636             {
2637 0         0 local $@;
  0         0  
2638 0         0 eval qq(require $rosedb_devinit);
2639 0         0 $error = $@;
2640             }
2641              
2642 0 0       0 if($error)
2643             {
2644             TRY:
2645             {
2646 0         0 local $@;
  0         0  
2647 0         0 eval { do $rosedb_devinit };
  0         0  
2648 0         0 $error = $@;
2649             }
2650             }
2651             else
2652             {
2653 0 0       0 if($rosedb_devinit->can('fixup'))
2654             {
2655 0         0 $rosedb_devinit->fixup($class);
2656             }
2657             }
2658             }
2659             }
2660             }
2661              
2662             # YAML syntax example:
2663             #
2664             # ---
2665             # production:
2666             # g3db:
2667             # password: mysecret
2668             # ---
2669             # mqa:
2670             # g3db:
2671             # password: myothersecret
2672              
2673             our $YAML_Class;
2674              
2675             sub load_yaml_fixup_file
2676             {
2677 0     0 0 0 my($class, $file) = @_;
2678              
2679 0         0 my $registry = $class->registry;
2680              
2681 0 0       0 unless($YAML_Class)
2682             {
2683 0         0 my $error;
2684              
2685             TRY:
2686             {
2687 0         0 local $@;
  0         0  
2688 0         0 eval { require YAML::Syck };
  0         0  
2689 0         0 $error = $@;
2690             }
2691              
2692 0 0       0 if($error)
2693             {
2694 0         0 require YAML;
2695             #warn "# Using YAML\n";
2696 0         0 $YAML_Class = 'YAML';
2697             }
2698             else
2699             {
2700             #warn "# Using YAML::Syck\n";
2701 0         0 $YAML_Class = 'YAML::Syck';
2702             }
2703             }
2704              
2705 0 0       0 $Debug && warn "$class - Loading fixups from $file...\n";
2706 16     16   140 no strict 'refs';
  16         33  
  16         8664  
2707 0         0 my @data = &{"${YAML_Class}::LoadFile"}($file);
  0         0  
2708              
2709 0         0 foreach my $data (@data)
2710             {
2711 0         0 foreach my $domain (sort keys %$data)
2712             {
2713 0         0 foreach my $type (sort keys %{$data->{$domain}})
  0         0  
2714             {
2715 0         0 my $entry = $registry->entry(domain => $domain, type => $type);
2716              
2717 0 0       0 unless($entry)
2718             {
2719 0         0 warn "No $class data source found for domain '$domain' ",
2720             "and type '$type'";
2721 0         0 next;
2722             }
2723              
2724 0         0 while(my($method, $value) = each(%{$data->{$domain}{$type}}))
  0         0  
2725             {
2726             #$Debug && warn "$class - $domain:$type - $method = $value\n";
2727 0         0 $entry->$method($value);
2728             }
2729             }
2730             }
2731             }
2732             }
2733              
2734             #
2735             # Storable hooks
2736             #
2737              
2738             sub STORABLE_freeze
2739             {
2740 0     0 0 0 my($self, $cloning) = @_;
2741              
2742 0 0       0 return if($cloning);
2743              
2744             # Ditch the DBI $dbh and pull the password out of its closure
2745 0         0 my $db = { %$self };
2746 0         0 $db->{'dbh'} = undef;
2747 0         0 $db->{'password'} = $self->password;
2748 0         0 $db->{'password_closure'} = undef;
2749              
2750 0         0 require Storable;
2751 0         0 return Storable::freeze($db);
2752             }
2753              
2754             sub STORABLE_thaw
2755             {
2756 0     0 0 0 my($self, $cloning, $serialized) = @_;
2757              
2758 0         0 %$self = %{ Storable::thaw($serialized) };
  0         0  
2759              
2760             # Put the password back in a closure
2761 0         0 my $password = delete $self->{'password'};
2762 0 0   0   0 $self->{'password_closure'} = sub { $password } if(defined $password);
  0         0  
2763             }
2764              
2765             #
2766             # This is both a class and an object method
2767             #
2768              
2769             sub error
2770             {
2771 54     54 1 1383 my($self_or_class) = shift;
2772              
2773 54 100       135 if(ref $self_or_class) # Object method
2774             {
2775 48 100       98 if(@_)
2776             {
2777 44         124 return $self_or_class->{'error'} = $Error = shift;
2778             }
2779 4         20 return $self_or_class->{'error'};
2780             }
2781              
2782             # Class method
2783 6 100       19 return $Error = shift if(@_);
2784 4         21 return $Error;
2785             }
2786              
2787             sub DESTROY
2788             {
2789 68     68   68153 $_[0]->disconnect;
2790             }
2791              
2792             BEGIN
2793 0         0 {
2794             package Rose::DateTime::Format::Generic;
2795              
2796 16     16   143 use Rose::Object;
  16         42  
  16         935  
2797 16     16   13918 our @ISA = qw(Rose::Object);
2798              
2799             use Rose::Object::MakeMethods::Generic
2800             (
2801 16         110 scalar => 'server_tz',
2802             boolean => 'european',
2803 16     16   121 );
  16         28  
2804              
2805 0     0     sub format_date { shift; Rose::DateTime::Util::format_date($_[0], '%Y-%m-%d') }
  0            
2806 0     0     sub format_datetime { shift; Rose::DateTime::Util::format_date($_[0], '%Y-%m-%d %T') }
  0            
2807 0     0     sub format_timestamp { shift; Rose::DateTime::Util::format_date($_[0], '%Y-%m-%d %H:%M:%S.%N') }
  0            
2808 0     0     sub format_timestamp_with_time_zone { shift->format_timestamp(@_) }
2809              
2810 0     0     sub parse_date { shift; Rose::DateTime::Util::parse_date($_[0], $_[0]->server_tz) }
  0            
2811 0     0     sub parse_datetime { shift; Rose::DateTime::Util::parse_date($_[0], $_[0]->server_tz) }
  0            
2812 0     0     sub parse_timestamp { shift; Rose::DateTime::Util::parse_date($_[0], $_[0]->server_tz) }
  0            
2813 0     0     sub parse_timestamp_with_time_zone { shift->parse_timestamp(@_) }
2814             }
2815              
2816             1;
2817              
2818             __END__
2819              
2820             =encoding utf8
2821              
2822             =head1 NAME
2823              
2824             Rose::DB - A DBI wrapper and abstraction layer.
2825              
2826             =head1 SYNOPSIS
2827              
2828             package My::DB;
2829              
2830             use Rose::DB;
2831             our @ISA = qw(Rose::DB);
2832              
2833             My::DB->register_db(
2834             domain => 'development',
2835             type => 'main',
2836             driver => 'Pg',
2837             database => 'dev_db',
2838             host => 'localhost',
2839             username => 'devuser',
2840             password => 'mysecret',
2841             server_time_zone => 'UTC',
2842             );
2843              
2844             My::DB->register_db(
2845             domain => 'production',
2846             type => 'main',
2847             driver => 'Pg',
2848             database => 'big_db',
2849             host => 'dbserver.acme.com',
2850             username => 'dbadmin',
2851             password => 'prodsecret',
2852             server_time_zone => 'UTC',
2853             );
2854              
2855             My::DB->default_domain('development');
2856             My::DB->default_type('main');
2857             ...
2858              
2859             $db = My::DB->new;
2860              
2861             my $dbh = $db->dbh or die $db->error;
2862              
2863             $db->begin_work or die $db->error;
2864             $dbh->do(...) or die $db->error;
2865             $db->commit or die $db->error;
2866              
2867             $db->do_transaction(sub
2868             {
2869             $dbh->do(...);
2870             $sth = $dbh->prepare(...);
2871             $sth->execute(...);
2872             while($sth->fetch) { ... }
2873             $dbh->do(...);
2874             })
2875             or die $db->error;
2876              
2877             $dt = $db->parse_timestamp('2001-03-05 12:34:56.123');
2878             $val = $db->format_timestamp($dt);
2879              
2880             $dt = $db->parse_datetime('2001-03-05 12:34:56');
2881             $val = $db->format_datetime($dt);
2882              
2883             $dt = $db->parse_date('2001-03-05');
2884             $val = $db->format_date($dt);
2885              
2886             $bit = $db->parse_bitfield('0x0AF', 32);
2887             $val = $db->format_bitfield($bit);
2888              
2889             ...
2890              
2891             =head1 DESCRIPTION
2892              
2893             L<Rose::DB> is a wrapper and abstraction layer for L<DBI>-related functionality. A L<Rose::DB> object "has a" L<DBI> object; it is not a subclass of L<DBI>.
2894              
2895             Please see the L<tutorial|Rose::DB::Tutorial> (perldoc Rose::DB::Tutorial) for an example usage scenario that reflects "best practices" for this module.
2896              
2897             B<Tip:> Are you looking for an object-relational mapper (ORM)? If so, please see the L<Rose::DB::Object> module. L<Rose::DB::Object> is an ORM that uses this module to manage its database connections. L<Rose::DB> alone is simply a data source abstraction layer; it is not an ORM.
2898              
2899             =head1 DATABASE SUPPORT
2900              
2901             L<Rose::DB> currently supports the following L<DBI> database drivers:
2902              
2903             DBD::Pg (PostgreSQL)
2904             DBD::mysql (MySQL)
2905             DBD::MariaDB (MariaDB)
2906             DBD::SQLite (SQLite)
2907             DBD::Informix (Informix)
2908             DBD::Oracle (Oracle)
2909              
2910             L<Rose::DB> will attempt to service an unsupported database using a L<generic|Rose::DB::Generic> implementation that may or may not work. Support for more drivers may be added in the future. Patches are welcome.
2911              
2912             All database-specific behavior is contained and documented in the subclasses of L<Rose::DB>. L<Rose::DB>'s constructor method (L<new()|/new>) returns a database-specific subclass of L<Rose::DB>, chosen based on the L<driver|/driver> value of the selected L<data source|"Data Source Abstraction">. The default mapping of databases to L<Rose::DB> subclasses is:
2913              
2914             DBD::Pg -> Rose::DB::Pg
2915             DBD::mysql -> Rose::DB::MySQL
2916             DBD::MariaDB -> Rose::DB::MariaDB
2917             DBD::SQLite -> Rose::DB::SQLite
2918             DBD::Informix -> Rose::DB::Informix
2919             DBD::Oracle -> Rose::DB::Oracle
2920              
2921             This mapping can be changed using the L<driver_class|/driver_class> class method.
2922              
2923             The L<Rose::DB> object method documentation found here defines the purpose of each method, as well as the default behavior of the method if it is not overridden by a subclass. You must read the subclass documentation to learn about behaviors that are specific to each type of database.
2924              
2925             Subclasses may also add methods that do not exist in the parent class, of course. This is yet another reason to read the documentation for the subclass that corresponds to your data source's database software.
2926              
2927             =head1 FEATURES
2928              
2929             The basic features of L<Rose::DB> are as follows.
2930              
2931             =head2 Data Source Abstraction
2932              
2933             Instead of dealing with "databases" that exist on "hosts" or are located via some vendor-specific addressing scheme, L<Rose::DB> deals with "logical" data sources. Each logical data source is currently backed by a single "physical" database (basically a single L<DBI> connection).
2934              
2935             Multiplexing, fail-over, and other more complex relationships between logical data sources and physical databases are not part of L<Rose::DB>. Some basic types of fail-over may be added to L<Rose::DB> in the future, but right now the mapping is strictly one-to-one. (I'm also currently inclined to encourage multiplexing functionality to exist in a layer above L<Rose::DB>, rather than within it or in a subclass of it.)
2936              
2937             The driver type of the data source determines the functionality of all methods that do vendor-specific things (e.g., L<column value parsing and formatting|"Vendor-Specific Column Value Parsing and Formatting">).
2938              
2939             L<Rose::DB> identifies data sources using a two-level namespace made of a "domain" and a "type". Both are arbitrary strings. If left unspecified, the default domain and default type (accessible via L<Rose::DB>'s L<default_domain|/default_domain> and L<default_type|/default_type> class methods) are assumed.
2940              
2941             There are many ways to use the two-level namespace, but the most common is to use the domain to represent the current environment (e.g., "development", "staging", "production") and then use the type to identify the logical data source within that environment (e.g., "report", "main", "archive")
2942              
2943             A typical deployment scenario will set the default domain using the L<default_domain|/default_domain> class method as part of the configure/install process. Within application code, L<Rose::DB> objects can be constructed by specifying type alone:
2944              
2945             $main_db = Rose::DB->new(type => 'main');
2946             $archive_db = Rose::DB->new(type => 'archive');
2947              
2948             If there is only one database type, then all L<Rose::DB> objects can be instantiated with a bare constructor call like this:
2949              
2950             $db = Rose::DB->new;
2951              
2952             Again, remember that this is just one of many possible uses of domain and type. Arbitrarily complex scenarios can be created by nesting namespaces within one or both parameters (much like how Perl uses "::" to create a multi-level namespace from single strings).
2953              
2954             The important point is the abstraction of data sources so they can be identified and referred to using a vocabulary that is entirely independent of the actual DSN (data source names) used by L<DBI> behind the scenes.
2955              
2956             =head2 Database Handle Life-Cycle Management
2957              
2958             When a L<Rose::DB> object is destroyed while it contains an active L<DBI> database handle, the handle is explicitly disconnected before destruction. L<Rose::DB> supports a simple retain/release reference-counting system which allows a database handle to out-live its parent L<Rose::DB> object.
2959              
2960             In the simplest case, L<Rose::DB> could be used for its data source abstractions features alone. For example, transiently creating a L<Rose::DB> and then retaining its L<DBI> database handle before it is destroyed:
2961              
2962             $main_dbh = Rose::DB->new(type => 'main')->retain_dbh
2963             or die Rose::DB->error;
2964              
2965             $aux_dbh = Rose::DB->new(type => 'aux')->retain_dbh
2966             or die Rose::DB->error;
2967              
2968             If the database handle was simply extracted via the L<dbh|/dbh> method instead of retained with L<retain_dbh|/retain_dbh>, it would be disconnected by the time the statement completed.
2969              
2970             # WRONG: $dbh will be disconnected immediately after the assignment!
2971             $dbh = Rose::DB->new(type => 'main')->dbh or die Rose::DB->error;
2972              
2973             =head2 Vendor-Specific Column Value Parsing and Formatting
2974              
2975             Certain semantically identical column types are handled differently in different databases. Date and time columns are good examples. Although many databases store month, day, year, hours, minutes, and seconds using a "datetime" column type, there will likely be significant differences in how each of those databases expects to receive such values, and how they're returned.
2976              
2977             L<Rose::DB> is responsible for converting the wide range of vendor-specific column values for a particular column type into a single form that is convenient for use within Perl code. L<Rose::DB> also handles the opposite task, taking input from the Perl side and converting it into the appropriate format for a specific database. Not all column types that exist in the supported databases are handled by L<Rose::DB>, but support will expand in the future.
2978              
2979             Many column types are specific to a single database and do not exist elsewhere. When it is reasonable to do so, vendor-specific column types may be "emulated" by L<Rose::DB> for the benefit of other databases. For example, an ARRAY value may be stored as a specially formatted string in a VARCHAR field in a database that does not have a native ARRAY column type.
2980              
2981             L<Rose::DB> does B<NOT> attempt to present a unified column type system, however. If a column type does not exist in a particular kind of database, there should be no expectation that L<Rose::DB> will be able to parse and format that value type on behalf of that database.
2982              
2983             =head2 High-Level Transaction Support
2984              
2985             Transactions may be started, committed, and rolled back in a variety of ways using the L<DBI> database handle directly. L<Rose::DB> provides wrappers to do the same things, but with different error handling and return values. There's also a method (L<do_transaction|/do_transaction>) that will execute arbitrary code within a single transaction, automatically handling rollback on failure and commit on success.
2986              
2987             =head1 SUBCLASSING
2988              
2989             Subclassing is B<strongly encouraged> and generally works as expected. (See the L<tutorial|Rose::DB::Tutorial> for a complete example.) There is, however, the question of how class data is shared with subclasses. Here's how it works for the various pieces of class data.
2990              
2991             =over
2992              
2993             =item B<alias_db>, B<modify_db>, B<register_db>, B<unregister_db>, B<unregister_domain>
2994              
2995             By default, all subclasses share the same data source "registry" with L<Rose::DB>. To provide a private registry for your subclass (the recommended approach), see the example in the documentation for the L<registry|/registry> method below.
2996              
2997             =item B<default_domain>, B<default_type>
2998              
2999             If called with no arguments, and if the attribute was never set for this
3000             class, then a left-most, breadth-first search of the parent classes is
3001             initiated. The value returned is taken from first parent class
3002             encountered that has ever had this attribute set.
3003              
3004             (These attributes use the L<inheritable_scalar|Rose::Class::MakeMethods::Generic/inheritable_scalar> method type as defined in L<Rose::Class::MakeMethods::Generic>.)
3005              
3006             =item B<driver_class, default_connect_options>
3007              
3008             These hashes of attributes are inherited by subclasses using a one-time, shallow copy from a superclass. Any subclass that accesses or manipulates the hash in any way will immediately get its own private copy of the hash I<as it exists in the superclass at the time of the access or manipulation>.
3009              
3010             The superclass from which the hash is copied is the closest ("least super") class that has ever accessed or manipulated this hash. The copy is a "shallow" copy, duplicating only the keys and values. Reference values are not recursively copied.
3011              
3012             Setting to hash to undef (using the 'reset' interface) will cause it to be re-copied from a superclass the next time it is accessed.
3013              
3014             (These attributes use the L<inheritable_hash|Rose::Class::MakeMethods::Generic/inheritable_hash> method type as defined in L<Rose::Class::MakeMethods::Generic>.)
3015              
3016             =back
3017              
3018             =head1 SERIALIZATION
3019              
3020             A L<Rose::DB> object may contain a L<DBI> database handle, and L<DBI> database handles usually don't survive the serialize process intact. L<Rose::DB> objects also hide database passwords inside closures, which also don't serialize well. In order for a L<Rose::DB> object to survive serialization, custom hooks are required.
3021              
3022             L<Rose::DB> has hooks for the L<Storable> serialization module, but there is an important caveat. Since L<Rose::DB> objects are blessed into a dynamically generated class (derived from the L<driver class|/driver_class>), you must load your L<Rose::DB>-derived class with all its registered data sources before you can successfully L<thaw|Storable/thaw> a L<frozen|Storable/freeze> L<Rose::DB>-derived object. Here's an example.
3023              
3024             Imagine that this is your L<Rose::DB>-derived class:
3025              
3026             package My::DB;
3027              
3028             use Rose::DB;
3029             our @ISA = qw(Rose::DB);
3030              
3031             My::DB->register_db(
3032             domain => 'dev',
3033             type => 'main',
3034             driver => 'Pg',
3035             ...
3036             );
3037              
3038             My::DB->register_db(
3039             domain => 'prod',
3040             type => 'main',
3041             driver => 'Pg',
3042             ...
3043             );
3044              
3045             My::DB->default_domain('dev');
3046             My::DB->default_type('main');
3047              
3048             In one program, a C<My::DB> object is L<frozen|Storable/freeze> using L<Storable>:
3049              
3050             # my_freeze_script.pl
3051              
3052             use My::DB;
3053             use Storable qw(nstore);
3054              
3055             # Create My::DB object
3056             $db = My::DB->new(domain => 'dev', type => 'main');
3057              
3058             # Do work...
3059             $db->dbh->db('CREATE TABLE some_table (...)');
3060             ...
3061              
3062             # Serialize $db and store it in frozen_data_file
3063             nstore($db, 'frozen_data_file');
3064              
3065             Now another program wants to L<thaw|Storable/thaw> out that C<My::DB> object and use it. To do so, it must be sure to load the L<My::DB> module (which registers all its data sources when loaded) I<before> attempting to deserialize the C<My::DB> object serialized by C<my_freeze_script.pl>.
3066              
3067             # my_thaw_script.pl
3068              
3069             # IMPORTANT: load db modules with all data sources registered before
3070             # attempting to deserialize objects of this class.
3071             use My::DB;
3072              
3073             use Storable qw(retrieve);
3074              
3075             # Retrieve frozen My::DB object from frozen_data_file
3076             $db = retrieve('frozen_data_file');
3077              
3078             # Do work...
3079             $db->dbh->db('DROP TABLE some_table');
3080             ...
3081              
3082             Note that this rule about loading a L<Rose::DB>-derived class with all its data sources registered prior to deserializing such an object only applies if the serialization was done in a different process. If you L<freeze|Storable/freeze> and L<thaw|Storable/thaw> within the same process, you don't have to worry about it.
3083              
3084             =head1 ENVIRONMENT
3085              
3086             There are two ways to alter the initial L<Rose::DB> data source registry.
3087              
3088             =over 4
3089              
3090             =item * The ROSEDB_DEVINIT file or module, which can add, modify, or remove data sources and alter the default L<domain|Rose::DB/domain> and L<type|Rose::DB/type>.
3091              
3092             =item * The ROSEDBRC file, which can modify existing data sources.
3093              
3094             =back
3095              
3096             =head2 ROSEDB_DEVINIT
3097              
3098             The C<ROSEDB_DEVINIT> file or module is used during development, usually to set up data sources for a particular developer's database or project. If the C<ROSEDB_DEVINIT> environment variable is set, it should be the name of a Perl module or file. If it is a Perl module and that module has a C<fixup()> subroutine, it will be called as a class method after the module is loaded.
3099              
3100             If the C<ROSEDB_DEVINIT> environment variable is not set, or if the specified file does not exist or has errors, then it defaults to the package name C<Rose::DB::Devel::Init::username>, where "username" is the account name of the current user.
3101              
3102             B<Note:> if the L<getpwuid()|perlfunc/getpwuid> function is unavailable (as is often the case on Windows versions of perl) then this default does not apply and the loading of the module named C<Rose::DB::Devel::Init::username> is not attempted.
3103              
3104             The C<ROSEDB_DEVINIT> file or module may contain arbitrary Perl code which will be loaded and evaluated in the context of L<Rose::DB>. Example:
3105              
3106             Rose::DB->default_domain('development');
3107              
3108             Rose::DB->modify_db(domain => 'development',
3109             type => 'main_db',
3110             database => 'main',
3111             username => 'jdoe',
3112             password => 'mysecret');
3113              
3114             1;
3115              
3116             Remember to end the file with a true value.
3117              
3118             The C<ROSEDB_DEVINIT> file or module must be read explicitly by calling the L<auto_load_fixups|/auto_load_fixups> class method.
3119              
3120             =head2 ROSEDBRC
3121              
3122             The C<ROSEDBRC> file contains configuration "fix-up" information. This file is most often used to dynamically set passwords that are too sensitive to be included directly in the source code of a L<Rose::DB>-derived class.
3123              
3124             The path to the fix-up file is determined by the C<ROSEDBRC> environment variable. If this variable is not set, or if the file it points to does not exist, then it defaults to C</etc/rosedbrc>.
3125              
3126             This file should be in YAML format. To read this file, you must have either L<YAML::Syck> or some reasonably modern version of L<YAML> installed (0.66 or later recommended). L<YAML::Syck> will be preferred if both are installed.
3127              
3128             The C<ROSEDBRC> file's contents have the following structure:
3129              
3130             ---
3131             somedomain:
3132             sometype:
3133             somemethod: somevalue
3134             ---
3135             otherdomain:
3136             othertype:
3137             othermethod: othervalue
3138              
3139             Each entry modifies an existing registered data source. Any valid L<registry entry|Rose::DB::Registry::Entry> object method can be used (in place of "somemethod" and "othermethod" in the YAML example above).
3140              
3141             This file must be read explicitly by calling the L<auto_load_fixups|/auto_load_fixups> class method I<after> setting up all your data sources. Example:
3142              
3143             package My::DB;
3144              
3145             use Rose::DB;
3146             our @ISA = qw(Rose::DB);
3147              
3148             __PACKAGE__->use_private_registry;
3149              
3150             # Register all data sources
3151             __PACKAGE__->register_db(
3152             domain => 'development',
3153             type => 'main',
3154             driver => 'Pg',
3155             database => 'dev_db',
3156             host => 'localhost',
3157             username => 'devuser',
3158             password => 'mysecret',
3159             );
3160              
3161             ...
3162              
3163             # Load fix-up files, if any
3164             __PACKAGE__->auto_load_fixups;
3165              
3166             =head1 CLASS METHODS
3167              
3168             =over 4
3169              
3170             =item B<alias_db PARAMS>
3171              
3172             Make one data source an alias for another by pointing them both to the same registry entry. PARAMS are name/value pairs that must include domain and type values for both the source and alias parameters. Example:
3173              
3174             Rose::DB->alias_db(source => { domain => 'dev', type => 'main' },
3175             alias => { domain => 'dev', type => 'aux' });
3176              
3177             This makes the "dev/aux" data source point to the same registry entry as the "dev/main" data source. Modifications to either registry entry (via L<modify_db|/modify_db>) will be reflected in both.
3178              
3179             =item B<auto_load_fixups>
3180              
3181             Attempt to load both the YAML-based L<ROSEDBRC|/ROSEDBRC> and Perl-based L<ROSEDB_DEVINIT|/ROSEDB_DEVINIT> fix-up files, if any exist, in that order. The L<ROSEDBRC|/ROSEDBRC> file will modify the data source L<registry|/registry> of the calling class. See the L<ENVIRONMENT|/ENVIRONMENT> section above for more information.
3182              
3183             =item B<db_cache [CACHE]>
3184              
3185             Get or set the L<Rose::DB::Cache>-derived object used to cache L<Rose::DB> objects on behalf of this class. If no such object exists, a new cache object of L<db_cache_class|/db_cache_class> class will be created, stored, and returned.
3186              
3187             =item B<db_cache_class [CLASS]>
3188              
3189             Get or set the name of the L<Rose::DB::Cache>-derived class used to cache L<Rose::DB> objects on behalf of this class. The default value is L<Rose::DB::Cache>.
3190              
3191             =item B<db_exists PARAMS>
3192              
3193             Returns true of the data source specified by PARAMS is registered, false otherwise. PARAMS are name/value pairs for C<domain> and C<type>. If they are omitted, they default to L<default_domain|/default_domain> and L<default_type|/default_type>, respectively. If default values do not exist, a fatal error will occur. If a single value is passed instead of name/value pairs, it is taken as the value of the C<type> parameter.
3194              
3195             =item B<default_connect_options [HASHREF | PAIRS]>
3196              
3197             Get or set the default L<DBI> connect options hash. If a reference to a hash is passed, it replaces the default connect options hash. If a series of name/value pairs are passed, they are added to the default connect options hash.
3198              
3199             The default set of default connect options is:
3200              
3201             AutoCommit => 1,
3202             RaiseError => 1,
3203             PrintError => 1,
3204             ChopBlanks => 1,
3205             Warn => 0,
3206              
3207             See the L<connect_options|/connect_options> object method for more information on how the default connect options are used.
3208              
3209             =item B<default_domain [DOMAIN]>
3210              
3211             Get or set the default data source domain. See the L<"Data Source Abstraction"> section for more information on data source domains.
3212              
3213             =item B<default_type [TYPE]>
3214              
3215             Get or set the default data source type. See the L<"Data Source Abstraction"> section for more information on data source types.
3216              
3217             =item B<driver_class DRIVER [, CLASS]>
3218              
3219             Get or set the subclass used for DRIVER. The DRIVER argument is automatically converted to lowercase. (Driver names are effectively case-insensitive.)
3220              
3221             $class = Rose::DB->driver_class('Pg'); # get
3222             Rose::DB->driver_class('pg' => 'MyDB::Pg'); # set
3223              
3224             The default mapping of driver names to class names is as follows:
3225              
3226             mysql -> Rose::DB::MySQL
3227             mariadb -> Rose::DB::MariaDB
3228             pg -> Rose::DB::Pg
3229             informix -> Rose::DB::Informix
3230             sqlite -> Rose::DB::SQLite
3231             oracle -> Rose::DB::Oracle
3232             generic -> Rose::DB::Generic
3233              
3234             The class mapped to the special driver name "generic" will be used for any driver name that does not have an entry in the map.
3235              
3236             See the documentation for the L<new|/new> method for more information on how the driver influences the class of objects returned by the constructor.
3237              
3238             =item B<default_keyword_function_calls [BOOL]>
3239              
3240             Get or set a boolean default value for the L<keyword_function_calls|/keyword_function_calls> object attribute. Defaults to the value of the C<ROSE_DB_KEYWORD_FUNCTION_CALLS> environment variable, it set to a defined value, or false otherwise.
3241              
3242             =item B<modify_db PARAMS>
3243              
3244             Modify a data source, setting the attributes specified in PARAMS, where
3245             PARAMS are name/value pairs. Any L<Rose::DB> object method that sets a L<data source configuration value|"Data Source Configuration"> is a valid parameter name.
3246              
3247             # Set new username for data source identified by domain and type
3248             Rose::DB->modify_db(domain => 'test',
3249             type => 'main',
3250             username => 'tester');
3251              
3252             PARAMS should include values for both the C<type> and C<domain> parameters since these two attributes are used to identify the data source. If they are omitted, they default to L<default_domain|/default_domain> and L<default_type|/default_type>, respectively. If default values do not exist, a fatal error will occur. If there is no data source defined for the specified C<type> and C<domain>, a fatal error will occur.
3253              
3254             =item B<prepare_cache_for_apache_fork>
3255              
3256             This is a convenience method that is equivalent to the following call:
3257              
3258             Rose::DB->db_cache->prepare_for_apache_fork()
3259              
3260             Any arguments passed to this method are passed on to the call to the L<db_cache|/db_cache>'s L<prepare_for_apache_fork|Rose::DB::Cache/prepare_for_apache_fork> method.
3261              
3262             Please read the L<Rose::DB::Cache> documentation, particularly the documentation for the L<use_cache_during_apache_startup|Rose::DB::Cache/use_cache_during_apache_startup> method for more information.
3263              
3264             =item B<register_db PARAMS>
3265              
3266             Registers a new data source with the attributes specified in PARAMS, where
3267             PARAMS are name/value pairs. Any L<Rose::DB> object method that sets a L<data source configuration value|"Data Source Configuration"> is a valid parameter name.
3268              
3269             PARAMS B<must> include a value for the C<driver> parameter. If the C<type> or C<domain> parameters are omitted or undefined, they default to the return values of the L<default_type|/default_type> and L<default_domain|/default_domain> class methods, respectively.
3270              
3271             The C<type> and C<domain> are used to identify the data source. If either one is missing, a fatal error will occur. See the L<"Data Source Abstraction"> section for more information on data source types and domains.
3272              
3273             The C<driver> is used to determine which class objects will be blessed into by the L<Rose::DB> constructor, L<new|/new>. The driver name is automatically converted to lowercase. If it is missing, a fatal error will occur.
3274              
3275             In most deployment scenarios, L<register_db|/register_db> is called early in the compilation process to ensure that the registered data sources are available when the "real" code runs.
3276              
3277             Database registration can be included directly in your L<Rose::DB> subclass. This is the recommended approach. Example:
3278              
3279             package My::DB;
3280              
3281             use Rose::DB;
3282             our @ISA = qw(Rose::DB);
3283              
3284             # Use a private registry for this class
3285             __PACKAGE__->use_private_registry;
3286              
3287             # Register data sources
3288             My::DB->register_db(
3289             domain => 'development',
3290             type => 'main',
3291             driver => 'Pg',
3292             database => 'dev_db',
3293             host => 'localhost',
3294             username => 'devuser',
3295             password => 'mysecret',
3296             );
3297              
3298             My::DB->register_db(
3299             domain => 'production',
3300             type => 'main',
3301             driver => 'Pg',
3302             database => 'big_db',
3303             host => 'dbserver.acme.com',
3304             username => 'dbadmin',
3305             password => 'prodsecret',
3306             );
3307             ...
3308              
3309             Another possible approach is to consolidate data source registration in a single module which is then C<use>ed early on in the code path. For example, imagine a mod_perl web server environment:
3310              
3311             # File: MyCorp/DataSources.pm
3312             package MyCorp::DataSources;
3313              
3314             My::DB->register_db(
3315             domain => 'development',
3316             type => 'main',
3317             driver => 'Pg',
3318             database => 'dev_db',
3319             host => 'localhost',
3320             username => 'devuser',
3321             password => 'mysecret',
3322             );
3323              
3324             My::DB->register_db(
3325             domain => 'production',
3326             type => 'main',
3327             driver => 'Pg',
3328             database => 'big_db',
3329             host => 'dbserver.acme.com',
3330             username => 'dbadmin',
3331             password => 'prodsecret',
3332             );
3333             ...
3334              
3335             # File: /usr/local/apache/conf/startup.pl
3336              
3337             use My::DB; # your Rose::DB subclass
3338             use MyCorp::DataSources; # register all data sources
3339             ...
3340              
3341             Data source registration can happen at any time, of course, but it is most useful when all application code can simply assume that all the data sources are already registered. Doing the registration as early as possible (e.g., directly in your L<Rose::DB> subclass, or in a C<startup.pl> file that is loaded from an apache/mod_perl web server's C<httpd.conf> file) is the best way to create such an environment.
3342              
3343             Note that the data source registry serves as an I<initial> source of information for L<Rose::DB> objects. Once an object is instantiated, it is independent of the registry. Changes to an object are not reflected in the registry, and changes to the registry are not reflected in existing objects.
3344              
3345             =item B<registry [REGISTRY]>
3346              
3347             Get or set the L<Rose::DB::Registry>-derived object that manages and stores the data source registry. It defaults to an "empty" L<Rose::DB::Registry> object. Remember that setting a new registry will replace the existing registry and all the data sources registered in it.
3348              
3349             Note that L<Rose::DB> subclasses will inherit the base class's L<Rose::DB::Registry> object and will therefore inherit all existing registry entries and share the same registry namespace as the base class. This may or may not be what you want.
3350              
3351             In most cases, it's wise to give your subclass its own private registry if it inherits directly from L<Rose::DB>. To do that, just set a new registry object in your subclass. Example:
3352              
3353             package My::DB;
3354              
3355             use Rose::DB;
3356             our @ISA = qw(Rose::DB);
3357              
3358             # Create a private registry for this class:
3359             #
3360             # either explicitly:
3361             # use Rose::DB::Registry;
3362             # __PACKAGE__->registry(Rose::DB::Registry->new);
3363             #
3364             # or use the convenience method:
3365             __PACKAGE__->use_private_registry;
3366             ...
3367              
3368             Further subclasses of C<My::DB> may then inherit its registry object, if desired, or may create their own private registries in the manner shown above.
3369              
3370             =item B<unregister_db PARAMS>
3371              
3372             Unregisters the data source having the C<type> and C<domain> specified in PARAMS, where PARAMS are name/value pairs. Returns true if the data source was unregistered successfully, false if it did not exist in the first place. Example:
3373              
3374             Rose::DB->unregister_db(type => 'main', domain => 'test');
3375              
3376             PARAMS B<must> include values for both the C<type> and C<domain> parameters since these two attributes are used to identify the data source. If either one is missing, a fatal error will occur.
3377              
3378             Unregistering a data source removes all knowledge of it. This may be harmful to any existing L<Rose::DB> objects that are associated with that data source.
3379              
3380             =item B<unregister_domain DOMAIN>
3381              
3382             Unregisters an entire domain. Returns true if the domain was unregistered successfully, false if it did not exist in the first place. Example:
3383              
3384             Rose::DB->unregister_domain('test');
3385              
3386             Unregistering a domain removes all knowledge of all of the data sources that existed under it. This may be harmful to any existing L<Rose::DB> objects that are associated with any of those data sources.
3387              
3388             =item B<use_cache_during_apache_startup [BOOL]>
3389              
3390             This is a convenience method that is equivalent to the following call:
3391              
3392             Rose::DB->db_cache->use_cache_during_apache_startup(...)
3393              
3394             The boolean argument passed to this method is passed on to the call to the L<db_cache|/db_cache>'s L<use_cache_during_apache_startup|Rose::DB::Cache/use_cache_during_apache_startup> method.
3395              
3396             Please read the L<Rose::DB::Cache>'s L<use_cache_during_apache_startup|Rose::DB::Cache/use_cache_during_apache_startup> documentation for more information.
3397              
3398             =item B<use_private_registry>
3399              
3400             This method is used to give a class its own private L<registry|/registry>. In other words, this:
3401              
3402             __PACKAGE__->use_private_registry;
3403              
3404             is roughly equivalent to this:
3405              
3406             use Rose::DB::Registry;
3407             __PACKAGE__->registry(Rose::DB::Registry->new);
3408              
3409             =back
3410              
3411             =head1 CONSTRUCTORS
3412              
3413             =over 4
3414              
3415             =item B<new PARAMS>
3416              
3417             Constructs a new object based on PARAMS, where PARAMS are
3418             name/value pairs. Any object method is a valid parameter name. Example:
3419              
3420             $db = Rose::DB->new(type => 'main', domain => 'qa');
3421              
3422             If a single argument is passed to L<new|/new>, it is used as the C<type> value:
3423              
3424             $db = Rose::DB->new(type => 'aux');
3425             $db = Rose::DB->new('aux'); # same thing
3426              
3427             Each L<Rose::DB> object is associated with a particular data source, defined by the L<type|/type> and L<domain|/domain> values. If these are not part of PARAMS, then the default values are used. If you do not want to use the default values for the L<type|/type> and L<domain|/domain> attributes, you should specify them in the constructor PARAMS.
3428              
3429             The default L<type|/type> and L<domain|/domain> can be set using the L<default_type|/default_type> and L<default_domain|/default_domain> class methods. See the L<"Data Source Abstraction"> section for more information on data sources.
3430              
3431             Object attributes are set based on the L<registry|/registry> entry specified by the C<type> and C<domain> parameters. This registry entry must exist or a fatal error will occur (with one exception; see below). Any additional PARAMS will override the values taken from the registry entry.
3432              
3433             If C<type> and C<domain> parameters are not passed, but a C<driver> parameter is passed, then a new "empty" object will be returned. Examples:
3434              
3435             # This is ok, even if no registered data sources exist
3436             $db = Rose::DB->new(driver => 'sqlite');
3437              
3438             The object returned by L<new|/new> will be derived from a database-specific driver class, chosen based on the L<driver|/driver> value of the selected data source. If there is no registered data source for the specified L<type|/type> and L<domain|/domain>, a fatal error will occur.
3439              
3440             The default driver-to-class mapping is as follows:
3441              
3442             pg -> Rose::DB::Pg
3443             mysql -> Rose::DB::MySQL
3444             mariadb -> Rose::DB::MariaDB
3445             informix -> Rose::DB::Informix
3446             oracle -> Rose::DB::Oracle
3447             sqlite -> Rose::DB::SQLite
3448              
3449             You can change this mapping with the L<driver_class|/driver_class> class method.
3450              
3451             =item B<new_or_cached PARAMS>
3452              
3453             Constructs or returns a L<Rose::DB> object based on PARAMS, where PARAMS are any name/value pairs that can be passed to the L<new|/new> method. If the L<db_cache|/db_cache>'s L<get_db|Rose::DB::Cache/get_db> method returns an existing L<Rose::DB> object that matches PARAMS, then it is returned. Otherwise, a L<new|/new> L<Rose::DB> object is created, L<stored|Rose::DB::Cache/set_db> in the L<db_cache|/db_cache>, then returned.
3454              
3455             See the L<Rose::DB::Cache> documentation to learn about the cache API and the default implementation.
3456              
3457             =back
3458              
3459             =head1 OBJECT METHODS
3460              
3461             =over 4
3462              
3463             =item B<begin_work>
3464              
3465             Attempt to start a transaction by calling the L<begin_work|DBI/begin_work> method on the L<DBI> database handle.
3466              
3467             If necessary, the database handle will be constructed and connected to the current data source. If this fails, undef is returned. If there is no registered data source for the current C<type> and C<domain>, a fatal error will occur.
3468              
3469             If the "AutoCommit" database handle attribute is false, the handle is assumed to already be in a transaction and L<Rose::DB::Constants::IN_TRANSACTION|Rose::DB::Constants> (-1) is returned. If the call to L<DBI>'s L<begin_work|DBI/begin_work> method succeeds, 1 is returned. If it fails, undef is returned.
3470              
3471             =item B<commit>
3472              
3473             Attempt to commit the current transaction by calling the L<commit|DBI/commit> method on the L<DBI> database handle. If the L<DBI> database handle does not exist or is not connected, 0 is returned.
3474              
3475             If the "AutoCommit" database handle attribute is true, the handle is assumed to not be in a transaction and L<Rose::DB::Constants::IN_TRANSACTION|Rose::DB::Constants> (-1) is returned. If the call to L<DBI>'s L<commit|DBI/commit> method succeeds, 1 is returned. If it fails, undef is returned.
3476              
3477             =item B<connect>
3478              
3479             Constructs and connects the L<DBI> database handle for the current data source, calling L<dbi_connect|/dbi_connect> to create a new L<DBI> database handle if none exists. If there is no registered data source for the current L<type|/type> and L<domain|/domain>, a fatal error will occur.
3480              
3481             If any L<post_connect_sql|/post_connect_sql> statement failed to execute, the database handle is disconnected and then discarded.
3482              
3483             If the database handle returned by L<dbi_connect|/dbi_connect> was originally connected by another L<Rose::DB>-derived object (e.g., if a subclass's custom implementation of L<dbi_connect|/dbi_connect> calls L<DBI>'s L<connect_cached|DBI/connect_cached> method) then the L<post_connect_sql|/post_connect_sql> statements will not be run, nor will any custom L<DBI> attributes be applied (e.g., L<Rose::DB::MySQL>'s L<mysql_enable_utf8|Rose::DB::MySQL/mysql_enable_utf8> attribute).
3484              
3485             Returns true if the database handle was connected successfully and all L<post_connect_sql|/post_connect_sql> statements (if any) were run successfully, false otherwise.
3486              
3487             =item B<connect_option NAME [, VALUE]>
3488              
3489             Get or set a single connection option. Example:
3490              
3491             $val = $db->connect_option('RaiseError'); # get
3492             $db->connect_option(AutoCommit => 1); # set
3493              
3494             Connection options are name/value pairs that are passed in a hash reference as the fourth argument to the call to L<DBI-E<gt>connect()|DBI/connect>. See the L<DBI> documentation for descriptions of the various options.
3495              
3496             =item B<connect_options [HASHREF | PAIRS]>
3497              
3498             Get or set the L<DBI> connect options hash. If a reference to a hash is passed, it replaces the connect options hash. If a series of name/value pairs are passed, they are added to the connect options hash.
3499              
3500             Returns a reference to the connect options has in scalar context, or a list of name/value pairs in list context.
3501              
3502             =item B<dbh [DBH]>
3503              
3504             Get or set the L<DBI> database handle connected to the current data source. If the database handle does not exist or was created in another process or thread, this method will discard the old database handle (if any) and L<dbi_connect|/dbi_connect> will be called to create a new one.
3505              
3506             Returns undef if the database handle could not be constructed and connected. If there is no registered data source for the current C<type> and C<domain>, a fatal error will occur.
3507              
3508             Note: when setting this attribute, you I<must> pass in a L<DBI> database handle that has the same L<driver|/driver> as the object. For example, if the L<driver|/driver> is C<mysql> then the L<DBI> database handle must be connected to a MySQL database. Passing in a mismatched database handle will cause a fatal error.
3509              
3510             =item B<dbi_connect [ARGS]>
3511              
3512             This method calls L<DBI-E<gt>connect(...)|DBI/connect>, passing all ARGS and returning all values. This method has no affect on the internal state of the object. Use the L<connect|/connect> method to create and store a new L<database handle|/dbh> in the object.
3513              
3514             Override this method in your L<Rose::DB> subclass if you want to use a different method (e.g. L<DBI-E<gt>connect_cached()|DBI/connect_cached>) to create database handles.
3515              
3516             =item B<disconnect>
3517              
3518             Decrements the reference count for the database handle and disconnects it if the reference count is zero and if the database handle was originally connected by this object. (This may not be the case if, say, a subclass's custom implementation of L<dbi_connect|/dbi_connect> calls L<DBI>'s L<connect_cached|DBI/connect_cached> method.) Regardless of the reference count, it sets the L<dbh|/dbh> attribute to undef.
3519              
3520             Returns true if all L<pre_disconnect_sql|/pre_disconnect_sql> statements (if any) were run successfully and the database handle was disconnected successfully (or if it was simply set to undef), false otherwise.
3521              
3522             The database handle will not be disconnected if any L<pre_disconnect_sql|/pre_disconnect_sql> statement fails to execute, and the L<pre_disconnect_sql|/pre_disconnect_sql> is not run unless the handle is going to be disconnected.
3523              
3524             =item B<do_transaction CODE [, ARGS]>
3525              
3526             Execute arbitrary code within a single transaction, rolling back if any of the code fails, committing if it succeeds. CODE should be a code reference. It will be called with any arguments passed to L<do_transaction|/do_transaction> after the code reference. Example:
3527              
3528             # Transfer $100 from account id 5 to account id 9
3529             $db->do_transaction(sub
3530             {
3531             my($amt, $id1, $id2) = @_;
3532              
3533             my $dbh = $db->dbh or die $db->error;
3534              
3535             # Transfer $amt from account id $id1 to account id $id2
3536             $dbh->do("UPDATE acct SET bal = bal - $amt WHERE id = $id1");
3537             $dbh->do("UPDATE acct SET bal = bal + $amt WHERE id = $id2");
3538             },
3539             100, 5, 9) or warn "Transfer failed: ", $db->error;
3540              
3541             If the CODE block threw an exception or the transaction could not be started and committed successfully, then undef is returned and the exception thrown is available in the L<error|/error> attribute. Otherwise, a true value is returned.
3542              
3543             =item B<error [MSG]>
3544              
3545             Get or set the error message associated with the last failure. If a method fails, check this attribute to get the reason for the failure in the form of a text message.
3546              
3547             =item B<has_dbh>
3548              
3549             Returns true if the object has a L<DBI> database handle (L<dbh|/dbh>), false if it does not.
3550              
3551             =item B<has_primary_key [ TABLE | PARAMS ]>
3552              
3553             Returns true if the specified table has a primary key (as determined by the L<primary_key_column_names|/primary_key_column_names> method), false otherwise.
3554              
3555             The arguments are the same as those for the L<primary_key_column_names|/primary_key_column_names> method: either a table name or name/value pairs specifying C<table>, C<catalog>, and C<schema>. The C<catalog> and C<schema> parameters are optional and default to the return values of the L<catalog|/catalog> and L<schema|/schema> methods, respectively. See the documentation for the L<primary_key_column_names|/primary_key_column_names> for more information.
3556              
3557             =item B<in_transaction>
3558              
3559             Return true if the L<dbh|/dbh> is currently in the middle of a transaction, false (but defined) if it is not. If no L<dbh|/dbh> exists, then undef is returned.
3560              
3561             =item B<init_db_info>
3562              
3563             Initialize data source configuration information based on the current values of the L<type|/type> and L<domain|/domain> attributes by pulling data from the corresponding registry entry. If there is no registered data source for the current L<type|/type> and L<domain|/domain>, a fatal error will occur. L<init_db_info|/init_db_info> is called as part of the L<new|/new> and L<connect|/connect> methods.
3564              
3565             =item B<insertid_param>
3566              
3567             Returns the name of the L<DBI> statement handle attribute that contains the auto-generated unique key created during the last insert operation. Returns undef if the current data source does not support this attribute.
3568              
3569             =item B<keyword_function_calls [BOOL]>
3570              
3571             Get or set a boolean value that indicates whether or not any string that looks like a function call (matches C</^\w+\(.*\)$/>) will be treated as a "keyword" by the various L<format_*|/"Vendor-Specific Column Value Parsing and Formatting"> methods. Defaults to the value returned by the L<default_keyword_function_calls|/default_keyword_function_calls> class method.
3572              
3573             =item B<last_insertid_from_sth STH>
3574              
3575             Given a L<DBI> statement handle, returns the value of the auto-generated unique key created during the last insert operation. This value may be undefined if this feature is not supported by the current data source.
3576              
3577             =item B<list_tables>
3578              
3579             Returns a list (in list context) or reference to an array (in scalar context) of tables in the database. The current L<catalog|/catalog> and L<schema|/schema> are honored.
3580              
3581             =item B<quote_column_name NAME>
3582              
3583             Returns the column name NAME appropriately quoted for use in an SQL statement. (Note that "appropriate" quoting may mean no quoting at all.)
3584              
3585             =item B<release_dbh>
3586              
3587             Decrements the reference count for the L<DBI> database handle, if it exists. Returns 0 if the database handle does not exist.
3588              
3589             If the reference count drops to zero, the database handle is disconnected. Keep in mind that the L<Rose::DB> object itself will increment the reference count when the database handle is connected, and decrement it when L<disconnect|/disconnect> is called.
3590              
3591             Returns true if the reference count is not 0 or if all L<pre_disconnect_sql|/pre_disconnect_sql> statements (if any) were run successfully and the database handle was disconnected successfully, false otherwise.
3592              
3593             The database handle will not be disconnected if any L<pre_disconnect_sql|/pre_disconnect_sql> statement fails to execute, and the L<pre_disconnect_sql|/pre_disconnect_sql> is not run unless the handle is going to be disconnected.
3594              
3595             See the L<"Database Handle Life-Cycle Management"> section for more information on the retain/release system.
3596              
3597             =item B<retain_dbh>
3598              
3599             Returns the connected L<DBI> database handle after incrementing the reference count. If the database handle does not exist or is not already connected, this method will do everything necessary to do so.
3600              
3601             Returns undef if the database handle could not be constructed and connected. If there is no registered data source for the current L<type|/type> and L<domain|/domain>, a fatal error will occur.
3602              
3603             See the L<"Database Handle Life-Cycle Management"> section for more information on the retain/release system.
3604              
3605             =item B<rollback>
3606              
3607             Roll back the current transaction by calling the L<rollback|DBI/rollback> method on the L<DBI> database handle. If the L<DBI> database handle does not exist or is not connected, 0 is returned.
3608              
3609             If the call to L<DBI>'s L<rollback|DBI/rollback> method succeeds or if auto-commit is enabled, 1 is returned. If it fails, undef is returned.
3610              
3611             =back
3612              
3613             =head2 Data Source Configuration
3614              
3615             Not all databases will use all of these values. Values that are not supported are simply ignored.
3616              
3617             =over 4
3618              
3619             =item B<autocommit [VALUE]>
3620              
3621             Get or set the value of the "AutoCommit" connect option and L<DBI> handle attribute. If a VALUE is passed, it will be set in both the connect options hash and the current database handle, if any. Returns the value of the "AutoCommit" attribute of the database handle if it exists, or the connect option otherwise.
3622              
3623             This method should not be mixed with the L<connect_options|/connect_options> method in calls to L<register_db|/register_db> or L<modify_db|/modify_db> since L<connect_options|/connect_options> will overwrite I<all> the connect options with its argument, and neither L<register_db|/register_db> nor L<modify_db|/modify_db> guarantee the order that its parameters will be evaluated.
3624              
3625             =item B<catalog [CATALOG]>
3626              
3627             Get or set the database catalog name. This setting is only relevant to databases that support the concept of catalogs.
3628              
3629             =item B<connect_options [HASHREF | PAIRS]>
3630              
3631             Get or set the options passed in a hash reference as the fourth argument to the call to L<DBI-E<gt>connect()|DBI/connect>. See the L<DBI> documentation for descriptions of the various options.
3632              
3633             If a reference to a hash is passed, it replaces the connect options hash. If a series of name/value pairs are passed, they are added to the connect options hash.
3634              
3635             Returns a reference to the hash of options in scalar context, or a list of name/value pairs in list context.
3636              
3637             When L<init_db_info|/init_db_info> is called for the first time on an object (either in isolation or as part of the L<connect|/connect> process), the connect options are merged with the L<default_connect_options|/default_connect_options>. The defaults are overridden in the case of a conflict. Example:
3638              
3639             Rose::DB->register_db(
3640             domain => 'development',
3641             type => 'main',
3642             driver => 'Pg',
3643             database => 'dev_db',
3644             host => 'localhost',
3645             username => 'devuser',
3646             password => 'mysecret',
3647             connect_options =>
3648             {
3649             RaiseError => 0,
3650             AutoCommit => 0,
3651             }
3652             );
3653              
3654             # Rose::DB->default_connect_options are:
3655             #
3656             # AutoCommit => 1,
3657             # ChopBlanks => 1,
3658             # PrintError => 1,
3659             # RaiseError => 1,
3660             # Warn => 0,
3661              
3662             # The object's connect options are merged with default options
3663             # since new() will trigger the first call to init_db_info()
3664             # for this object
3665             $db = Rose::DB->new(domain => 'development', type => 'main');
3666              
3667             # $db->connect_options are:
3668             #
3669             # AutoCommit => 0,
3670             # ChopBlanks => 1,
3671             # PrintError => 1,
3672             # RaiseError => 0,
3673             # Warn => 0,
3674              
3675             $db->connect_options(TraceLevel => 2); # Add an option
3676              
3677             # $db->connect_options are now:
3678             #
3679             # AutoCommit => 0,
3680             # ChopBlanks => 1,
3681             # PrintError => 1,
3682             # RaiseError => 0,
3683             # TraceLevel => 2,
3684             # Warn => 0,
3685              
3686             # The object's connect options are NOT re-merged with the default
3687             # connect options since this will trigger the second call to
3688             # init_db_info(), not the first
3689             $db->connect or die $db->error;
3690              
3691             # $db->connect_options are still:
3692             #
3693             # AutoCommit => 0,
3694             # ChopBlanks => 1,
3695             # PrintError => 1,
3696             # RaiseError => 0,
3697             # TraceLevel => 2,
3698             # Warn => 0,
3699              
3700             =item B<database [NAME]>
3701              
3702             Get or set the database name used in the construction of the DSN used in the L<DBI> L<connect|DBI/connect> call.
3703              
3704             =item B<domain [DOMAIN]>
3705              
3706             Get or set the data source domain. See the L<"Data Source Abstraction"> section for more information on data source domains.
3707              
3708             =item B<driver [DRIVER]>
3709              
3710             Get or set the driver name. The driver name can only be set during object construction (i.e., as an argument to L<new|/new>) since it determines the object class. After the object is constructed, setting the driver to anything other than the same value it already has will cause a fatal error.
3711              
3712             Even in the call to L<new|/new>, setting the driver name explicitly is not recommended. Instead, specify the driver when calling L<register_db|/register_db> for each data source and allow the L<driver|/driver> to be set automatically based on the L<domain|/domain> and L<type|/type>.
3713              
3714             The driver names for the L<currently supported database types|"DATABASE SUPPORT"> are:
3715              
3716             pg
3717             mysql
3718             mariadb
3719             informix
3720             oracle
3721             sqlite
3722              
3723             Driver names should only use lowercase letters.
3724              
3725             =item B<dsn [DSN]>
3726              
3727             Get or set the L<DBI> DSN (Data Source Name) passed to the call to L<DBI>'s L<connect|DBI/connect> method.
3728              
3729             An attempt is made to parse the new DSN. Any parts successfully extracted are assigned to the corresponding L<Rose::DB> attributes (e.g., L<host|/host>, L<port|/port>, L<database|/database>). If no value could be extracted for an attribute, it is set to undef.
3730              
3731             If the DSN is never set explicitly, it is built automatically based on the relevant object attributes.
3732              
3733             If the DSN is set explicitly, but any of L<host|/host>, L<port|/port>, L<database|/database>, L<schema|/schema>, or L<catalog|/catalog> are also provided, either in an object constructor or when the data source is registered, the explicit DSN may be ignored as a new DSN is constructed based on these attributes.
3734              
3735             =item B<handle_error [VALUE]>
3736              
3737             Get or set the value of the "HandleError" connect option and L<DBI> handle attribute. If a VALUE is passed, it will be set in both the connect options hash and the current database handle, if any. Returns the value of the "HandleError" attribute of the database handle if it exists, or the connect option otherwise.
3738              
3739             This method should not be mixed with the L<connect_options|/connect_options> method in calls to L<register_db|/register_db> or L<modify_db|/modify_db> since L<connect_options|/connect_options> will overwrite I<all> the connect options with its argument, and neither L<register_db|/register_db> nor L<modify_db|/modify_db> guarantee the order that its parameters will be evaluated.
3740              
3741             =item B<host [NAME]>
3742              
3743             Get or set the database server host name used in the construction of the DSN which is passed in the L<DBI> L<connect|DBI/connect> call.
3744              
3745             =item B<password [PASS]>
3746              
3747             Get or set the password that will be passed to the L<DBI> L<connect|DBI/connect> call.
3748              
3749             =item B<port [NUM]>
3750              
3751             Get or set the database server port number used in the construction of the DSN which is passed in the L<DBI> L<connect|DBI/connect> call.
3752              
3753             =item B<pre_disconnect_sql [STATEMENTS]>
3754              
3755             Get or set the SQL statements that will be run immediately before disconnecting from the database. STATEMENTS should be a list or reference to an array of SQL statements. Returns a reference to the array of SQL statements in scalar context, or a list of SQL statements in list context.
3756              
3757             The SQL statements are run in the order that they are supplied in STATEMENTS. If any L<pre_disconnect_sql|/pre_disconnect_sql> statement fails when executed, the subsequent statements are ignored.
3758              
3759             =item B<post_connect_sql [STATEMENTS]>
3760              
3761             Get or set the SQL statements that will be run immediately after connecting to the database. STATEMENTS should be a list or reference to an array of SQL statements. Returns a reference to the array of SQL statements in scalar context, or a list of SQL statements in list context.
3762              
3763             The SQL statements are run in the order that they are supplied in STATEMENTS. If any L<post_connect_sql|/post_connect_sql> statement fails when executed, the subsequent statements are ignored.
3764              
3765             =item B<primary_key_column_names [ TABLE | PARAMS ]>
3766              
3767             Returns a list (in list context) or reference to an array (in scalar context) of the names of the columns that make up the primary key for the specified table. If the table has no primary key, an empty list (in list context) or reference to an empty array (in scalar context) will be returned.
3768              
3769             The table may be specified in two ways. If one argument is passed, it is taken as the name of the table. Otherwise, name/value pairs are expected. Valid parameter names are:
3770              
3771             =over 4
3772              
3773             =item C<catalog>
3774              
3775             The name of the catalog that contains the table. This parameter is optional and defaults to the return value of the L<catalog|/catalog> method.
3776              
3777             =item C<schema>
3778              
3779             The name of the schema that contains the table. This parameter is optional and defaults to the return value of the L<schema|/schema> method.
3780              
3781             =item C<table>
3782              
3783             The name of the table. This parameter is required.
3784              
3785             =back
3786              
3787             Case-sensitivity of names is determined by the underlying database. If your database is case-sensitive, then you must pass names to this method with the expected case.
3788              
3789             =item B<print_error [VALUE]>
3790              
3791             Get or set the value of the "PrintError" connect option and L<DBI> handle attribute. If a VALUE is passed, it will be set in both the connect options hash and the current database handle, if any. Returns the value of the "PrintError" attribute of the database handle if it exists, or the connect option otherwise.
3792              
3793             This method should not be mixed with the L<connect_options|/connect_options> method in calls to L<register_db|/register_db> or L<modify_db|/modify_db> since L<connect_options|/connect_options> will overwrite I<all> the connect options with its argument, and neither L<register_db|/register_db> nor L<modify_db|/modify_db> guarantee the order that its parameters will be evaluated.
3794              
3795             =item B<raise_error [VALUE]>
3796              
3797             Get or set the value of the "RaiseError" connect option and L<DBI> handle attribute. If a VALUE is passed, it will be set in both the connect options hash and the current database handle, if any. Returns the value of the "RaiseError" attribute of the database handle if it exists, or the connect option otherwise.
3798              
3799             This method should not be mixed with the L<connect_options|/connect_options> method in calls to L<register_db|/register_db> or L<modify_db|/modify_db> since L<connect_options|/connect_options> will overwrite I<all> the connect options with its argument, and neither L<register_db|/register_db> nor L<modify_db|/modify_db> guarantee the order that its parameters will be evaluated.
3800              
3801             =item B<schema [SCHEMA]>
3802              
3803             Get or set the database schema name. This setting is only useful to databases that support the concept of schemas (e.g., PostgreSQL).
3804              
3805             =item B<server_time_zone [TZ]>
3806              
3807             Get or set the time zone used by the database server software. TZ should be a time zone name that is understood by L<DateTime::TimeZone>. The default value is "floating".
3808              
3809             See the L<DateTime::TimeZone> documentation for acceptable values of TZ.
3810              
3811             =item B<type [TYPE]>
3812              
3813             Get or set the data source type. See the L<"Data Source Abstraction"> section for more information on data source types.
3814              
3815             =item B<username [NAME]>
3816              
3817             Get or set the username that will be passed to the L<DBI> L<connect|DBI/connect> call.
3818              
3819             =back
3820              
3821             =head2 Value Parsing and Formatting
3822              
3823             =over 4
3824              
3825             =item B<format_bitfield BITS [, SIZE]>
3826              
3827             Converts the L<Bit::Vector> object BITS into the appropriate format for the "bitfield" data type of the current data source. If a SIZE argument is provided, the bit field will be padded with the appropriate number of zeros until it is SIZE bits long. If the data source does not have a native "bit" or "bitfield" data type, a character data type may be used to store the string of 1s and 0s returned by the default implementation.
3828              
3829             =item B<format_boolean VALUE>
3830              
3831             Converts VALUE into the appropriate format for the "boolean" data type of the current data source. VALUE is simply evaluated in Perl's scalar context to determine if it's true or false.
3832              
3833             =item B<format_date DATETIME>
3834              
3835             Converts the L<DateTime> object DATETIME into the appropriate format for the "date" (month, day, year) data type of the current data source.
3836              
3837             =item B<format_datetime DATETIME>
3838              
3839             Converts the L<DateTime> object DATETIME into the appropriate format for the "datetime" (month, day, year, hour, minute, second) data type of the current data source.
3840              
3841             =item B<format_interval DURATION>
3842              
3843             Converts the L<DateTime::Duration> object DURATION into the appropriate format for the interval (years, months, days, hours, minutes, seconds) data type of the current data source. If DURATION is undefined, a L<DateTime::Duration> object, a valid interval keyword (according to L<validate_interval_keyword|/validate_interval_keyword>), or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified.
3844              
3845             =item B<format_time TIMECLOCK>
3846              
3847             Converts the L<Time::Clock> object TIMECLOCK into the appropriate format for the time (hour, minute, second, fractional seconds) data type of the current data source. Fractional seconds are optional, and the useful precision may vary depending on the data source.
3848              
3849             =item B<format_timestamp DATETIME>
3850              
3851             Converts the L<DateTime> object DATETIME into the appropriate format for the timestamp (month, day, year, hour, minute, second, fractional seconds) data type of the current data source. Fractional seconds are optional, and the useful precision may vary depending on the data source.
3852              
3853             =item B<format_timestamp_with_time_zone DATETIME>
3854              
3855             Converts the L<DateTime> object DATETIME into the appropriate format for the timestamp with time zone (month, day, year, hour, minute, second, fractional seconds, time zone) data type of the current data source. Fractional seconds are optional, and the useful precision may vary depending on the data source.
3856              
3857             =item B<parse_bitfield BITS [, SIZE]>
3858              
3859             Parse BITS and return a corresponding L<Bit::Vector> object. If SIZE is not passed, then it defaults to the number of bits in the parsed bit string.
3860              
3861             If BITS is a string of "1"s and "0"s or matches C</^B'[10]+'$/>, then the "1"s and "0"s are parsed as a binary string.
3862              
3863             If BITS is a string of numbers, at least one of which is in the range 2-9, it is assumed to be a decimal (base 10) number and is converted to a bitfield as such.
3864              
3865             If BITS matches any of these regular expressions:
3866              
3867             /^0x/
3868             /^X'.*'$/
3869             /^[0-9a-f]+$/
3870              
3871             it is assumed to be a hexadecimal number and is converted to a bitfield as such.
3872              
3873             Otherwise, undef is returned.
3874              
3875             =item B<parse_boolean STRING>
3876              
3877             Parse STRING and return a boolean value of 1 or 0. STRING should be formatted according to the data source's native "boolean" data type. The default implementation accepts 't', 'true', 'y', 'yes', and '1' values for true, and 'f', 'false', 'n', 'no', and '0' values for false.
3878              
3879             If STRING is a valid boolean keyword (according to L<validate_boolean_keyword|/validate_boolean_keyword>) or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Returns undef if STRING could not be parsed as a valid "boolean" value.
3880              
3881             =item B<parse_date STRING>
3882              
3883             Parse STRING and return a L<DateTime> object. STRING should be formatted according to the data source's native "date" (month, day, year) data type.
3884              
3885             If STRING is a valid date keyword (according to L<validate_date_keyword|/validate_date_keyword>) or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Returns undef if STRING could not be parsed as a valid "date" value.
3886              
3887             =item B<parse_datetime STRING>
3888              
3889             Parse STRING and return a L<DateTime> object. STRING should be formatted according to the data source's native "datetime" (month, day, year, hour, minute, second) data type.
3890              
3891             If STRING is a valid datetime keyword (according to L<validate_datetime_keyword|/validate_datetime_keyword>) or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Returns undef if STRING could not be parsed as a valid "datetime" value.
3892              
3893             =item B<parse_interval STRING [, MODE]>
3894              
3895             Parse STRING and return a L<DateTime::Duration> object. STRING should be formatted according to the data source's native "interval" (years, months, days, hours, minutes, seconds) data type.
3896              
3897             If STRING is a L<DateTime::Duration> object, a valid interval keyword (according to L<validate_interval_keyword|/validate_interval_keyword>), or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Otherwise, undef is returned if STRING could not be parsed as a valid "interval" value.
3898              
3899             This optional MODE argument determines how math is done on duration objects. If defined, the C<end_of_month> setting for each L<DateTime::Duration> object created by this column will have its mode set to MODE. Otherwise, the C<end_of_month> parameter will not be passed to the L<DateTime::Duration> constructor.
3900              
3901             Valid modes are C<wrap>, C<limit>, and C<preserve>. See the documentation for L<DateTime::Duration> for a full explanation.
3902              
3903             =item B<parse_time STRING>
3904              
3905             Parse STRING and return a L<Time::Clock> object. STRING should be formatted according to the data source's native "time" (hour, minute, second, fractional seconds) data type.
3906              
3907             If STRING is a valid time keyword (according to L<validate_time_keyword|/validate_time_keyword>) or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Returns undef if STRING could not be parsed as a valid "time" value.
3908              
3909             =item B<parse_timestamp STRING>
3910              
3911             Parse STRING and return a L<DateTime> object. STRING should be formatted according to the data source's native "timestamp" (month, day, year, hour, minute, second, fractional seconds) data type. Fractional seconds are optional, and the acceptable precision may vary depending on the data source.
3912              
3913             If STRING is a valid timestamp keyword (according to L<validate_timestamp_keyword|/validate_timestamp_keyword>) or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Returns undef if STRING could not be parsed as a valid "timestamp" value.
3914              
3915             =item B<parse_timestamp_with_time_zone STRING>
3916              
3917             Parse STRING and return a L<DateTime> object. STRING should be formatted according to the data source's native "timestamp with time zone" (month, day, year, hour, minute, second, fractional seconds, time zone) data type. Fractional seconds are optional, and the acceptable precision may vary depending on the data source.
3918              
3919             If STRING is a valid timestamp keyword (according to L<validate_timestamp_keyword|/validate_timestamp_keyword>) or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|/keyword_function_calls> is true, then it is returned unmodified. Returns undef if STRING could not be parsed as a valid "timestamp with time zone" value.
3920              
3921             =item B<validate_boolean_keyword STRING>
3922              
3923             Returns true if STRING is a valid keyword for the "boolean" data type of the current data source, false otherwise. The default implementation accepts the values "TRUE" and "FALSE".
3924              
3925             =item B<validate_date_keyword STRING>
3926              
3927             Returns true if STRING is a valid keyword for the "date" (month, day, year) data type of the current data source, false otherwise. The default implementation always returns false.
3928              
3929             =item B<validate_datetime_keyword STRING>
3930              
3931             Returns true if STRING is a valid keyword for the "datetime" (month, day, year, hour, minute, second) data type of the current data source, false otherwise. The default implementation always returns false.
3932              
3933             =item B<validate_interval_keyword STRING>
3934              
3935             Returns true if STRING is a valid keyword for the "interval" (years, months, days, hours, minutes, seconds) data type of the current data source, false otherwise. The default implementation always returns false.
3936              
3937             =item B<validate_time_keyword STRING>
3938              
3939             Returns true if STRING is a valid keyword for the "time" (hour, minute, second, fractional seconds) data type of the current data source, false otherwise. The default implementation always returns false.
3940              
3941             =item B<validate_timestamp_keyword STRING>
3942              
3943             Returns true if STRING is a valid keyword for the "timestamp" (month, day, year, hour, minute, second, fractional seconds) data type of the current data source, false otherwise. The default implementation always returns false.
3944              
3945             =back
3946              
3947             =head1 DEVELOPMENT POLICY
3948              
3949             The L<Rose development policy|Rose/"DEVELOPMENT POLICY"> applies to this, and all C<Rose::*> modules. Please install L<Rose> from CPAN and then run "C<perldoc Rose>" for more information.
3950              
3951             =head1 SUPPORT
3952              
3953             Any L<Rose::DB> questions or problems can be posted to the L<Rose::DB::Object> mailing list. (If the volume ever gets high enough, I'll create a separate list for L<Rose::DB>, but it isn't an issue right now.) To subscribe to the list or view the archives, go here:
3954              
3955             L<http://groups.google.com/group/rose-db-object>
3956              
3957             Although the mailing list is the preferred support mechanism, you can also email the author (see below) or file bugs using the CPAN bug tracking system:
3958              
3959             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Rose-DB>
3960              
3961             There's also a wiki and other resources linked from the Rose project home page:
3962              
3963             L<http://rosecode.org>
3964              
3965             =head1 CONTRIBUTORS
3966              
3967             Kostas Chatzikokolakis, Peter Karman, Brian Duggan, Lucian Dragus, Ask Bjørn Hansen, Sergey Leschenko, Ron Savage
3968              
3969             =head1 AUTHOR
3970              
3971             John C. Siracusa (siracusa@gmail.com)
3972              
3973             =head1 LICENSE
3974              
3975             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is
3976             free software; you can redistribute it and/or modify it under the same terms
3977             as Perl itself.