File Coverage

blib/lib/Rose/DB/Pg.pm
Criterion Covered Total %
statement 83 333 24.9
branch 1 176 0.5
condition 1 82 1.2
subroutine 27 63 42.8
pod 10 37 27.0
total 122 691 17.6


line stmt bran cond sub pod time code
1             package Rose::DB::Pg;
2              
3 16     16   118 use strict;
  16         35  
  16         587  
4 16     16   88 no warnings 'uninitialized';
  16         27  
  16         562  
5              
6 16     16   90 use DateTime::Infinite;
  16         30  
  16         425  
7 16     16   8801 use DateTime::Format::Pg;
  16         1252672  
  16         197  
8 16     16   10568 use SQL::ReservedWords::PostgreSQL();
  16         31745  
  16         487  
9              
10 16     16   163 use Rose::DB;
  16         38  
  16         1135  
11              
12             our $VERSION = '0.786'; # overshot version number, freeze until caught up
13              
14             our $DBD_PG_AFTER_380; # set in refine_dbi_foreign_key_info()
15              
16             our $Debug = 0;
17              
18             #
19             # Object data
20             #
21              
22             use Rose::Object::MakeMethods::Generic
23             (
24 16         213 'scalar' =>
25             [
26             qw(sslmode service options)
27             ],
28 16     16   110 );
  16         42  
