Added a little to the POD to explain version dependency.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Table.pm
CommitLineData
3c5de62a 1package SQL::Translator::Schema::Table;
2
3# ----------------------------------------------------------------------
be53b4c8 4# $Id: Table.pm,v 1.23 2003-10-04 01:22:04 kycl4rk Exp $
3c5de62a 5# ----------------------------------------------------------------------
6# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
7#
8# This program is free software; you can redistribute it and/or
9# modify it under the terms of the GNU General Public License as
10# published by the Free Software Foundation; version 2.
11#
12# This program is distributed in the hope that it will be useful, but
13# WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15# General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
20# 02111-1307 USA
21# -------------------------------------------------------------------
22
23=pod
24
25=head1 NAME
26
27SQL::Translator::Schema::Table - SQL::Translator table object
28
29=head1 SYNOPSIS
30
31 use SQL::Translator::Schema::Table;
0f3cc5c0 32 my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
3c5de62a 33
34=head1 DESCSIPTION
35
36C<SQL::Translator::Schema::Table> is the table object.
37
38=head1 METHODS
39
40=cut
41
42use strict;
43use Class::Base;
30f4ec44 44use SQL::Translator::Utils 'parse_list_arg';
0f3cc5c0 45use SQL::Translator::Schema::Constants;
3c5de62a 46use SQL::Translator::Schema::Constraint;
47use SQL::Translator::Schema::Field;
48use SQL::Translator::Schema::Index;
c8515c9f 49use Data::Dumper;
3c5de62a 50
51use base 'Class::Base';
0f3cc5c0 52use vars qw( $VERSION $FIELD_ORDER );
3c5de62a 53
be53b4c8 54$VERSION = sprintf "%d.%02d", q$Revision: 1.23 $ =~ /(\d+)\.(\d+)/;
3c5de62a 55
56# ----------------------------------------------------------------------
57sub init {
58
59=pod
60
61=head2 new
62
63Object constructor.
64
43b9dc7a 65 my $table = SQL::Translator::Schema::Table->new(
66 schema => $schema,
67 name => 'foo',
68 );
3c5de62a 69
70=cut
71
72 my ( $self, $config ) = @_;
43b9dc7a 73
88b8377e 74 for my $arg ( qw[ schema name comments ] ) {
43b9dc7a 75 next unless defined $config->{ $arg };
88b8377e 76 defined $self->$arg( $config->{ $arg } ) or return;
43b9dc7a 77 }
78
3c5de62a 79 return $self;
80}
81
82# ----------------------------------------------------------------------
3c5de62a 83sub add_constraint {
84
85=pod
86
87=head2 add_constraint
88
0f3cc5c0 89Add a constraint to the table. Returns the newly created
90C<SQL::Translator::Schema::Constraint> object.
3c5de62a 91
870024f3 92 my $c1 = $table->add_constraint(
93 name => 'pk',
94 type => PRIMARY_KEY,
95 fields => [ 'foo_id' ],
3c5de62a 96 );
97
dfdb0568 98 my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
99 $c2 = $table->add_constraint( $constraint );
43b9dc7a 100
3c5de62a 101=cut
102
43b9dc7a 103 my $self = shift;
104 my $constraint_class = 'SQL::Translator::Schema::Constraint';
105 my $constraint;
106
107 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
108 $constraint = shift;
109 $constraint->table( $self );
110 }
111 else {
112 my %args = @_;
113 $args{'table'} = $self;
114 $constraint = $constraint_class->new( \%args ) or
115 return $self->error( $constraint_class->error );
116 }
117
dfdb0568 118 #
119 # If we're trying to add a PK when one is already defined,
120 # then just add the fields to the existing definition.
121 #
3dd9026c 122 my $ok = 1;
dfdb0568 123 my $pk = $self->primary_key;
124 if ( $pk && $constraint->type eq PRIMARY_KEY ) {
125 $self->primary_key( $constraint->fields );
126 $constraint = $pk;
3dd9026c 127 $ok = 0;
dfdb0568 128 }
2ccf2299 129 elsif ( $constraint->type eq PRIMARY_KEY ) {
130 for my $fname ( $constraint->fields ) {
131 if ( my $f = $self->get_field( $fname ) ) {
132 $f->is_primary_key( 1 );
133 }
134 }
135 }
3dd9026c 136 #
137 # See if another constraint of the same type
be53b4c8 138 # covers the same fields. -- This doesn't work! ky
3dd9026c 139 #
be53b4c8 140# elsif ( $constraint->type ne CHECK_C ) {
141# my @field_names = $constraint->fields;
142# for my $c (
143# grep { $_->type eq $constraint->type }
144# $self->get_constraints
145# ) {
146# my %fields = map { $_, 1 } $c->fields;
147# for my $field_name ( @field_names ) {
148# if ( $fields{ $field_name } ) {
149# $constraint = $c;
150# $ok = 0;
151# last;
152# }
153# }
154# last unless $ok;
155# }
156# }
dfdb0568 157
158 if ( $ok ) {
159 push @{ $self->{'constraints'} }, $constraint;
160 }
161
3c5de62a 162 return $constraint;
163}
164
165# ----------------------------------------------------------------------
166sub add_index {
167
168=pod
169
170=head2 add_index
171
0f3cc5c0 172Add an index to the table. Returns the newly created
173C<SQL::Translator::Schema::Index> object.
3c5de62a 174
870024f3 175 my $i1 = $table->add_index(
3c5de62a 176 name => 'name',
177 fields => [ 'name' ],
178 type => 'normal',
179 );
180
dfdb0568 181 my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
182 $i2 = $table->add_index( $index );
43b9dc7a 183
3c5de62a 184=cut
185
43b9dc7a 186 my $self = shift;
187 my $index_class = 'SQL::Translator::Schema::Index';
188 my $index;
189
190 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
191 $index = shift;
192 $index->table( $self );
193 }
194 else {
195 my %args = @_;
196 $args{'table'} = $self;
197 $index = $index_class->new( \%args ) or return
198 $self->error( $index_class->error );
199 }
200
3c5de62a 201 push @{ $self->{'indices'} }, $index;
202 return $index;
203}
204
205# ----------------------------------------------------------------------
206sub add_field {
207
208=pod
209
210=head2 add_field
211
43b9dc7a 212Add an field to the table. Returns the newly created
213C<SQL::Translator::Schema::Field> object. The "name" parameter is
214required. If you try to create a field with the same name as an
215existing field, you will get an error and the field will not be created.
3c5de62a 216
870024f3 217 my $f1 = $table->add_field(
0f3cc5c0 218 name => 'foo_id',
219 data_type => 'integer',
220 size => 11,
3c5de62a 221 );
222
870024f3 223 my $f2 = SQL::Translator::Schema::Field->new(
43b9dc7a 224 name => 'name',
225 table => $table,
226 );
870024f3 227 $f2 = $table->add_field( $field2 ) or die $table->error;
43b9dc7a 228
3c5de62a 229=cut
230
dfdb0568 231 my $self = shift;
43b9dc7a 232 my $field_class = 'SQL::Translator::Schema::Field';
233 my $field;
234
235 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
236 $field = shift;
237 $field->table( $self );
238 }
239 else {
240 my %args = @_;
241 $args{'table'} = $self;
242 $field = $field_class->new( \%args ) or return
243 $self->error( $field_class->error );
244 }
245
30f4ec44 246 $field->order( ++$FIELD_ORDER );
43b9dc7a 247 my $field_name = $field->name or return $self->error('No name');
248
249 if ( exists $self->{'fields'}{ $field_name } ) {
870024f3 250 return $self->error(qq[Can't create field: "$field_name" exists]);
43b9dc7a 251 }
252 else {
253 $self->{'fields'}{ $field_name } = $field;
43b9dc7a 254 }
255
3c5de62a 256 return $field;
257}
258
259# ----------------------------------------------------------------------
88b8377e 260sub comments {
261
262=pod
263
264=head2 comments
265
266Get or set the comments on a table. May be called several times to
267set and it will accumulate the comments. Called in an array context,
268returns each comment individually; called in a scalar context, returns
269all the comments joined on newlines.
270
271 $table->comments('foo');
272 $table->comments('bar');
273 print join( ', ', $table->comments ); # prints "foo, bar"
274
275=cut
276
eb3b8ae4 277 my $self = shift;
278 my @comments = ref $_[0] ? @{ $_[0] } : @_;
b891fb49 279
eb3b8ae4 280 for my $arg ( @comments ) {
b891fb49 281 $arg = $arg->[0] if ref $arg;
eb3b8ae4 282 push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
b891fb49 283 }
88b8377e 284
eb3b8ae4 285 if ( @{ $self->{'comments'} || [] } ) {
286 return wantarray
287 ? @{ $self->{'comments'} }
288 : join( "\n", @{ $self->{'comments'} } )
289 ;
290 }
291 else {
292 return wantarray ? () : undef;
293 }
88b8377e 294}
295
296# ----------------------------------------------------------------------
0f3cc5c0 297sub get_constraints {
298
299=pod
300
301=head2 get_constraints
302
303Returns all the constraint objects as an array or array reference.
304
305 my @constraints = $table->get_constraints;
306
307=cut
308
309 my $self = shift;
310
311 if ( ref $self->{'constraints'} ) {
312 return wantarray
313 ? @{ $self->{'constraints'} } : $self->{'constraints'};
314 }
315 else {
316 $self->error('No constraints');
317 return wantarray ? () : undef;
318 }
319}
320
321# ----------------------------------------------------------------------
322sub get_indices {
3c5de62a 323
324=pod
325
0f3cc5c0 326=head2 get_indices
3c5de62a 327
0f3cc5c0 328Returns all the index objects as an array or array reference.
3c5de62a 329
0f3cc5c0 330 my @indices = $table->get_indices;
3c5de62a 331
332=cut
333
334 my $self = shift;
0f3cc5c0 335
336 if ( ref $self->{'indices'} ) {
337 return wantarray
338 ? @{ $self->{'indices'} }
339 : $self->{'indices'};
340 }
341 else {
342 $self->error('No indices');
343 return wantarray ? () : undef;
344 }
345}
346
347# ----------------------------------------------------------------------
43b9dc7a 348sub get_field {
349
350=pod
351
352=head2 get_field
353
354Returns a field by the name provided.
355
356 my $field = $table->get_field('foo');
357
358=cut
359
360 my $self = shift;
361 my $field_name = shift or return $self->error('No field name');
362 return $self->error( qq[Field "$field_name" does not exist] ) unless
363 exists $self->{'fields'}{ $field_name };
364 return $self->{'fields'}{ $field_name };
365}
366
367# ----------------------------------------------------------------------
0f3cc5c0 368sub get_fields {
369
370=pod
371
372=head2 get_fields
373
374Returns all the field objects as an array or array reference.
375
376 my @fields = $table->get_fields;
377
378=cut
379
380 my $self = shift;
381 my @fields =
30f4ec44 382 map { $_->[1] }
383 sort { $a->[0] <=> $b->[0] }
384 map { [ $_->order, $_ ] }
0f3cc5c0 385 values %{ $self->{'fields'} || {} };
386
387 if ( @fields ) {
388 return wantarray ? @fields : \@fields;
389 }
390 else {
391 $self->error('No fields');
392 return wantarray ? () : undef;
393 }
3c5de62a 394}
395
396# ----------------------------------------------------------------------
397sub is_valid {
398
399=pod
400
401=head2 is_valid
402
403Determine whether the view is valid or not.
404
405 my $ok = $view->is_valid;
406
407=cut
408
409 my $self = shift;
43b9dc7a 410 return $self->error('No name') unless $self->name;
0f3cc5c0 411 return $self->error('No fields') unless $self->get_fields;
412
413 for my $object (
414 $self->get_fields, $self->get_indices, $self->get_constraints
415 ) {
416 return $object->error unless $object->is_valid;
417 }
418
419 return 1;
3c5de62a 420}
421
870024f3 422# ----------------------------------------------------------------------
65157eda 423sub is_trivial_link {
424
425=pod
426
427=head2 is_data
428
429=cut
430
431 my $self = shift;
432 return 0 if $self->is_data;
433 return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
434
435 $self->{'is_trivial_link'} = 1;
436
437 my %fk = ();
438
439 foreach my $field ( $self->get_fields ) {
440 next unless $field->is_foreign_key;
441 $fk{$field->foreign_key_reference->reference_table}++;
442 }
443
444 foreach my $referenced (keys %fk){
f9c5e794 445 if($fk{$referenced} > 1){
446 $self->{'is_trivial_link'} = 0;
447 last;
65157eda 448 }
3d6c9056 449 }
65157eda 450
451 return $self->{'is_trivial_link'};
452
453}
454
69c7a62f 455sub is_data {
69c7a62f 456
870024f3 457=pod
458
459=head2 is_data
460
461=cut
462
463 my $self = shift;
464 return $self->{'is_data'} if defined $self->{'is_data'};
69c7a62f 465
870024f3 466 $self->{'is_data'} = 0;
69c7a62f 467
870024f3 468 foreach my $field ( $self->get_fields ) {
469 if ( !$field->is_primary_key and !$field->is_foreign_key ) {
470 $self->{'is_data'} = 1;
471 return $self->{'is_data'};
472 }
473 }
474
475 return $self->{'is_data'};
69c7a62f 476}
477
870024f3 478# ----------------------------------------------------------------------
69c7a62f 479sub can_link {
480
481=pod
482
483=head2 can_link
484
485Determine whether the table can link two arg tables via many-to-many.
486
487 my $ok = $table->can_link($table1,$table2);
488
489=cut
490
870024f3 491 my ( $self, $table1, $table2 ) = @_;
492
493 return $self->{'can_link'}{ $table1->name }{ $table2->name }
494 if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
495
496 if ( $self->is_data == 1 ) {
497 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
498 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
499 return $self->{'can_link'}{ $table1->name }{ $table2->name };
500 }
501
502 my %fk = ();
503
504 foreach my $field ( $self->get_fields ) {
505 if ( $field->is_foreign_key ) {
506 push @{ $fk{ $field->foreign_key_reference->reference_table } },
507 $field->foreign_key_reference;
508 }
509 }
510
511 if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
512 {
513 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
514 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
515 return $self->{'can_link'}{ $table1->name }{ $table2->name };
516 }
517
518 # trivial traversal, only one way to link the two tables
519 if ( scalar( @{ $fk{ $table1->name } } == 1 )
520 and scalar( @{ $fk{ $table2->name } } == 1 ) )
521 {
522 $self->{'can_link'}{ $table1->name }{ $table2->name } =
523 [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
524 $self->{'can_link'}{ $table1->name }{ $table2->name } =
525 [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
526
527 # non-trivial traversal. one way to link table2,
528 # many ways to link table1
529 }
530 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
531 and scalar( @{ $fk{ $table2->name } } == 1 ) )
532 {
533 $self->{'can_link'}{ $table1->name }{ $table2->name } =
534 [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
535 $self->{'can_link'}{ $table2->name }{ $table1->name } =
536 [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
537
538 # non-trivial traversal. one way to link table1,
539 # many ways to link table2
540 }
541 elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
542 and scalar( @{ $fk{ $table2->name } } > 1 ) )
543 {
544 $self->{'can_link'}{ $table1->name }{ $table2->name } =
545 [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
546 $self->{'can_link'}{ $table2->name }{ $table1->name } =
547 [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
548
549 # non-trivial traversal. many ways to link table1 and table2
550 }
551 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
552 and scalar( @{ $fk{ $table2->name } } > 1 ) )
553 {
554 $self->{'can_link'}{ $table1->name }{ $table2->name } =
555 [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
556 $self->{'can_link'}{ $table2->name }{ $table1->name } =
557 [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
558
559 # one of the tables didn't export a key
560 # to this table, no linking possible
561 }
562 else {
563 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
564 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
565 }
566
567 return $self->{'can_link'}{ $table1->name }{ $table2->name };
69c7a62f 568}
569
43b9dc7a 570# ----------------------------------------------------------------------
dfdb0568 571sub name {
572
573=pod
574
575=head2 name
576
870024f3 577Get or set the table's name.
dfdb0568 578
579If provided an argument, checks the schema object for a table of
580that name and disallows the change if one exists.
581
582 my $table_name = $table->name('foo');
583
584=cut
585
586 my $self = shift;
587
588 if ( my $arg = shift ) {
589 if ( my $schema = $self->schema ) {
870024f3 590 return $self->error( qq[Can't use table name "$arg": table exists] )
dfdb0568 591 if $schema->get_table( $arg );
592 }
593 $self->{'name'} = $arg;
594 }
595
596 return $self->{'name'} || '';
597}
598
599# ----------------------------------------------------------------------
43b9dc7a 600sub schema {
601
602=pod
603
604=head2 schema
605
870024f3 606Get or set the table's schema object.
43b9dc7a 607
608 my $schema = $table->schema;
609
610=cut
611
612 my $self = shift;
613 if ( my $arg = shift ) {
614 return $self->error('Not a schema object') unless
615 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
616 $self->{'schema'} = $arg;
617 }
618
619 return $self->{'schema'};
620}
621
622# ----------------------------------------------------------------------
623sub primary_key {
624
625=pod
626
870024f3 627=head2 primary_key
43b9dc7a 628
870024f3 629Gets or sets the table's primary key(s). Takes one or more field
5e84ac85 630names (as a string, list or array[ref]) as an argument. If the field
631names are present, it will create a new PK if none exists, or it will
632add to the fields of an existing PK (and will unique the field names).
633Returns the C<SQL::Translator::Schema::Constraint> object representing
634the primary key.
635
636These are eqivalent:
43b9dc7a 637
638 $table->primary_key('id');
5e84ac85 639 $table->primary_key(['name']);
640 $table->primary_key('id','name']);
43b9dc7a 641 $table->primary_key(['id','name']);
642 $table->primary_key('id,name');
643 $table->primary_key(qw[ id name ]);
644
645 my $pk = $table->primary_key;
646
647=cut
648
30f4ec44 649 my $self = shift;
650 my $fields = parse_list_arg( @_ );
43b9dc7a 651
5e84ac85 652 my $constraint;
43b9dc7a 653 if ( @$fields ) {
654 for my $f ( @$fields ) {
655 return $self->error(qq[Invalid field "$f"]) unless
656 $self->get_field($f);
657 }
658
659 my $has_pk;
660 for my $c ( $self->get_constraints ) {
661 if ( $c->type eq PRIMARY_KEY ) {
662 $has_pk = 1;
663 $c->fields( @{ $c->fields }, @$fields );
5e84ac85 664 $constraint = $c;
43b9dc7a 665 }
666 }
667
668 unless ( $has_pk ) {
5e84ac85 669 $constraint = $self->add_constraint(
43b9dc7a 670 type => PRIMARY_KEY,
671 fields => $fields,
88b8377e 672 ) or return;
43b9dc7a 673 }
674 }
675
5e84ac85 676 if ( $constraint ) {
677 return $constraint;
678 }
679 else {
680 for my $c ( $self->get_constraints ) {
681 return $c if $c->type eq PRIMARY_KEY;
682 }
43b9dc7a 683 }
684
dfdb0568 685 return;
43b9dc7a 686}
687
688# ----------------------------------------------------------------------
689sub options {
690
691=pod
692
693=head2 options
694
870024f3 695Get or set the table's options (e.g., table types for MySQL). Returns
43b9dc7a 696an array or array reference.
697
698 my @options = $table->options;
699
700=cut
701
702 my $self = shift;
30f4ec44 703 my $options = parse_list_arg( @_ );
43b9dc7a 704
705 push @{ $self->{'options'} }, @$options;
706
707 if ( ref $self->{'options'} ) {
708 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
709 }
710 else {
711 return wantarray ? () : [];
712 }
713}
714
30f4ec44 715# ----------------------------------------------------------------------
716sub order {
717
718=pod
719
720=head2 order
721
870024f3 722Get or set the table's order.
30f4ec44 723
724 my $order = $table->order(3);
725
726=cut
727
728 my ( $self, $arg ) = @_;
729
730 if ( defined $arg && $arg =~ /^\d+$/ ) {
731 $self->{'order'} = $arg;
732 }
733
734 return $self->{'order'} || 0;
735}
736
737# ----------------------------------------------------------------------
738sub DESTROY {
739 my $self = shift;
740 undef $self->{'schema'}; # destroy cyclical reference
741 undef $_ for @{ $self->{'constraints'} };
742 undef $_ for @{ $self->{'indices'} };
743 undef $_ for values %{ $self->{'fields'} };
744}
745
3c5de62a 7461;
747
748# ----------------------------------------------------------------------
749
750=pod
751
870024f3 752=head1 AUTHORS
3c5de62a 753
870024f3 754Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
755Allen Day E<lt>allenday@ucla.eduE<gt>.
3c5de62a 756
757=cut