Commit | Line | Data |
6b0e47fc |
1 | package DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault; |
2 | |
3 | use strict; |
4 | use warnings; |
942bd5e0 |
5 | use mro 'c3'; |
6b0e47fc |
6 | |
eeeab540 |
7 | our $VERSION = '0.07012'; |
6b0e47fc |
8 | |
9 | =head1 NAME |
10 | |
dc744c9d |
11 | DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault -- Loader::DBI |
12 | Component to parse quoted default constants and functions |
6b0e47fc |
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 | |
41968729 |
33 | # remove Pg typecasts (e.g. 'foo'::character varying) too |
34 | if ($def =~ /^["'](.*?)['"](?:::[\w\s]+)?\z/) { |
6b0e47fc |
35 | $info->{default_value} = $1; |
36 | } |
96336646 |
37 | # Some DBs (eg. Pg) put parenthesis around negative number defaults |
38 | elsif ($def =~ /^\((-?\d.*?)\)(?:::[\w\s]+)?\z/) { |
39 | $info->{default_value} = $1; |
40 | } |
c99b3e2b |
41 | elsif ($def =~ /^(-?\d.*?)(?:::[\w\s]+)?\z/) { |
96336646 |
42 | $info->{default_value} = $1; |
43 | } |
44 | elsif ($def =~ /^NULL:?/i) { |
87a43db1 |
45 | my $null = 'null'; |
46 | $info->{default_value} = \$null; |
96336646 |
47 | } |
6b0e47fc |
48 | else { |
96336646 |
49 | $info->{default_value} = \$def; |
6b0e47fc |
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 |