29              
30             #
31             # Object methods
32             #
33              
34             sub build_dsn
35             {
36 10     10 0 79 my($self_or_class, %args) = @_;
37              
38 10         25 my %info;
39              
40 10   33     118 $info{'dbname'} = $args{'db'} || $args{'database'};
41              
42             @info{qw(host port options service sslmode)} =
43 10         64 @args{qw(host port options service sslmode)};
44              
45             return
46             "dbi:Pg:" .
47 10         33 join(';', map { "$_=$info{$_}" } grep { defined $info{$_} }
  20         155  
  60         130  
48             qw(dbname host port options service sslmode));
49             }
50              
51 34     34 0 147 sub dbi_driver { 'Pg' }
52              
53             sub init_date_handler
54             {
55 0     0 0   my($self) = shift;
56              
57 0           my $parent_class = ref($self)->parent_class;
58 0           my $european_dates = "${parent_class}::european_dates";
59 0           my $server_time_zone = "${parent_class}::server_time_zone";
60              
61 16     16   17282 no strict 'refs';
  16         43  
  16         11077  
62 0 0         my $parser =
    0          
63             DateTime::Format::Pg->new(
64             ($self->$european_dates() ? (european => 1) : ()),
65             ($self->$server_time_zone() ?
66             (server_tz => $self->$server_time_zone()) : ()));
67              
68 0           return $parser;
69             }
70              
71 0     0 0   sub default_implicit_schema { 'public' }
72 0     0 0   sub likes_lowercase_table_names { 1 }
73 0     0 0   sub likes_lowercase_schema_names { 1 }
74 0     0 0   sub likes_lowercase_catalog_names { 1 }
75 0     0 0   sub likes_lowercase_sequence_names { 1 }
76              
77 0     0 0   sub supports_multi_column_count_distinct { 0 }
78 0     0 0   sub supports_arbitrary_defaults_on_insert { 1 }
79 0     0 0   sub supports_select_from_subselect { 1 }
80              
81 0     0 1   sub pg_enable_utf8 { shift->dbh_attribute_boolean('pg_enable_utf8', @_) }
82              
83 0     0 0   sub supports_schema { 1 }
84              
85 0     0 0   sub max_column_name_length { 63 }
86 0     0 0   sub max_column_alias_length { 63 }
87              
88             sub last_insertid_from_sth
89             {
90             #my($self, $sth, $obj) = @_;
91              
92             # PostgreSQL demands that the primary key column not be in the insert
93             # statement at all in order for it to auto-generate a value. The
94             # insert SQL will need to be modified to make this work for
95             # Rose::DB::Object...
96             #if($DBD::Pg::VERSION >= 1.40)
97             #{
98             # my $meta = $obj->meta;
99             # return $self->dbh->last_insert_id(undef, $meta->select_schema, $meta->table, undef);
100             #}
101              
102 0     0 0   return undef;
103             }
104              
105             sub format_select_lock
106             {
107 0     0 0   my($self, $class, $lock, $tables_list) = @_;
108              
109 0 0         $lock = { type => $lock } unless(ref $lock);
110              
111 0 0 0       $lock->{'type'} ||= 'for update' if($lock->{'for_update'});
112              
113 0           my %types =
114             (
115             'for update' => 'FOR UPDATE',
116             'shared' => 'FOR SHARE',
117             );
118              
119 0 0         my $sql = $types{$lock->{'type'}}
120             or Carp::croak "Invalid lock type: $lock->{'type'}";
121              
122 0           my @tables;
123              
124 0 0         if(my $on = $lock->{'on'})
    0          
125             {
126 0           @tables = map { $self->table_sql_from_lock_on_value($class, $_, $tables_list) } @$on;
  0            
127             }
128             elsif(my $lock_tables = $lock->{'tables'})
129             {
130 0           my %map;
131              
132 0 0         if($tables_list)
133             {
134 0           my $tn = 1;
135              
136 0           foreach my $table (@$tables_list)
137             {
138 0           (my $table_key = $table) =~ s/^(["']?)[^.]+\1\.//;
139 0           $map{$table_key} = 't' . $tn++;
140             }
141             }
142              
143             @tables = map
144             {
145 0           ref $_ eq 'SCALAR' ? $$_ :
146 0 0         $self->auto_quote_table_name(defined $map{$_} ? $map{$_} : $_)
    0          
147             }
148             @$lock_tables;
149             }
150              
151 0 0         if(@tables)
152             {
153 0           $sql .= ' OF ' . join(', ', @tables);
154             }
155              
156 0 0         $sql .= ' NOWAIT' if($lock->{'nowait'});
157              
158 0 0         $sql .= ' SKIP LOCKED' if($lock->{'skip_locked'});
159              
160 0           return $sql;
161             }
162              
163             sub parse_datetime
164             {
165 0     0 0   my($self) = shift;
166              
167 0 0         unless(ref $_[0])
168             {
169 16     16   137 no warnings 'uninitialized';
  16         58  
  16         1865  
170 0 0         return DateTime::Infinite::Past->new if($_[0] eq '-infinity');
171 0 0         return DateTime::Infinite::Future->new if($_[0] eq 'infinity');
172             }
173              
174 0           my $method = ref($self)->parent_class . '::parse_datetime';
175              
176 16     16   115 no strict 'refs';
  16         64  
  16         1410  
177 0           $self->$method(@_);
178             }
179              
180             sub parse_timestamp
181             {
182 0     0 0   my($self) = shift;
183              
184 0 0         unless(ref $_[0])
185             {
186 16     16   116 no warnings 'uninitialized';
  16         39  
  16         1532  
187 0 0         return DateTime::Infinite::Past->new if($_[0] eq '-infinity');
188 0 0         return DateTime::Infinite::Future->new if($_[0] eq 'infinity');
189             }
190              
191 0           my $method = ref($self)->parent_class . '::parse_timestamp';
192              
193 16     16   115 no strict 'refs';
  16         46  
  16         1402  
194 0           $self->$method(@_);
195             }
196              
197             sub parse_timestamp_with_time_zone
198             {
199 0     0 0   my($self, $value) = @_;
200              
201 0 0         unless(ref $value)
202             {
203 16     16   124 no warnings 'uninitialized';
  16         31  
  16         1494  
204 0 0         return DateTime::Infinite::Past->new if($value eq '-infinity');
205 0 0         return DateTime::Infinite::Future->new if($value eq 'infinity');
206             }
207              
208 0           my $method = ref($self)->parent_class . '::parse_timestamp_with_time_zone';
209              
210 16     16   118 no strict 'refs';
  16         41  
  16         1051  
211 0           shift->$method(@_);
212             }
213              
214             sub validate_date_keyword
215             {
216 16     16   108 no warnings;
  16         36  
  16         4155  
217 0 0 0 0 1   $_[1] =~ /^(?:(?:now|timeofday)(?:\(\))?|(?:current_(?:date|time(?:stamp)?)
218             |localtime(?:stamp)?)(?:\(\d*\))?|epoch|today|tomorrow|yesterday|)$/xi ||
219             ($_[0]->keyword_function_calls && $_[1] =~ /^\w+\(.*\)$/);
220             }
221              
222             sub validate_time_keyword
223             {
224 16     16   126 no warnings;
  16         33  
  16         3382  
225 0 0 0 0 1   $_[1] =~ /^(?:(?:now|timeofday)(?:\(\))?|(?:current_(?:date|time(?:stamp)?)
226             |localtime(?:stamp)?)(?:\(\d*\))?|allballs)$/xi ||
227             ($_[0]->keyword_function_calls && $_[1] =~ /^\w+\(.*\)$/);
228             }
229              
230             sub validate_timestamp_keyword
231             {
232 16     16   121 no warnings;
  16         30  
  16         4468  
233 0 0 0 0 1   $_[1] =~ /^(?:(?:now|timeofday)(?:\(\))?|(?:current_(?:date|time(?:stamp)?)
234             |localtime(?:stamp)?)(?:\(\d*\))?|-?infinity|epoch|today|tomorrow|yesterday|allballs)$/xi ||
235             ($_[0]->keyword_function_calls && $_[1] =~ /^\w+\(.*\)$/);
236              
237             }
238              
239             *validate_datetime_keyword = \&validate_timestamp_keyword;
240              
241             sub server_time_zone
242             {
243 0     0 1   my($self) = shift;
244              
245 0 0         $self->{'date_handler'} = undef if(@_);
246              
247 0           my $method = ref($self)->parent_class . '::server_time_zone';
248              
249 16     16   128 no strict 'refs';
  16         35  
  16         1426  
250 0           $self->$method(@_);
251             }
252              
253             sub european_dates
254             {
255 0     0 1   my($self) = shift;
256              
257 0 0         $self->{'date_handler'} = undef if(@_);
258              
259 0           my $method = ref($self)->parent_class . '::european_dates';
260              
261 16     16   116 no strict 'refs';
  16         33  
  16         11068  
262 0           $self->$method(@_);
263             }
264              
265             sub parse_array
266             {
267 0     0 1   my($self) = shift;
268              
269 0 0         return $_[0] if(ref $_[0]);
270 0 0         return [ @_ ] if(@_ > 1);
271              
272 0           my $val = $_[0];
273              
274 0 0         return undef unless(defined $val);
275              
276 0           $val =~ s/^ (?:\[.+\]=)? \{ (.*) \} $/$1/sx;
277              
278 0           my @array;
279              
280 0           while($val =~ s/(?:"((?:[^"\\]+|\\.)*)"|([^",]+))(?:,|$)//)
281             {
282 0 0         my($item) = map { $_ eq 'NULL' ? undef : $_ } (defined $1 ? $1 : $2);
  0 0          
283 0 0         $item =~ s{\\(.)}{$1}g if(defined $item);
284 0           push(@array, $item);
285             }
286              
287 0           return \@array;
288             }
289              
290             sub format_array
291             {
292 0     0 1   my($self) = shift;
293              
294 0 0 0       return undef unless(ref $_[0] || defined $_[0]);
295              
296 0 0         my @array = (ref $_[0]) ? @{$_[0]} : @_;
  0            
297              
298             return '{' . join(',', map
299             {
300 0 0         if(!defined $_)
  0 0          
    0          
301             {
302 0           'NULL'
303             }
304             elsif(/^[-+]?\d+(?:\.\d*)?$/)
305             {
306 0           $_
307             }
308             elsif(ref($_) eq 'ARRAY')
309             {
310 0           $self->format_array($_);
311             }
312             else
313             {
314 0           s/\\/\\\\/g;
315 0           s/"/\\"/g;
316 0           qq("$_")
317             }
318             } @array) . '}';
319             }
320              
321             sub parse_interval
322             {
323 0     0 1   my($self, $value, $end_of_month_mode) = @_;
324              
325 0 0 0       if(!defined $value || UNIVERSAL::isa($value, 'DateTime::Duration') ||
      0        
      0        
      0        
326             $self->validate_interval_keyword($value) ||
327             ($self->keyword_function_calls && $value =~ /^\w+\(.*\)$/))
328             {
329 0           return $value;
330             }
331              
332 0           my($dt_duration, $error);
333              
334             TRY:
335             {
336 0           local $@;
  0            
337 0           eval { $dt_duration = $self->date_handler->parse_interval($value) };
  0            
338 0           $error = $@;
339             }
340              
341 0           my $method = ref($self)->parent_class . '::parse_interval';
342              
343 16     16   136 no strict 'refs';
  16         56  
  16         7422  
344 0 0         return $self->$method($value, $end_of_month_mode) if($error);
345              
346 0 0 0       if(defined $end_of_month_mode && $dt_duration)
347             {
348             # XXX: There is no mutator for end_of_month_mode, so I'm being evil
349             # XXX: and setting it directly. Blah.
350 0           $dt_duration->{'end_of_month'} = $end_of_month_mode;
351             }
352              
353 0           return $dt_duration;
354             }
355              
356             BEGIN
357             {
358 16     16   141 require DateTime::Format::Pg;
359              
360             # Handle DateTime::Format::Pg bug
361             # http://rt.cpan.org/Public/Bug/Display.html?id=18487
362 16 50       130 if($DateTime::Format::Pg::VERSION < 0.11)
363             {
364             *format_interval = sub
365             {
366 0         0 my($self, $dur) = @_;
367 0 0 0     0 return $dur if(!defined $dur || $self->validate_interval_keyword($dur) ||
      0        
      0        
368             ($self->keyword_function_calls && $dur =~ /^\w+\(.*\)$/));
369 0         0 my $val = $self->date_handler->format_interval($dur);
370              
371 0         0 $val =~ s/(\S+e\S+) seconds/sprintf('%f seconds', $1)/e;
  0         0  
372 0         0 return $val;
373 0         0 };
374             }
375             else
376             {
377             *format_interval = sub
378             {
379 0     0   0 my($self, $dur) = @_;
380 0 0 0     0 return $dur if(!defined $dur || $self->validate_interval_keyword($dur) ||
      0        
      0        
381             ($self->keyword_function_calls && $dur =~ /^\w+\(.*\)$/));
382 0         0 return $self->date_handler->format_interval($dur);
383 16         8769 };
384             }
385             }
386              
387             sub next_value_in_sequence
388             {
389 0     0 1   my($self, $sequence_name) = @_;
390              
391 0 0         my $dbh = $self->dbh or return undef;
392              
393 0           my($value, $error);
394              
395             TRY:
396             {
397 0           local $@;
  0            
398              
399             eval
400 0           {
401 0           local $dbh->{'PrintError'} = 0;
402 0           local $dbh->{'RaiseError'} = 1;
403 0           my $sth = $dbh->prepare(qq(SELECT nextval(?)));
404 0           $sth->execute($sequence_name);
405 0           $value = ${$sth->fetchrow_arrayref}[0];
  0            
406             };
407              
408 0           $error = $@;
409             }
410              
411 0 0         if($error)
412             {
413 0           $self->error("Could not get the next value in the sequence '$sequence_name' - $error");
414 0           return undef;
415             }
416              
417 0           return $value;
418             }
419              
420             sub current_value_in_sequence
421             {
422 0     0 0   my($self, $sequence_name) = @_;
423              
424 0 0         my $dbh = $self->dbh or return undef;
425              
426 0           my($value, $error);
427              
428             TRY:
429             {
430 0           local $@;
  0            
431              
432             eval
433 0           {
434 0           local $dbh->{'PrintError'} = 0;
435 0           local $dbh->{'RaiseError'} = 1;
436 0           my $name = $dbh->quote_identifier($sequence_name);
437 0           my $sth = $dbh->prepare(qq(SELECT last_value FROM $name));
438 0           $sth->execute;
439 0           $value = ${$sth->fetchrow_arrayref}[0];
  0            
440             };
441              
442 0           $error = $@;
443             }
444              
445 0 0         if($error)
446             {
447 0           $self->error("Could not get the current value in the sequence '$sequence_name' - $error");
448 0           return undef;
449             }
450              
451 0           return $value;
452             }
453              
454 0 0   0 0   sub sequence_exists { defined shift->current_value_in_sequence(@_) ? 1 : 0 }
455              
456 0     0 0   sub use_auto_sequence_name { 1 }
457              
458             sub auto_sequence_name
459             {
460 0     0 0   my($self, %args) = @_;
461              
462 0           my $table = $args{'table'};
463 0 0         Carp::croak "Missing table argument" unless(defined $table);
464              
465 0           my $column = $args{'column'};
466 0 0         Carp::croak "Missing column argument" unless(defined $column);
467              
468 0           return lc "${table}_${column}_seq";
469             }
470              
471             *is_reserved_word = \&SQL::ReservedWords::PostgreSQL::is_reserved;
472              
473             #
474             # DBI introspection
475             #
476              
477             sub refine_dbi_column_info
478             {
479 0     0 0   my($self, $col_info, $meta) = @_;
480              
481             # Save default value
482 0           my $default = $col_info->{'COLUMN_DEF'};
483              
484 0           my $method = ref($self)->parent_class . '::refine_dbi_column_info';
485              
486 16     16   125 no strict 'refs';
  16         37  
  16         4325  
487 0           $self->$method($col_info);
488              
489              
490 0 0         if(defined $default)
491             {
492             # Set sequence name key, if present
493 0 0         if($default =~ /^nextval\(\(?'((?:''|[^']+))'::\w+/)
    0          
494             {
495 0 0         $col_info->{'rdbo_default_value_sequence_name'} =
496             $self->likes_lowercase_sequence_names ? lc $1 : $1;
497              
498 0 0         if($meta)
499             {
500 0           my $seq = $col_info->{'rdbo_default_value_sequence_name'};
501              
502 0           my $implicit_schema = $self->default_implicit_schema;
503              
504             # Strip off default implicit schema unless a schema is explicitly
505             # specified in the RDBO metadata object.
506 0 0 0       if(defined $seq && defined $implicit_schema && !defined $meta->schema)
      0        
507             {
508 0           $seq =~ s/^$implicit_schema\.//;
509             }
510              
511 0           $col_info->{'rdbo_default_value_sequence_name'} = $self->unquote_column_name($seq);
512              
513             # Pg returns serial columns as integer or bigint
514 0 0 0       if($col_info->{'TYPE_NAME'} eq 'integer' ||
515             $col_info->{'TYPE_NAME'} eq 'bigint')
516             {
517 0           my $db = $meta->db;
518              
519             my $auto_seq =
520             $db->auto_sequence_name(table => $meta->table,
521 0           column => $col_info->{'COLUMN_NAME'});
522              
523             # Use schema prefix on auto-generated name if necessary
524 0 0         if($seq =~ /^[^.]+\./)
525             {
526 0           my $schema = $meta->select_schema($db);
527 0 0         $auto_seq = "$schema.$auto_seq" if($schema);
528             }
529              
530 16     16   126 no warnings 'uninitialized';
  16         48  
  16         5167  
531 0 0         if(lc $seq eq lc $auto_seq)
532             {
533             $col_info->{'TYPE_NAME'} =
534 0 0         $col_info->{'TYPE_NAME'} eq 'integer' ? 'serial' : 'bigserial';
535             }
536             }
537             }
538             }
539             elsif($default =~ /^NULL::[\w ]+$/)
540             {
541             # RT 64331: https://rt.cpan.org/Ticket/Display.html?id=64331
542 0           $col_info->{'COLUMN_DEF'} = undef;
543             }
544             }
545              
546 0           my $type_name = $col_info->{'TYPE_NAME'};
547              
548             # Pg has some odd/different names for types. Convert them to standard forms.
549 0 0         if($type_name eq 'character varying')
    0          
    0          
    0          
    0          
    0          
550             {
551 0           $col_info->{'TYPE_NAME'} = 'varchar';
552             }
553             elsif($type_name eq 'bit')
554             {
555 0           $col_info->{'TYPE_NAME'} = 'bits';
556             }
557             elsif($type_name eq 'real')
558             {
559 0           $col_info->{'TYPE_NAME'} = 'float';
560             }
561             elsif($type_name eq 'time without time zone')
562             {
563 0           $col_info->{'TYPE_NAME'} = 'time';
564 0           $col_info->{'pg_type'} =~ /^time(?:\((\d+)\))? without time zone$/i;
565 0   0       $col_info->{'TIME_SCALE'} = $1 || 0;
566             }
567             elsif($type_name eq 'double precision')
568             {
569 0           $col_info->{'COLUMN_SIZE'} = undef;
570             }
571             elsif($type_name eq 'money')
572             {
573 0           $col_info->{'COLUMN_SIZE'} = undef;
574             }
575              
576             # Pg does not populate COLUMN_SIZE correctly for bit fields, so
577             # we have to extract the number of bits from pg_type.
578 0 0         if($col_info->{'pg_type'} =~ /^bit\((\d+)\)$/)
579             {
580 0           $col_info->{'COLUMN_SIZE'} = $1;
581             }
582              
583             # Extract precision and scale from numeric types
584 0 0         if($col_info->{'pg_type'} =~ /^numeric/i)
585             {
586 16     16   125 no warnings 'uninitialized';
  16         43  
  16         4678  
587              
588 0 0         if($col_info->{'COLUMN_SIZE'} =~ /^(\d+),(\d+)$/)
    0          
589             {
590 0           $col_info->{'COLUMN_SIZE'} = $1;
591 0           $col_info->{'DECIMAL_DIGITS'} = $2;
592             }
593             elsif($col_info->{'pg_type'} =~ /^numeric\((\d+),(\d+)\)$/i)
594             {
595 0           $col_info->{'COLUMN_SIZE'} = $2;
596 0           $col_info->{'DECIMAL_DIGITS'} = $1;
597             }
598             }
599              
600             # Treat custom types that look like enums as enums
601 0 0 0       if(ref $col_info->{'pg_enum_values'} && @{$col_info->{'pg_enum_values'}})
  0            
602             {
603 0           $col_info->{'TYPE_NAME'} = 'enum';
604 0           $col_info->{'RDBO_ENUM_VALUES'} = $col_info->{'pg_enum_values'};
605 0           $col_info->{'RDBO_DB_TYPE'} = $col_info->{'pg_type'};
606             }
607              
608             # We currently treat all arrays the same, regardless of what they are
609             # arrays of: integer, character, float, etc. So we covert TYPE_NAMEs
610             # like 'integer[]' into 'array'
611 0 0         if($col_info->{'TYPE_NAME'} =~ /^\w.*\[\]$/)
612             {
613 0           $col_info->{'TYPE_NAME'} = 'array';
614             }
615              
616 0           return;
617             }
618              
619             sub parse_dbi_column_info_default
620             {
621 0     0 0   my($self, $string, $col_info) = @_;
622              
623 16     16   154 no warnings 'uninitialized';
  16         60  
  16         11422  
624 0           local $_ = $string;
625              
626 0           my $pg_vers = $self->dbh->{'pg_server_version'};
627              
628             # Example: q(B'00101'::"bit")
629 0 0 0       if(/^B'([01]+)'::(?:bit|"bit")$/ && $col_info->{'TYPE_NAME'} eq 'bit')
    0 0        
    0          
    0          
630             {
631 0           return $1;
632             }
633             # Example: 922337203685::bigint
634             elsif(/^(.+)::"?bigint"?$/i && $col_info->{'TYPE_NAME'} eq 'bigint')
635             {
636 0           return $1;
637             }
638             # TODO: http://rt.cpan.org/Ticket/Display.html?id=35462
639             # Example: '{foo,"\\"bar,",baz}'::text[]
640             # ...
641             # Example: 'value'::character varying
642             # Example: ('now'::text)::timestamp(0)
643             elsif(/^\(*'(.*)'::.+$/)
644             {
645 0           my $default = $1;
646              
647             # Single quotes are backslash-escaped, but PostgreSQL 8.1 and
648             # later uses doubled quotes '' instead. Strangely, I see
649             # doubled quotes in 8.0.x as well...
650 0 0 0       if($pg_vers >= 80000 && index($default, q('')) > 0)
    0 0        
651             {
652 0           $default =~ s/''/'/g;
653             }
654             elsif($pg_vers < 80100 && index($default, q(\')) > 0)
655             {
656 0           $default = $1;
657 0           $default =~ s/\\'/'/g;
658             }
659              
660 0           return $default;
661             }
662             # Handle sequence-based defaults elsewhere
663             elsif(/^nextval\(/)
664             {
665 0           return undef;
666             }
667              
668 0           return $string;
669             }
670              
671             sub refine_dbi_foreign_key_info
672             {
673 0     0 0   my($self, $fk_info) = @_;
674              
675 0 0 0       if(!defined $DBD_PG_AFTER_380 && defined $DBD::Pg::VERSION)
676             {
677 0 0 0       $DBD_PG_AFTER_380 = ($DBD::Pg::VERSION =~ /^(\d+)\.(\d+)/ && ($1 >=3 && $2 >= 8)) ? 1 : 0;
678             }
679              
680 0 0         if($DBD_PG_AFTER_380)
681             {
682 0           $fk_info->{'FK_TABLE_CAT'} = undef;
683 0           $fk_info->{'UK_TABLE_CAT'} = undef;
684             }
685             }
686              
687             sub list_tables
688             {
689 0     0 0   my($self, %args) = @_;
690              
691 0 0         my $types = $args{'include_views'} ? "'TABLE','VIEW'" : 'TABLE';
692 0           my @tables;
693              
694 0           my $schema = $self->schema;
695 0 0         $schema = $self->default_implicit_schema unless(defined $schema);
696              
697 0           my $error;
698              
699             TRY:
700             {
701 0           local $@;
  0            
702              
703             eval
704 0           {
705 0 0         my $dbh = $self->dbh or die $self->error;
706              
707 0           local $dbh->{'RaiseError'} = 1;
708 0           local $dbh->{'FetchHashKeyName'} = 'NAME';
709              
710 0           my $sth = $dbh->table_info($self->catalog, $schema, '', $types,
711             { noprefix => 1, pg_noprefix => 1 });
712              
713 0           $sth->execute;
714              
715 0           while(my $table_info = $sth->fetchrow_hashref)
716             {
717 0           push(@tables, $self->unquote_table_name($table_info->{'TABLE_NAME'}));
718             }
719             };
720              
721 0           $error = $@;
722             }
723              
724 0 0         if($error)
725             {
726 0           Carp::croak "Could not list tables from ", $self->dsn, " - $error";
727             }
728              
729 0 0         return wantarray ? @tables : \@tables;
730             }
731              
732             # sub list_tables
733             # {
734             # my($self) = shift;
735             #
736             # my @tables;
737             #
738             # my $schema = $self->schema;
739             # $schema = $db->default_implicit_schema unless(defined $schema);
740             #
741             # if($DBD::Pg::VERSION >= 1.31)
742             # {
743             # @tables = $self->dbh->tables($self->catalog, $schema, '', 'TABLE',
744             # { noprefix => 1, pg_noprefix => 1 });
745             # }
746             # else
747             # {
748             # @tables = $dbh->tables;
749             # }
750             # }
751             #
752             # return wantarray ? @tables : \@tables;
753             # }
754              
755             1;
756              
757             __END__
758              
759             =head1 NAME
760              
761             Rose::DB::Pg - PostgreSQL driver class for Rose::DB.
762              
763             =head1 SYNOPSIS
764              
765             use Rose::DB;
766              
767             Rose::DB->register_db(
768             domain => 'development',
769             type => 'main',
770             driver => 'Pg',
771             database => 'dev_db',
772             host => 'localhost',
773             username => 'devuser',
774             password => 'mysecret',
775             server_time_zone => 'UTC',
776             european_dates => 1,
777             );
778              
779             Rose::DB->default_domain('development');
780             Rose::DB->default_type('main');
781             ...
782              
783             $db = Rose::DB->new; # $db is really a Rose::DB::Pg-derived object
784             ...
785              
786             =head1 DESCRIPTION
787              
788             L<Rose::DB> blesses objects into a class derived from L<Rose::DB::Pg> when the L<driver|Rose::DB/driver> is "pg". This mapping of driver names to class names is configurable. See the documentation for L<Rose::DB>'s L<new()|Rose::DB/new> and L<driver_class()|Rose::DB/driver_class> methods for more information.
789              
790             This class cannot be used directly. You must use L<Rose::DB> and let its L<new()|Rose::DB/new> method return an object blessed into the appropriate class for you, according to its L<driver_class()|Rose::DB/driver_class> mappings.
791              
792             Only the methods that are new or have different behaviors than those in L<Rose::DB> are documented here. See the L<Rose::DB> documentation for the full list of methods.
793              
794             =head1 OBJECT METHODS
795              
796             =over 4
797              
798             =item B<european_dates [BOOL]>
799              
800             Get or set the boolean value that determines whether or not dates are assumed to be in european dd/mm/yyyy format. The default is to assume US mm/dd/yyyy format (because this is the default for PostgreSQL).
801              
802             This value will be passed to L<DateTime::Format::Pg> as the value of the C<european> parameter in the call to the constructor C<new()>. This L<DateTime::Format::Pg> object is used by L<Rose::DB::Pg> to parse and format date-related column values in methods like L<parse_date|Rose::DB/parse_date>, L<format_date|Rose::DB/format_date>, etc.
803              
804             =item B<next_value_in_sequence SEQUENCE>
805              
806             Advance the sequence named SEQUENCE and return the new value. Returns undef if there was an error.
807              
808             =item B<server_time_zone [TZ]>
809              
810             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".
811              
812             This value will be passed to L<DateTime::Format::Pg> as the value of the C<server_tz> parameter in the call to the constructor C<new()>. This L<DateTime::Format::Pg> object is used by L<Rose::DB::Pg> to parse and format date-related column values in methods like L<parse_date|Rose::DB/parse_date>, L<format_date|Rose::DB/format_date>, etc.
813              
814             See the L<DateTime::TimeZone> documentation for acceptable values of TZ.
815              
816             =item B<pg_enable_utf8 [BOOL]>
817              
818             Get or set the L<pg_enable_utf8|DBD::Pg/pg_enable_utf8> database handle attribute. This is set directly on the L<dbh|Rose::DB/dbh>, if one exists. Otherwise, it will be set when the L<dbh|Rose::DB/dbh> is created. If no value for this attribute is defined (the default) then it will not be set when the L<dbh|Rose::DB/dbh> is created, deferring instead to whatever default value L<DBD::Pg> chooses.
819              
820             Returns the value of this attribute in the L<dbh|Rose::DB/dbh>, if one exists, or the value that will be set when the L<dbh|Rose::DB/dbh> is next created.
821              
822             See the L<DBD::Pg|DBD::Pg/pg_enable_utf8> documentation to learn more about this attribute.
823              
824             =item B<sslmode [MODE]>
825              
826             Get or set the SSL mode of the connection. Valid values for MODE are C<disable>, C<allow>, C<prefer>, and C<require>. This attribute is used to build the L<DBI> L<dsn|Rose::DB/dsn>. Setting it has no effect until the next L<connect|Rose::DB/connect>ion. See the L<DBD::Pg|DBD::Pg/connect> documentation to learn more about this attribute.
827              
828             =back
829              
830             =head2 Value Parsing and Formatting
831              
832             =over 4
833              
834             =item B<format_array ARRAYREF | LIST>
835              
836             Given a reference to an array or a list of values, return a string formatted according to the rules of PostgreSQL's "ARRAY" column type. Undef is returned if ARRAYREF points to an empty array or if LIST is not passed.
837              
838             =item B<format_interval DURATION>
839              
840             Given a L<DateTime::Duration> object, return a string formatted according to the rules of PostgreSQL's "INTERVAL" column type. If DURATION is undefined, a L<DateTime::Duration> object, a valid interval keyword (according to L<validate_interval_keyword|Rose::DB/validate_interval_keyword>), or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|Rose::DB/keyword_function_calls> is true, then it is returned unmodified.
841              
842             =item B<parse_array STRING>
843              
844             Parse STRING and return a reference to an array. STRING should be formatted according to PostgreSQL's "ARRAY" data type. Undef is returned if STRING is undefined.
845              
846             =item B<parse_interval STRING>
847              
848             Parse STRING and return a L<DateTime::Duration> object. STRING should be formatted according to the PostgreSQL native "interval" (years, months, days, hours, minutes, seconds) data type.
849              
850             If STRING is a L<DateTime::Duration> object, a valid interval keyword (according to L<validate_interval_keyword|Rose::DB/validate_interval_keyword>), or if it looks like a function call (matches C</^\w+\(.*\)$/>) and L<keyword_function_calls|Rose::DB/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.
851              
852             =item B<validate_date_keyword STRING>
853              
854             Returns true if STRING is a valid keyword for the PostgreSQL "date" data type. Valid (case-insensitive) date keywords are:
855              
856             current_date
857             epoch
858             now
859             now()
860             today
861             tomorrow
862             yesterday
863              
864             The keywords are case sensitive. Any string that looks like a function call (matches C</^\w+\(.*\)$/>) is also considered a valid date keyword if L<keyword_function_calls|Rose::DB/keyword_function_calls> is true.
865              
866             =item B<validate_datetime_keyword STRING>
867              
868             Returns true if STRING is a valid keyword for the PostgreSQL "datetime" data type, false otherwise. Valid (case-insensitive) datetime keywords are:
869              
870             -infinity
871             allballs
872             current_date
873             current_time
874             current_time()
875             current_timestamp
876             current_timestamp()
877             epoch
878             infinity
879             localtime
880             localtime()
881             localtimestamp
882             localtimestamp()
883             now
884             now()
885             timeofday()
886             today
887             tomorrow
888             yesterday
889              
890             The keywords are case sensitive. Any string that looks like a function call (matches C</^\w+\(.*\)$/>) is also considered a valid datetime keyword if L<keyword_function_calls|Rose::DB/keyword_function_calls> is true.
891              
892             =item B<validate_time_keyword STRING>
893              
894             Returns true if STRING is a valid keyword for the PostgreSQL "time" data type, false otherwise. Valid (case-insensitive) timestamp keywords are:
895              
896             allballs
897             current_time
898             current_time()
899             localtime
900             localtime()
901             now
902             now()
903             timeofday()
904              
905             The keywords are case sensitive. Any string that looks like a function call (matches C</^\w+\(.*\)$/>) is also considered a valid timestamp keyword if L<keyword_function_calls|Rose::DB/keyword_function_calls> is true.
906              
907             =item B<validate_timestamp_keyword STRING>
908              
909             Returns true if STRING is a valid keyword for the PostgreSQL "timestamp" data type, false otherwise. Valid (case-insensitive) timestamp keywords are:
910              
911             -infinity
912             allballs
913             current_date
914             current_time
915             current_time()
916             current_timestamp
917             current_timestamp()
918             epoch
919             infinity
920             localtime
921             localtime()
922             localtimestamp
923             localtimestamp()
924             now
925             now()
926             timeofday()
927             today
928             tomorrow
929             yesterday
930              
931             The keywords are case sensitive. Any string that looks like a function call (matches C</^\w+\(.*\)$/>) is also considered a valid timestamp keyword if L<keyword_function_calls|Rose::DB/keyword_function_calls> is true.
932              
933             =back
934              
935             =head1 AUTHOR
936              
937             John C. Siracusa (siracusa@gmail.com)
938              
939             =head1 LICENSE
940              
941             Copyright (c) 2010 by John C. Siracusa. All rights reserved. This program is
942             free software; you can redistribute it and/or modify it under the same terms
943             as Perl itself.