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