File Coverage

blib/lib/MySQL/Diff/Table.pm
Criterion Covered Total %
statement 62 112 55.3
branch 16 48 33.3
condition 1 21 4.7
subroutine 6 20 30.0
pod 14 15 93.3
total 99 216 45.8


line stmt bran cond sub pod time code
1             package MySQL::Diff::Table;
2              
3             =head1 NAME
4              
5             MySQL::Diff::Table - Table Definition Class
6              
7             =head1 SYNOPSIS
8              
9             use MySQL::Diff::Table
10              
11             my $db = MySQL::Diff::Database->new(%options);
12             my $def = $db->def();
13             my $name = $db->name();
14             my $field = $db->field();
15             my $fields = $db->fields(); # %$fields
16             my $primary_key = $db->primary_key();
17             my $indices = $db->indices(); # %$indices
18             my $options = $db->options();
19              
20             my $isfield = $db->isa_field($field);
21             my $isprimary = $db->isa_primary($field);
22             my $isindex = $db->isa_index($field);
23             my $isunique = $db->is_unique($field);
24             my $isfulltext = $db->is_fulltext($field);
25              
26             =head1 DESCRIPTION
27              
28             Parses a table definition into component parts.
29              
30             =cut
31              
32 4     4   56445 use warnings;
  4         13  
  4         106  
33 4     4   16 use strict;
  4         7  
  4         133  
34              
35             our $VERSION = '0.60';
36              
37             # ------------------------------------------------------------------------------
38             # Libraries
39              
40 4     4   17 use Carp qw(:DEFAULT);
  4         7  
  4         442  
41 4     4   366 use MySQL::Diff::Utils qw(debug);
  4         7  
  4         5743  
42              
43             # ------------------------------------------------------------------------------
44              
45             =head1 METHODS
46              
47             =head2 Constructor
48              
49             =over 4
50              
51             =item new( %options )
52              
53             Instantiate the objects, providing the command line options for database
54             access and process requirements.
55              
56             =cut
57              
58             sub new {
59 2     2 1 824 my $class = shift;
60 2         5 my %hash = @_;
61 2         4 my $self = {};
62 2   33     10 bless $self, ref $class || $class;
63              
64 2         9 $self->{$_} = $hash{$_} for(keys %hash);
65              
66 2         22 debug(3,"\nconstructing new MySQL::Diff::Table");
67 2 50       5 croak "MySQL::Diff::Table::new called without def params" unless $self->{def};
68 2         5 $self->_parse;
69 1         4 return $self;
70             }
71              
72             =back
73              
74             =head2 Public Methods
75              
76             Fuller documentation will appear here in time :)
77              
78             =over 4
79              
80             =item * def
81              
82             Returns the table definition as a string.
83              
84             =item * name
85              
86             Returns the name of the current table.
87              
88             =item * field
89              
90             Returns the current field definition of the given field.
91              
92             =item * fields
93              
94             Returns an array reference to a list of fields.
95              
96             =item * primary_key
97              
98             Returns a hash reference to fields used as primary key fields.
99              
100             =item * indices
101              
102             Returns a hash reference to fields used as index fields.
103              
104             =item * options
105              
106             Returns the additional options added to the table definition.
107              
108             =item * isa_field
109              
110             Returns 1 if given field is used in the current table definition, otherwise
111             returns 0.
112              
113             =item * isa_primary
114              
115             Returns 1 if given field is defined as a primary key, otherwise returns 0.
116              
117             =item * isa_index
118              
119             Returns 1 if given field is used as an index field, otherwise returns 0.
120              
121             =item * is_unique
122              
123             Returns 1 if given field is used as unique index field, otherwise returns 0.
124              
125             =item * is_fulltext
126              
127             Returns 1 if given field is used as fulltext index field, otherwise returns 0.
128              
129             =item * is_auto_inc
130              
131             Returns 1 if given field is defined as an auto increment field, otherwise returns 0.
132              
133             =back
134              
135             =cut
136              
137 0     0 1 0 sub def { my $self = shift; return $self->{def}; }
  0         0  
138 0     0 1 0 sub name { my $self = shift; return $self->{name}; }
  0         0  
139 0     0 1 0 sub field { my $self = shift; return $self->{fields}{$_[0]}; }
  0         0  
140 0     0 1 0 sub fields { my $self = shift; return $self->{fields}; }
  0         0  
141 0     0 1 0 sub primary_key { my $self = shift; return $self->{primary_key}; }
  0         0  
142 0     0 1 0 sub indices { my $self = shift; return $self->{indices}; }
  0         0  
143 0     0 1 0 sub options { my $self = shift; return $self->{options}; }
  0         0  
144 0     0 0 0 sub foreign_key { my $self = shift; return $self->{foreign_key}; }
  0         0  
145              
146 0 0 0 0 1 0 sub isa_field { my $self = shift; return $_[0] && $self->{fields}{$_[0]} ? 1 : 0; }
  0         0  
147 0 0 0 0 1 0 sub isa_primary { my $self = shift; return $_[0] && $self->{primary}{$_[0]} ? 1 : 0; }
  0         0  
148 0 0 0 0 1 0 sub isa_index { my $self = shift; return $_[0] && $self->{indices}{$_[0]} ? 1 : 0; }
  0         0  
149 0 0 0 0 1 0 sub is_unique { my $self = shift; return $_[0] && $self->{unique}{$_[0]} ? 1 : 0; }
  0         0  
