File Coverage

blib/lib/Otogiri/Plugin/TableInfo/Pg.pm
Criterion Covered Total %
statement 21 125 16.8
branch 0 26 0.0
condition 0 3 0.0
subroutine 7 21 33.3
pod 0 3 0.0
total 28 178 15.7


line stmt bran cond sub pod time code
1             package Otogiri::Plugin::TableInfo::Pg;
2 2     2   42 use 5.008005;
  2         4  
  2         63  
3 2     2   8 use strict;
  2         2  
  2         45  
4 2     2   6 use warnings;
  2         4  
  2         35  
5 2     2   6 use DBI;
  2         3  
  2         86  
6 2     2   8 use DBIx::Inspector;
  2         2  
  2         40  
7 2     2   565 use List::MoreUtils qw(any);
  2         956  
  2         110  
8 2     2   805 use Otogiri::Plugin::TableInfo::PgKeywords;
  2         4  
  2         2746  
9              
10             sub new {
11 0     0 0   my ($class, $table_info) = @_;
12 0           my $keywords = Otogiri::Plugin::TableInfo::PgKeywords->new();
13 0           my $self = {
14             table_info => $table_info,
15             keywords => $keywords,
16             };
17 0           bless $self, $class;
18             }
19              
20              
21             sub show_create_view {
22 0     0 0   my ($self, $view_name) = @_;
23 0           my ($row) = $self->{table_info}->search_by_sql('SELECT definition FROM pg_views WHERE viewname = ?', [$view_name]);
24 0           my $definition = $row->{definition};
25 0 0         if ( defined $definition ) {
26 0           $definition =~ s/\A\s//;
27 0           $definition =~ s/\n//g;
28 0           $definition =~ s/\s{2,}/ /g;
29             }
30 0           return $definition;
31             }
32              
33             sub show_create_table {
34 0     0 0   my ($self, $table_name) = @_;
35 0           my $inspector = DBIx::Inspector->new(dbh => $self->{table_info}->dbh);
36 0           my $table = $inspector->table($table_name);
37              
38 0 0         return if ( !defined $table );
39              
40 0           my @indexes = $self->{table_info}->select('pg_indexes', { tablename => $table->name }, { order_by => 'indexname' });
41 0           my $result = "CREATE TABLE " . $table->name . " (\n";
42 0           $result .= $self->_build_column_defs($table);
43 0           $result .= ");\n";
44 0           $result .= $self->_build_sequence_defs($table);
45 0           $result .= $self->_build_pk_defs($table);
46 0           $result .= $self->_build_uk_defs($table, @indexes);
47 0           $result .= $self->_build_index_defs($table, @indexes);
48 0           $result .= $self->_build_fk_defs($table);
49 0           return $result;
50             }
51              
52             sub _build_column_defs {
53 0     0     my ($self, $table) = @_;
54 0           my $result = "";
55 0           for my $column ( $table->columns() ) {
56 0           my $column_name = $self->{keywords}->quote($column->name); #quote column name if it is need.
57 0           $result .= " " . $column_name . " " . $column->{PG_TYPE};
58 0 0 0       $result .= " DEFAULT " . $column->column_def if ( defined $column->column_def && !$self->_is_sequence_column($column) );
59 0 0         $result .= " NOT NULL" if ( !$column->nullable );
60 0           $result .= ",\n";
61             }
62 0           $result =~ s/,\n\z/\n/;
63 0           return $result;
64             }
65              
66             sub _build_sequence_defs {
67 0     0     my ($self, $table) = @_;
68 0           my $result = "";
69 0           my @sequence_columns = grep { $self->_is_sequence_column($_) } $table->columns();
  0            
70 0           for my $column ( @sequence_columns ) {
71 0           my $sequence_name = $self->_parse_sequence_name($column);
72 0           $result .= $self->_build_create_sequence_defs($sequence_name);
73 0           $result .= "ALTER SEQUENCE " . $sequence_name . " OWNED BY " . $table->name . "." . $column->name . ";\n";
74 0           $result .= "ALTER TABLE ONLY " . $table->name . " ALTER COLUMN " . $column->name . " SET DEFAULT " . $column->column_def . ";\n";
75             }
76 0           return $result;
77             }
78              
79             sub _parse_sequence_name {
80 0     0     my ($self, $column) = @_;
81 0 0         if ( $column->column_def =~ qr/^nextval\('([^']+)'::regclass\)/ ) {
82 0           return $1;
83             }
84 0           return;
85             }
86              
87             sub _build_create_sequence_defs {
88 0     0     my ($self, $sequence_name) = @_;
89 0           my ($row) = $self->{table_info}->select($sequence_name);
90 0           my $result = "CREATE SEQUENCE $sequence_name\n";
91 0           $result .= " START WITH " . $row->{start_value} . "\n";
92 0           $result .= " INCREMENT BY " . $row->{increment_by} . "\n";
93 0 0         if ( $row->{min_value} eq '1' ) {
94 0           $result .= " NO MINVALUE\n";
95             }
96             else {
97 0           $result .= " MINVALUE " . $row->{min_value} . "\n";
98             }
99              
100 0 0         if ( $row->{max_value} eq '9223372036854775807' ) {
101 0           $result .= " NO MAXVALUE\n";
102             }
103             else {
104 0           $result .= " MAXVALUE " . $row->{max_value} . "\n";
105             }
106              
107 0           $result .= " CACHE " . $row->{cache_value} . ";\n";
108 0           return $result;
109             }
110              
111             sub _is_sequence_column {
112 0     0     my ($self, $column) = @_;
113 0           my $default_value = $column->column_def;
114 0 0         return if ( !defined $default_value );
115 0           return $default_value =~ qr/^nextval\(/;
116             }
117              
118             sub _build_pk_defs {
119 0     0     my ($self, $table) = @_;
120 0           my $result = "";
121 0           for my $column ( $table->primary_key() ) {
122 0           $result .= "ALTER TABLE ONLY " . $table->name . "\n";
123 0           $result .= " ADD CONSTRAINT " . $column->{PG_COLUMN} . " PRIMARY KEY (" . $column->name . ");\n";
124             }
125 0           return $result;
126             }
127              
128             sub _build_index_defs {
129 0     0     my ($self, $table, @indexes) = @_;
130              
131 0           my @rows = grep { $_->{indexdef} !~ qr/\ACREATE UNIQUE INDEX/ } @indexes;
  0            
132              
133 0           my $result = '';
134 0           for my $row ( @rows ) {
135 0 0         next if ( $self->_is_pk($table, $row->{indexname}) );
136 0           $result .= $row->{indexdef} . ";\n";
137             }
138 0           return $result;
139             }
140              
141             sub _is_pk {
142 0     0     my ($self, $table, $column_name) = @_;
143 0     0     return any { $_->{PK_NAME} eq $column_name } $table->primary_key();
  0            
144             }
145              
146             sub _build_uk_defs {
147 0     0     my ($self, $table, @indexes) = @_;
148 0 0         my @unique_indexes = grep {
149 0           $_->{indexdef} =~ qr/\ACREATE UNIQUE INDEX/ && !$self->_is_pk($table, $_->{indexname})
150             } @indexes;
151 0           my $result = '';
152 0           for my $indexdef ( map{ $_->{indexdef} } @unique_indexes ) {
  0            
153 0           $result .= $indexdef . ";\n";
154             }
155 0           return $result;
156             }
157              
158             sub _build_fk_defs {
159 0     0     my ($self, $table) = @_;
160 0           my $result = '';
161             # UPDATE_RULE and DELETE_RULE are described in http://search.cpan.org/dist/DBI/DBI.pm#foreign_key_info
162 0           my %rule = (
163             0 => 'CASCADE',
164             1 => 'RESTRICT',
165             2 => 'SET NULL',
166             #3 => 'NO ACTION', # If NO ACTION, ON UPDATE/DELETE statament is not exist.
167             4 => 'SET DEFAULT',
168             );
169              
170 0           for my $fk_info ( $table->fk_foreign_keys() ) {
171 0           $result .= "ALTER TABLE ONLY " . $table->name . "\n";
172 0           $result .= " ADD CONSTRAINT " . $fk_info->fk_name . " FOREIGN KEY (" . $fk_info->fkcolumn_name . ")";
173 0           $result .= " REFERENCES " . $fk_info->pktable_name . "(" . $fk_info->pkcolumn_name . ")";
174 0 0         $result .= " ON UPDATE " . $rule{$fk_info->{UPDATE_RULE}} if ( exists $rule{$fk_info->{UPDATE_RULE}} );
175 0 0         $result .= " ON DELETE " . $rule{$fk_info->{DELETE_RULE}} if ( exists $rule{$fk_info->{DELETE_RULE}} );
176 0 0         $result .= " DEFERRABLE" if ( $fk_info->deferability ne '7' );
177 0           $result .= ";\n";
178             }
179 0           return $result;
180             }
181              
182              
183              
184             1;
185             __END__