1 package DBIx::DBSchema::Table;
5 use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
6 use DBIx::DBSchema::Column 0.14;
7 use DBIx::DBSchema::Index;
8 use DBIx::DBSchema::ForeignKey 0.13;
10 our $VERSION = '0.12';
15 DBIx::DBSchema::Table - Table objects
19 use DBIx::DBSchema::Table;
21 #new style (preferred), pass a hashref of parameters
22 $table = new DBIx::DBSchema::Table (
25 primary_key => "primary_key",
26 columns => \@dbix_dbschema_column_objects,
27 #deprecated# unique => $dbix_dbschema_colgroup_unique_object,
28 #deprecated# 'index' => $dbix_dbschema_colgroup_index_object,
29 indices => \@dbix_dbschema_index_objects,
30 foreign_keys => \@dbix_dbschema_foreign_key_objects,
34 #old style (VERY deprecated)
35 $table = new DBIx::DBSchema::Table (
38 $dbix_dbschema_colgroup_unique_object,
39 $dbix_dbschema_colgroup_index_object,
40 @dbix_dbschema_column_objects,
43 $table->addcolumn ( $dbix_dbschema_column_object );
45 $table_name = $table->name;
46 $table->name("table_name");
48 $primary_key = $table->primary_key;
49 $table->primary_key("primary_key");
51 #deprecated# $dbix_dbschema_colgroup_unique_object = $table->unique;
52 #deprecated# $table->unique( $dbix_dbschema__colgroup_unique_object );
54 #deprecated# $dbix_dbschema_colgroup_index_object = $table->index;
55 #deprecated# $table->index( $dbix_dbschema_colgroup_index_object );
57 %indices = $table->indices;
58 $dbix_dbschema_index_object = $indices{'index_name'};
59 @all_index_names = keys %indices;
60 @all_dbix_dbschema_index_objects = values %indices;
62 @column_names = $table->columns;
64 $dbix_dbschema_column_object = $table->column("column");
67 @sql_statements = $table->sql_create_table( $dbh );
68 @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
71 @sql_statements = $table->sql_create_table( $datasrc );
72 @sql_statements = $table->sql_create_table;
76 DBIx::DBSchema::Table objects represent a single database table.
84 Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
85 hash reference of named parameters.
89 primary_key => PRIMARY_KEY,
92 local_options => OPTIONS,
95 TABLE_NAME is the name of the table.
97 PRIMARY_KEY is the primary key (may be empty).
99 COLUMNS is a reference to an array of DBIx::DBSchema::Column objects
100 (see L<DBIx::DBSchema::Column>).
102 INDICES is a reference to an array of DBIx::DBSchema::Index objects
103 (see L<DBIx::DBSchema::Index>), or a hash reference of index names (keys) and
104 DBIx::DBSchema::Index objects (values).
106 FOREIGN_KEYS is a references to an array of DBIx::DBSchema::ForeignKey objects
107 (see L<DBIx::DBSchema::ForeignKey>).
109 OPTIONS is a scalar of database-specific table options, such as "WITHOUT OIDS"
110 for Pg or "TYPE=InnoDB" for mysql.
116 my $class = ref($proto) || $proto;
122 $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
123 $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
125 $self->{indices} = { map { $_->name, $_ } @{$self->{indices}} }
126 if ref($self->{indices}) eq 'ARRAY';
128 $self->{foreign_keys} ||= [];
132 carp "Old-style $class creation without named parameters is deprecated!";
133 #croak "FATAL: old-style $class creation no longer supported;".
134 # " use named parameters";
136 my($name,$primary_key,$unique,$index,@columns) = @_;
138 my %columns = map { $_->name, $_ } @columns;
139 my @column_order = map { $_->name } @columns;
143 'primary_key' => $primary_key,
146 'columns' => \%columns,
147 'column_order' => \@column_order,
148 'foreign_keys' => [],
153 #check $primary_key, $unique and $index to make sure they are $columns ?
154 # (and sanity check?)
156 bless ($self, $class);
158 $_->table_obj($self) foreach values %{ $self->{columns} };
163 =item new_odbc DATABASE_HANDLE TABLE_NAME
165 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
166 handle for the specified table. This uses the experimental DBI type_info
167 method to create a table with standard (ODBC) SQL column types that most
168 closely correspond to any non-portable column types. Use this to import a
169 schema that you wish to use with many different database engines. Although
170 primary key and (unique) index information will only be imported from databases
171 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
172 column names and attributes *should* work for any database.
174 Note: the _odbc refers to the column types used and nothing else - you do not
175 have to have ODBC installed or connect to the database via ODBC.
179 our %create_params = (
180 # undef => sub { '' },
182 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
184 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
188 my( $proto, $dbh, $name) = @_;
190 my $driver = _load_driver($dbh);
191 my $sth = _null_sth($dbh, $name);
196 ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
202 'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
210 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
211 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
212 "returned no results for type ". $sth->{TYPE}->[$sthpos];
214 my $length = &{ $create_params{ $type_info->{CREATE_PARAMS} } }
220 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
224 DBIx::DBSchema::Column->new({
226 #'type' => "SQL_". uc($type_info->{'TYPE_NAME'}),
227 'type' => $type_info->{'TYPE_NAME'},
228 'null' => $sth->{NULLABLE}->[$sthpos],
230 'default' => $default,
231 #'local' => # DB-local
240 'indices' => { map { my $indexname = $_;
242 DBIx::DBSchema::Index->new($indices_hr->{$indexname})
250 =item new_native DATABASE_HANDLE TABLE_NAME
252 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
253 handle for the specified table. This uses database-native methods to read the
254 schema, and will preserve any non-portable column types. The method is only
255 available if there is a DBIx::DBSchema::DBD for the corresponding database
256 engine (currently, MySQL and PostgreSQL).
261 my( $proto, $dbh, $name) = @_;
262 my $driver = _load_driver($dbh);
265 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
269 ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
275 'primary_key' => $primary_key,
278 map DBIx::DBSchema::Column->new( @{$_} ),
279 eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
282 'indices' => { map { my $indexname = $_;
284 DBIx::DBSchema::Index->new($indices_hr->{$indexname})
290 map DBIx::DBSchema::ForeignKey->new( $_ ),
291 eval "DBIx::DBSchema::DBD::$driver->constraints(\$dbh, \$name)"
298 =item addcolumn COLUMN
300 Adds this DBIx::DBSchema::Column object.
305 my($self, $column) = @_;
306 $column->table_obj($self);
307 ${$self->{'columns'}}{$column->name} = $column; #sanity check?
308 push @{$self->{'column_order'}}, $column->name;
311 =item delcolumn COLUMN_NAME
313 Deletes this column. Returns false if no column of this name was found to
314 remove, true otherwise.
319 my($self,$column) = @_;
320 return 0 unless exists $self->{'columns'}{$column};
321 $self->{'columns'}{$column}->table_obj('');
322 delete $self->{'columns'}{$column};
323 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
326 =item name [ TABLE_NAME ]
328 Returns or sets the table name.
334 if ( defined($value) ) {
335 $self->{name} = $value;
341 =item local_options [ OPTIONS ]
343 Returns or sets the database-specific table options string.
349 if ( defined($value) ) {
350 $self->{local_options} = $value;
352 defined $self->{local_options} ? $self->{local_options} : '';
356 =item primary_key [ PRIMARY_KEY ]
358 Returns or sets the primary key.
364 if ( defined($value) ) {
365 $self->{primary_key} = $value;
367 #$self->{primary_key};
368 #hmm. maybe should untaint the entire structure when it comes off disk
369 # cause if you don't trust that, ?
370 $self->{primary_key} =~ /^(\w*)$/
372 or die "Illegal primary key: ", $self->{primary_key};
379 Returns a list consisting of the names of all columns.
385 #keys %{$self->{'columns'}};
387 @{ $self->{'column_order'} };
390 =item column COLUMN_NAME
392 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
398 my($self,$column)=@_;
399 $self->{'columns'}->{$column};
404 Returns a list of key-value pairs suitable for assigning to a hash. Keys are
405 index names, and values are index objects (see L<DBIx::DBSchema::Index>).
411 exists( $self->{'indices'} )
412 ? %{ $self->{'indices'} }
418 Meet exciting and unique singles using this method!
420 This method returns a list of column names that are indexed with their own,
421 unique, non-compond (that's the "single" part) indices.
427 my %indices = $self->indices;
429 map { ${ $indices{$_}->columns }[0] }
430 grep { $indices{$_}->unique && scalar(@{$indices{$_}->columns}) == 1 }
434 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
436 Returns a list of SQL statments to create this table.
438 The data source can be specified by passing an open DBI database handle, or by
439 passing the DBI data source name, username and password.
441 Although the username and password are optional, it is best to call this method
442 with a database handle or data source including a valid username and password -
443 a DBI connection will be opened and the quoting and type mapping will be more
446 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
447 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
448 (if applicable) may also be supported in the future.
452 sub sql_create_table {
453 my($self, $dbh) = ( shift, _dbh(@_) );
455 my $driver = _load_driver($dbh);
457 #should be in the DBD somehwere :/
458 # my $saved_pkey = '';
459 # if ( $driver eq 'Pg' && $self->primary_key ) {
460 # my $pcolumn = $self->column( (
461 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
463 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
464 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
465 # #my $saved_pkey = $self->primary_key;
466 # #$self->primary_key('');
467 # #change it back afterwords :/
470 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
472 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
473 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
475 # push @columns, $self->foreign_keys_sql;
480 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n".
484 my %indices = $self->indices;
485 #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
486 foreach my $index ( keys %indices ) {
487 push @r, $indices{$index}->sql_create_index( $self->name );
490 #$self->primary_key($saved_pkey) if $saved_pkey;
494 =item sql_add_constraints [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
496 Returns a list of SQL statments to add constraints (foreign keys) to this table.
498 The data source can be specified by passing an open DBI database handle, or by
499 passing the DBI data source name, username and password.
501 Although the username and password are optional, it is best to call this method
502 with a database handle or data source including a valid username and password -
503 a DBI connection will be opened and the quoting and type mapping will be more
506 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
507 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
508 (if applicable) may also be supported in the future.
512 sub sql_add_constraints {
514 my @fks = $self->foreign_keys_sql or return ();
516 'ALTER TABLE '. $self->name. ' '. join(",\n ", map "ADD $_", @fks)
520 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
522 Returns a list of SQL statements to alter this table so that it is identical
523 to the provided table, also a DBIx::DBSchema::Table object.
525 The data source can be specified by passing an open DBI database handle, or by
526 passing the DBI data source name, username and password.
528 Although the username and password are optional, it is best to call this method
529 with a database handle or data source including a valid username and password -
530 a DBI connection will be opened and used to check the database version as well
531 as for more reliable quoting and type mapping. Note that the database
532 connection will be used passively, B<not> to actually run the CREATE
535 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
536 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
537 Currently supported databases are MySQL and PostgreSQL.
539 If not passed a data source (or handle), or if there is no driver for the
540 specified database, will attempt to use generic SQL syntax.
544 #gosh, false laziness w/DBSchema::sql_update_schema
546 sub sql_alter_table {
547 my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
549 my $driver = _load_driver($dbh);
551 my $table = $self->name;
559 # columns (add/alter)
562 foreach my $column ( $new->columns ) {
564 if ( $self->column($column) ) {
565 warn " $table.$column exists\n" if $DEBUG > 1;
567 my ($alter_table, $sql) =
568 $self->column($column)->sql_alter_column( $new->column($column),
572 push @at, @$alter_table;
576 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
578 my ($alter_table, $sql) = $new->column($column)->sql_add_column( $dbh );
579 push @at, @$alter_table;
590 my %old_indices = $self->indices;
591 my %new_indices = $new->indices;
593 foreach my $old ( keys %old_indices ) {
595 if ( exists( $new_indices{$old} )
596 && $old_indices{$old}->cmp( $new_indices{$old} )
599 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
600 delete $old_indices{$old};
601 delete $new_indices{$old};
603 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
605 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
610 #warn if there's more than one?
611 my $same = shift @same;
613 warn "index $table.$old is identical to $same; renaming\n"
616 my $temp = 'dbs_temp'.$tempnum++;
618 push @r, "ALTER INDEX $old RENAME TO $temp";
619 push @r_later, "ALTER INDEX $temp RENAME TO $same";
621 delete $old_indices{$old};
622 delete $new_indices{$same};
630 foreach my $old ( keys %old_indices ) {
631 warn "removing obsolete index $table.$old ON ( ".
632 $old_indices{$old}->columns_sql. " )\n"
634 push @r, 'DROP INDEX '. ( $driver ne 'mysql' ? ' IF EXISTS ' : '').
635 " $old ". ( $driver eq 'mysql' ? " ON $table " : '');
638 foreach my $new ( keys %new_indices ) {
639 warn "creating new index $table.$new\n" if $DEBUG > 1;
640 push @r, $new_indices{$new}->sql_create_index($table);
647 foreach my $column ( grep !$new->column($_), $self->columns ) {
649 warn "column $table.$column should be dropped.\n" if $DEBUG;
651 push @at, $self->column($column)->sql_drop_column( $dbh );
656 # return the statements
659 unshift @r, "ALTER TABLE $table ". join(', ', @at) if @at;
663 warn join('', map "$_\n", @r)
670 =item sql_alter_constraints PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
672 Returns a list of SQL statements to alter this table's constraints (foreign
673 keys) so that they are identical to the provided table, also a
674 DBIx::DBSchema::Table object.
676 The data source can be specified by passing an open DBI database handle, or by
677 passing the DBI data source name, username and password.
679 Although the username and password are optional, it is best to call this method
680 with a database handle or data source including a valid username and password -
681 a DBI connection will be opened and used to check the database version as well
682 as for more reliable quoting and type mapping. Note that the database
683 connection will be used passively, B<not> to actually run the CREATE
686 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
687 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
688 Currently supported databases are MySQL and PostgreSQL.
690 If not passed a data source (or handle), or if there is no driver for the
691 specified database, will attempt to use generic SQL syntax.
695 sub sql_alter_constraints {
696 my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
698 my $driver = _load_driver($dbh);
700 my $table = $self->name;
705 foreach my $foreign_key ( $new->foreign_keys ) {
707 next if grep $foreign_key->cmp($_), $self->foreign_keys;
709 push @at, 'ADD '. $foreign_key->sql_foreign_key;
713 foreach my $foreign_key ( $self->foreign_keys ) {
715 next if grep $foreign_key->cmp($_), $new->foreign_keys;
716 next unless $foreign_key->constraint;
718 push @at, 'DROP CONSTRAINT '. $foreign_key->constraint;
721 return () unless @at;
723 'ALTER TABLE '. $self->name. ' '. join(",\n ", @at)
729 my( $self, $dbh ) = ( shift, _dbh(@_) );
731 my $name = $self->name;
733 ("DROP TABLE $name");
736 =item foreign_keys_sql
740 sub foreign_keys_sql {
742 map $_->sql_foreign_key, $self->foreign_keys;
747 Returns a list of foreign keys (DBIx::DBSchema::ForeignKey objects).
753 exists( $self->{'foreign_keys'} )
754 ? @{ $self->{'foreign_keys'} }
760 my($dbh, $table) = @_;
761 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
763 $sth->execute or die $sth->errstr;
771 Ivan Kohler <ivan-dbix-dbschema@420.am>
773 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
778 Copyright (c) 2000-2007 Ivan Kohler
779 Copyright (c) 2000 Mail Abuse Prevention System LLC
780 Copyright (c) 2007-2013 Freeside Internet Services, Inc.
782 This program is free software; you can redistribute it and/or modify it under
783 the same terms as Perl itself.
787 sql_create_table() has database-specific foo that probably ought to be
788 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
790 sql_alter_table() also has database-specific foo that ought to be abstracted
791 into the DBIx::DBSchema::DBD:: modules.
793 sql_create_table() may change or destroy the object's data. If you need to use
794 the object after sql_create_table, make a copy beforehand.
796 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
798 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
800 indices method should be a setter, not just a getter?
804 L<DBIx::DBSchema>, L<DBIx::DBSchema::Column>, L<DBI>,
805 L<DBIx::DBSchema::Index>, L<DBIx::DBSchema::FoeignKey>