lib/DBIx/Class/Schema/Loader/DBI/Component/QuotedDefault.pm

   1 package DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault;
   2
   3 use strict;
   4 use warnings;
   5 use base 'DBIx::Class::Schema::Loader::DBI';
   6 use mro 'c3';
   7
   8 our $VERSION = '0.07047';
   9
  10 =head1 NAME
  11
  12 DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault -- Loader::DBI
  13 Component to parse quoted default constants and functions
  14
  15 =head1 DESCRIPTION
  16
  17 If C<COLUMN_DEF> from L<DBI/column_info> returns character constants quoted,
  18 then we need to remove the quotes. This also allows distinguishing between
  19 default functions without information schema introspection.
  20
  21 =cut
  22
  23 sub _columns_info_for {
  24     my $self    = shift;
  25     my ($table) = @_;
  26
  27     my $result = $self->next::method(@_);
  28
  29     while (my ($col, $info) = each %$result) {
  30         if (my $def = $info->{default_value}) {
  31             $def =~ s/^\s+//;
  32             $def =~ s/\s+\z//;
  33
  34 # remove Pg typecasts (e.g. 'foo'::character varying) too
  35             if ($def =~ /^["'](.*?)['"](?:::[\w\s]+)?\z/) {
  36                 $info->{default_value} = $1;
  37             }
  38 # Some DBs (eg. Pg) put parenthesis around negative number defaults
  39             elsif ($def =~ /^\((-?\d.*?)\)(?:::[\w\s]+)?\z/) {
  40                 $info->{default_value} = $1;
  41             }
  42             elsif ($def =~ /^(-?\d.*?)(?:::[\w\s]+)?\z/) {
  43                 $info->{default_value} = $1;
  44             }
  45             elsif ($def =~ /^NULL:?/i) {
  46                 my $null = 'null';
  47                 $info->{default_value} = \$null;
  48             }
  49             else {
  50                 $info->{default_value} = \$def;
  51             }
  52         }
  53     }
  54
  55     return $result;
  56 }
  57
  58 1;
  59
  60 =head1 SEE ALSO
  61
  62 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
  63 L<DBIx::Class::Schema::Loader::DBI>
  64
  65 =head1 AUTHORS
  66
  67 See L<DBIx::Class::Schema::Loader/AUTHORS>.
  68
  69 =head1 LICENSE
  70
  71 This library is free software; you can redistribute it and/or modify it under
  72 the same terms as Perl itself.
  73
  74 =cut