File Coverage

blib/lib/Alzabo/Create/Table.pm
Criterion Covered Total %
statement 21 221 9.5
branch 0 74 0.0
condition 0 15 0.0
subroutine 7 29 24.1
pod 19 22 86.3
total 47 361 13.0


line stmt bran cond sub pod time code
1             package Alzabo::Create::Table;
2              
3 9     9   515 use strict;
  9         19  
  9         427  
4 9     9   45 use vars qw($VERSION);
  9         18  
  9         355  
5              
6 9     9   48 use Alzabo::Create;
  9         15  
  9         374  
7 9     9   44 use Alzabo::Exceptions ( abbr => 'params_exception' );
  9         17  
  9         73  
8              
9 9     9   46 use Params::Validate qw( :all );
  9         16  
  9         2479  
10             Params::Validate::validation_options
11             ( on_fail => sub { params_exception join '', @_ } );
12              
13 9     9   53 use Tie::IxHash;
  9         15  
  9         249  
14              
15 9     9   46 use base qw(Alzabo::Table);
  9         14  
  9         40485  
16              
17             $VERSION = 2.0;
18              
19             1;
20              
21             sub new
22             {
23 0     0 1   my $proto = shift;
24 0   0       my $class = ref $proto || $proto;
25              
26 0           validate( @_, { schema => { isa => 'Alzabo::Create::Schema' },
27             name => { type => SCALAR },
28             attributes => { type => ARRAYREF,
29             optional => 1 },
30             comment => { type => UNDEF | SCALAR,
31             default => '' },
32             } );
33 0           my %p = @_;
34              
35 0           my $self = bless {}, $class;
36              
37 0           $self->{schema} = $p{schema};
38              
39 0           $self->set_name($p{name});
40              
41 0           $self->{columns} = Tie::IxHash->new;
42 0           $self->{pk} = [];
43 0           $self->{indexes} = Tie::IxHash->new;
44              
45 0           my %attr;
46 0           tie %{ $self->{attributes} }, 'Tie::IxHash';
  0            
47              
48 0           $self->set_attributes( @{ $p{attributes} } );
  0            
49              
50 0           $self->set_comment( $p{comment} );
51              
52             # Setting this prevents run time type errors.
53 0           $self->{fk} = {};
54              
55 0           return $self;
56             }
57              
58             sub set_name
59             {
60 0     0 1   my $self = shift;
61              
62 0           validate_pos( @_, { type => SCALAR } );
63 0           my $name = shift;
64              
65 0 0         params_exception "Table $name already exists in schema"
66             if $self->schema->has_table($name);
67              
68 0           my @i;
69 0 0         if ($self->{indexes})
70             {
71 0           @i = $self->indexes;
72 0           $self->delete_index($_) foreach @i;
73             }
74              
75 0           my $old_name = $self->{name};
76 0           $self->{name} = $name;
77              
78             eval
79 0           {
80 0           $self->schema->rules->validate_table_name($self);
81             };
82              
83 0           $self->add_index($_) foreach @i;
84              
85 0 0         if ($@)
86             {
87 0           $self->{name} = $old_name;
88              
89 0           rethrow_exception($@);
90             }
91              
92 0 0 0       if ( $old_name && eval { $self->schema->table($old_name) } )
  0            
93             {
94 0           $self->schema->register_table_name_change( table => $self,
95             old_name => $old_name );
96              
97 0           foreach my $fk ($self->all_foreign_keys)
98             {
99 0           $fk->table_to->register_table_name_change( table => $self,
100             old_name => $old_name );
101             }
102             }
103             }
104              
105             sub make_column
106             {
107 0     0 1   my $self = shift;
108 0           my %p = @_;
109              
110 0           my $is_pk = delete $p{primary_key};
111              
112 0           my %p2;
113 0           foreach ( qw( before after ) )
114             {
115 0 0         $p2{$_} = delete $p{$_} if exists $p{$_};
116             }
117 0           $self->add_column( column => Alzabo::Create::Column->new( table => $self,
118             %p ),
119             %p2 );
120              
121 0           my $col = $self->column( $p{name} );
122 0 0         $self->add_primary_key($col) if $is_pk;
123              
124 0           return $col;
125             }
126              
127             sub add_column
128             {
129 0     0 1   my $self = shift;
130              
131 0           validate( @_, { column => { isa => 'Alzabo::Create::Column' },
132             before => { optional => 1 },
133             after => { optional => 1 } } );
134 0           my %p = @_;
135              
136 0           my $col = $p{column};
137              
138 0 0         params_exception "Column " . $col->name . " already exists in " . $self->name
139             if $self->{columns}->EXISTS( $col->name );
140              
141 0 0         $col->set_table($self) unless $col->table eq $self;
142              
143 0           $self->{columns}->STORE( $col->name, $col);
144              
145 0           foreach ( qw( before after ) )
146             {
147 0 0         if ( exists $p{$_} )
148             {
149 0           $self->move_column( $_ => $p{$_},
150             column => $col );
151 0           last;
152             }
153             }
154             }
155              
156             sub delete_column
157             {
158 0     0 1   my $self = shift;
159              
160 0           validate_pos( @_, { isa => 'Alzabo::Create::Column' } );
161 0           my $col = shift;
162              
163 0 0         params_exception"Column $col doesn't exist in $self->{name}"
164             unless $self->{columns}->EXISTS( $col->name );
165              
166 0 0         $self->delete_primary_key($col) if $col->is_primary_key;
167              
168 0           foreach my $fk ($self->foreign_keys_by_column($col))
169             {
170 0           $self->delete_foreign_key($fk);
171              
172 0           foreach my $other_fk ($fk->table_to->foreign_keys( table => $self,
173             column => $fk->columns_to ) )
174             {
175 0           $fk->table_to->delete_foreign_key( $other_fk );
176             }
177             }
178              
179 0           foreach my $i ($self->indexes)
180             {
181 0 0         $self->delete_index($i) if grep { $_ eq $col } $i->columns;
  0            
182             }
183              
184 0           $self->{columns}->DELETE( $col->name );
185             }
186              
187             sub move_column
188             {
189 0     0 1   my $self = shift;
190              
191 0           validate( @_, { column => { isa => 'Alzabo::Create::Column' },
192             before => { isa => 'Alzabo::Create::Column',
193             optional => 1 },
194             after => { isa => 'Alzabo::Create::Column',
195             optional => 1 } } );
196 0           my %p = @_;
197              
198 0 0 0       if ( exists $p{before} && exists $p{after} )
199             {
200 0           params_exception
201             "move_column method cannot be called with both 'before' and 'after' parameters";
202             }
203              
204 0 0         if ( exists $p{before} )
205             {
206 0 0         params_exception "Column " . $p{before}->name . " doesn't exist in schema"
207             unless $self->{columns}->EXISTS( $p{before}->name );
208             }
209             else
210             {
211 0 0         params_exception "Column " . $p{after}->name . " doesn't exist in schema"
212             unless $self->{columns}->EXISTS( $p{after}->name );
213             }
214              
215 0 0         params_exception "Column " . $p{column}->name . " doesn't exist in schema"
216             unless $self->{columns}->EXISTS( $p{column}->name );
217              
218 0           my @pk = $self->primary_key;
219              
220 0           $self->{columns}->DELETE( $p{column}->name );
221              
222 0           my $index;
223 0 0         if ( $p{before} )
224             {
225 0           $index = $self->{columns}->Indices( $p{before}->name );
226             }
227             else
228             {
229 0           $index = $self->{columns}->Indices( $p{after}->name ) + 1;
230             }
231              
232 0           $self->{columns}->Splice( $index, 0, $p{column}->name => $p{column} );
233              
234 0           $self->{pk} = [ $self->{columns}->Indices( map { $_->name } @pk ) ];
  0            
235             }
236              
237             sub add_primary_key
238             {
239 0     0 1   my $self = shift;
240              
241 0           validate_pos( @_, { isa => 'Alzabo::Create::Column' } );
242 0           my $col = shift;
243              
244 0           my $name = $col->name;
245 0 0         params_exception "Column $name doesn't exist in $self->{name}"
246             unless $self->{columns}->EXISTS($name);
247              
248 0 0         params_exception "Column $name is already a primary key"
249             if $col->is_primary_key;
250              
251 0           $self->schema->rules->validate_primary_key($col);
252              
253 0           $col->set_nullable(0);
254              
255 0           my $idx = $self->{columns}->Indices($name);
256 0           push @{ $self->{pk} }, $idx;
  0            
257             }
258              
259             sub delete_primary_key
260             {
261 0     0 1   my $self = shift;
262              
263 0           validate_pos( @_, { isa => 'Alzabo::Create::Column' } );
264 0           my $col = shift;
265              
266 0           my $name = $col->name;
267 0 0         params_exception "Column $name doesn't exist in $self->{name}"
268             unless $self->{columns}->EXISTS($name);
269              
270 0 0         params_exception "Column $name is not a primary key"
271             unless $col->is_primary_key;
272              
273 0           my $idx = $self->{columns}->Indices($name);
274 0           $self->{pk} = [ grep { $_ != $idx } @{ $self->{pk} } ];
  0            
  0            
275             }
276              
277             sub make_foreign_key
278             {
279 0     0 1   my $self = shift;
280              
281 0           $self->add_foreign_key( Alzabo::Create::ForeignKey->new( @_ ) );
282             }
283              
284             sub add_foreign_key
285             {
286 0     0 1   my $self = shift;
287              
288 0           validate_pos( @_, { isa => 'Alzabo::Create::ForeignKey' } );
289 0           my $fk = shift;
290              
291 0           foreach my $c ( $fk->columns_from )
292             {
293 0           push @{ $self->{fk}{ $fk->table_to->name }{ $c->name } }, $fk;
  0            
294             }
295              
296 0 0 0       if ( ( $fk->is_one_to_one || $fk->is_one_to_many )
  0   0        
297             && !
298             ( $self->primary_key_size == grep { $_->is_primary_key } $fk->columns_from )
299             )
300             {
301 0           my $i = Alzabo::Create::Index->new( table => $self,
302             columns => [ $fk->columns_from ],
303             unique => 1 );
304              
305             # could already have a non-unique index (grr, index id()
306             # method is somewhat broken)
307 0 0         $self->delete_index($i) if $self->has_index( $i->id );
308 0           $self->add_index($i);
309             }
310             }
311              
312             sub delete_foreign_key
313             {
314 0     0 1   my $self = shift;
315              
316 0           validate_pos( @_, { isa => 'Alzabo::Create::ForeignKey' } );
317 0           my $fk = shift;
318              
319 0           foreach my $c ( $fk->columns_from )
320             {
321 0 0         params_exception "Column " . $c->name . " doesn't exist in $self->{name}"
322             unless $self->{columns}->EXISTS( $c->name );
323             }
324              
325             params_exception
326 0 0         "No foreign keys to " . $fk->table_to->name . " exist in $self->{name}"
327             unless exists $self->{fk}{ $fk->table_to->name };
328              
329 0           my @new_fk;
330 0           foreach my $c ( $fk->columns_from )
331             {
332 0 0         params_exception
333             "Column " . $c->name . " is not a foreign key to " .
334             $fk->table_to->name . " in $self->{name}"
335             unless exists $self->{fk}{ $fk->table_to->name }{ $c->name };
336              
337 0           foreach my $current_fk ( @{ $self->{fk}{ $fk->table_to->name }{ $c->name } } )
  0            
338             {
339 0 0         push @new_fk, $current_fk unless $current_fk eq $fk;
340             }
341             }
342              
343 0           foreach my $c ( $fk->columns_from )
344             {
345 0 0         if (@new_fk)
346             {
347 0           $self->{fk}{ $fk->table_to->name }{ $c->name } = \@new_fk;
348             }
349             else
350             {
351 0           delete $self->{fk}{ $fk->table_to->name }{ $c->name };
352             }
353             }
354              
355 0           delete $self->{fk}{ $fk->table_to->name }
356 0 0         unless keys %{ $self->{fk}{ $fk->table_to->name } };
357             }
358              
359             sub make_index
360             {
361 0     0 1   my Alzabo::Table $self = shift;
362              
363 0           $self->add_index( Alzabo::Create::Index->new( table => $self,
364             @_ ) );
365             }
366              
367             sub add_index
368             {
369 0     0 1   my Alzabo::Table $self = shift;
370              
371 0           validate_pos( @_, { isa => 'Alzabo::Create::Index' } );
372 0           my $i = shift;
373              
374 0           my $id = $i->id;
375 0 0         params_exception "Index already exists (id $id)."
376             if $self->{indexes}->EXISTS($id);
377              
378 0           $self->{indexes}->STORE( $id, $i );
379              
380 0           return $i;
381             }
382              
383             sub delete_index
384             {
385 0     0 1   my Alzabo::Table $self = shift;
386              
387 0           validate_pos( @_, { isa => 'Alzabo::Create::Index' } );
388 0           my $i = shift;
389              
390 0 0         params_exception "Index does not exist."
391             unless $self->{indexes}->EXISTS( $i->id );
392              
393 0           $self->{indexes}->DELETE( $i->id );
394             }
395              
396             sub register_table_name_change
397             {
398 0     0 0   my $self = shift;
399              
400 0           validate( @_, { table => { isa => 'Alzabo::Create::Table' },
401             old_name => { type => SCALAR } } );
402 0           my %p = @_;
403              
404 0 0         $self->{fk}{ $p{table}->name } = delete $self->{fk}{ $p{old_name} }
405             if exists $self->{fk}{ $p{old_name} };
406             }
407              
408             sub register_column_name_change
409             {
410 0     0 0   my $self = shift;
411              
412 0           validate( @_, { column => { isa => 'Alzabo::Create::Column' },
413             old_name => { type => SCALAR } } );
414 0           my %p = @_;
415              
416 0           my $new_name = $p{column}->name;
417 0           my $index = $self->{columns}->Indices( $p{old_name} );
418 0           $self->{columns}->Replace( $index, $p{column}, $new_name );
419              
420 0           foreach my $t ( keys %{ $self->{fk} } )
  0            
421             {
422 0 0         $self->{fk}{$t}{$new_name} = delete $self->{fk}{$t}{ $p{old_name} }
423             if exists $self->{fk}{$t}{ $p{old_name} };
424             }
425              
426 0           my @i = $self->{indexes}->Values;
427 0           $self->{indexes} = Tie::IxHash->new;
428 0           foreach my $i (@i)
429             {
430 0           $i->register_column_name_change(%p);
431 0           $self->add_index($i);
432             }
433             }
434              
435             sub set_attributes
436             {
437 0     0 1   my $self = shift;
438              
439 0           validate_pos( @_, ( { type => SCALAR } ) x @_ );
440              
441 0           %{ $self->{attributes} } = ();
  0            
442              
443 0 0         foreach ( grep { defined && length } @_ )
  0            
444             {
445 0           $self->add_attribute($_);
446             }
447             }
448              
449             sub add_attribute
450             {
451 0     0 1   my $self = shift;
452              
453 0           validate_pos( @_, { type => SCALAR } );
454 0           my $attr = shift;
455              
456 0           $attr =~ s/^\s+//;
457 0           $attr =~ s/\s+$//;
458              
459 0           $self->schema->rules->validate_table_attribute( table => $self,
460             attribute => $attr );
461              
462 0           $self->{attributes}{$attr} = 1;
463             }
464              
465             sub delete_attribute
466             {
467 0     0 1   my $self = shift;
468              
469 0           validate_pos( @_, { type => SCALAR } );
470 0           my $attr = shift;
471              
472 0 0         params_exception "Table " . $self->name . " doesn't have attribute $attr"
473             unless exists $self->{attributes}{$attr};
474              
475 0           delete $self->{attributes}{$attr};
476             }
477              
478 0 0   0 1   sub set_comment { $_[0]->{comment} = defined $_[1] ? $_[1] : '' }
479              
480             sub save_current_name
481             {
482 0     0 0   my $self = shift;
483              
484 0           $self->{last_instantiated_name} = $self->name;
485              
486 0           foreach my $column ( $self->columns )
487             {
488 0           $column->save_current_name;
489             }
490             }
491              
492 0     0 1   sub former_name { $_[0]->{last_instantiated_name} }
493              
494             __END__