150 0 0 0 0 1 0 sub is_fulltext { my $self = shift; return $_[0] && $self->{fulltext}{$_[0]} ? 1 : 0; }
  0         0  
151 0 0 0 0 1 0 sub is_auto_inc { my $self = shift; return $_[0] && $self->{auto_inc}{$_[0]} ? 1 : 0; }
  0         0  
152              
153             # ------------------------------------------------------------------------------
154             # Private Methods
155              
156             sub _parse {
157 2     2   3 my $self = shift;
158              
159 2         5 $self->{def} =~ s/`([^`]+)`/$1/gs; # later versions quote names
160 2         10 $self->{def} =~ s/\n+/\n/;
161 2         23 $self->{lines} = [ grep ! /^\s*$/, split /(?=^)/m, $self->{def} ];
162 2         4 my @lines = @{$self->{lines}};
  2         7  
163 2         9 debug(4,"parsing table def '$self->{def}'");
164              
165 2         2 my $name;
166 2 50       14 if ($lines[0] =~ /^\s*create\s+table\s+(\S+)\s+\(\s*$/i) {
167 2         6 $self->{name} = $1;
168 2         7 debug(3,"got table name '$self->{name}'");
169 2         3 shift @lines;
170             } else {
171 0         0 croak "couldn't figure out table name";
172             }
173              
174 2         6 while (@lines) {
175 7         10 $_ = shift @lines;
176 7         49 s/^\s*(.*?),?\s*$/$1/; # trim whitespace and trailing commas
177 7         20 debug(4,"line: [$_]");
178 7 100       32 if (/^PRIMARY\s+KEY\s+(.+)$/) {
179 1         2 my $primary = $1;
180             croak "two primary keys in table '$self->{name}': '$primary', '$self->{primary_key}'\n"
181 1 50       3 if $self->{primary_key};
182 1         4 debug(4,"got primary key $primary");
183 1         2 $self->{primary_key} = $primary;
184 1         11 $primary =~ s/\((.*?)\)/$1/;
185 1         5 $self->{primary}{$_} = 1 for(split(/,/, $primary));
186              
187 1         3 next;
188             }
189            
190 6 50       13 if (/^(?:CONSTRAINT\s+(.*)?)?\s+FOREIGN\s+KEY\s+(.*)$/) {
191 0         0 my ($key, $val) = ($1, $2);
192             croak "foreign key '$key' duplicated in table '$name'\n"
193 0 0       0 if $self->{foreign_key}{$key};
194 0         0 debug(1,"got foreign key $key");
195 0         0 $self->{foreign_key}{$key} = $val;
196 0         0 next;
197             }
198              
199 6 50       18 if (/^(KEY|UNIQUE(?: KEY)?)\s+(\S+?)(?:\s+USING\s+(?:BTREE|HASH|RTREE))?\s*\((.*)\)(?:\s+USING\s+(?:BTREE|HASH|RTREE))?$/) {
200 0         0 my ($type, $key, $val) = ($1, $2, $3);
201             croak "index '$key' duplicated in table '$self->{name}'\n"
202 0 0       0 if $self->{indices}{$key};
203 0         0 $self->{indices}{$key} = $val;
204 0 0       0 $self->{unique}{$key} = 1 if($type =~ /unique/i);
205 0 0       0 debug(4, "got ", defined $self->{unique}{$key} ? 'unique ' : '', "index key '$key': ($val)");
206 0         0 next;
207             }
208              
209 6 50       10 if (/^(FULLTEXT(?:\s+KEY|INDEX)?)\s+(\S+?)\s*\((.*)\)$/) {
210 0         0 my ($type, $key, $val) = ($1, $2, $3);
211             croak "FULLTEXT index '$key' duplicated in table '$self->{name}'\n"
212 0 0       0 if $self->{fulltext}{$key};
213 0         0 $self->{indices}{$key} = $val;
214 0         0 $self->{fulltext}{$key} = 1;
215 0         0 debug(4,"got FULLTEXT index '$key': ($val)");
216 0         0 next;
217             }
218              
219 6 100       12 if (/^\)\s*(.*?);$/) { # end of table definition
220 1         3 $self->{options} = $1;
221 1         3 debug(4,"got table options '$self->{options}'");
222 1         2 last;
223             }
224              
225 5 50       17 if (/^(\S+)\s*(.*)/) {
226 5         13 my ($field, $fdef) = ($1, $2);
227             croak "definition for field '$field' duplicated in table '$self->{name}'\n"
228 5 100       220 if $self->{fields}{$field};
229 4         8 $self->{fields}{$field} = $fdef;
230 4         13 debug(4,"got field def '$field': $fdef");
231 4 50       12 next unless $fdef =~ /\s+AUTO_INCREMENT\b/;
232 0         0 $self->{auto_inc}{$field} = 1;
233 0         0 debug(4,"got AUTO_INCREMENT field '$field'");
234 0         0 next;
235             }
236              
237 0         0 croak "unparsable line in definition for table '$self->{name}':\n$_";
238             }
239              
240             warn "table '$self->{name}' didn't have terminator\n"
241 1 50       3 unless defined $self->{options};
242              
243 1         3 @lines = grep ! m{^/\*!40\d{3} .*? \*/;}, @lines;
244 1         2 @lines = grep ! m{^(SET |DROP TABLE)}, @lines;
245              
246 1 50       10 warn "table '$self->{name}' had trailing garbage:\n", join '', @lines
247             if @lines;
248             }
249              
250             1;
251              
252             __END__