File Coverage

blib/lib/Rose/DB/Pg.pm
Criterion Covered Total %
statement 91 345 26.3
branch 3 180 1.6
condition 1 85 1.1
subroutine 29 66 43.9
pod 11 39 28.2
total 135 715 18.8


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