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;
10 our $VERSION = '0.09';
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 Optionally, the data source can be specified by passing an open DBI database
439 handle, or by passing the DBI data source name, username and password.
441 The data source can be specified by passing an open DBI database handle, or by
442 passing the DBI data source name, username and password.
444 Although the username and password are optional, it is best to call this method
445 with a database handle or data source including a valid username and password -
446 a DBI connection will be opened and the quoting and type mapping will be more
449 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
450 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
451 (if applicable) may also be supported in the future.
455 sub sql_create_table {
456 my($self, $dbh) = ( shift, _dbh(@_) );
458 my $driver = _load_driver($dbh);
460 #should be in the DBD somehwere :/
461 # my $saved_pkey = '';
462 # if ( $driver eq 'Pg' && $self->primary_key ) {
463 # my $pcolumn = $self->column( (
464 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
466 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
467 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
468 # #my $saved_pkey = $self->primary_key;
469 # #$self->primary_key('');
470 # #change it back afterwords :/
473 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
475 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
476 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
478 push @columns, $self->foreign_keys_sql;
483 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n".
487 if ( $self->_unique ) {
489 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
490 " table has deprecated (non-named) unique indices\n";
493 #my($index) = $self->name. "__". $_ . "_idx";
494 #$index =~ s/,\s*/_/g;
495 my $index = $self->name. $indexnum++;
496 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
497 } $self->unique->sql_list;
501 if ( $self->_index ) {
503 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
504 " table has deprecated (non-named) indices\n";
507 #my($index) = $self->name. "__". $_ . "_idx";
508 #$index =~ s/,\s*/_/g;
509 my $index = $self->name. $indexnum++;
510 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
511 } $self->index->sql_list;
514 my %indices = $self->indices;
515 #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
516 foreach my $index ( keys %indices ) {
517 push @r, $indices{$index}->sql_create_index( $self->name );
520 #$self->primary_key($saved_pkey) if $saved_pkey;
524 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
526 Returns a list of SQL statements to alter this table so that it is identical
527 to the provided table, also a DBIx::DBSchema::Table object.
529 The data source can be specified by passing an open DBI database handle, or by
530 passing the DBI data source name, username and password.
532 Although the username and password are optional, it is best to call this method
533 with a database handle or data source including a valid username and password -
534 a DBI connection will be opened and used to check the database version as well
535 as for more reliable quoting and type mapping. Note that the database
536 connection will be used passively, B<not> to actually run the CREATE
539 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
540 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
541 Currently supported databases are MySQL and PostgreSQL.
543 If not passed a data source (or handle), or if there is no driver for the
544 specified database, will attempt to use generic SQL syntax.
548 #gosh, false laziness w/DBSchema::sql_update_schema
550 sub sql_alter_table {
551 my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
553 my $driver = _load_driver($dbh);
555 my $table = $self->name;
563 # columns (add/alter)
566 foreach my $column ( $new->columns ) {
568 if ( $self->column($column) ) {
569 warn " $table.$column exists\n" if $DEBUG > 1;
571 my ($alter_table, $sql) =
572 $self->column($column)->sql_alter_column( $new->column($column),
576 push @at, @$alter_table;
580 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
582 my ($alter_table, $sql) = $new->column($column)->sql_add_column( $dbh );
583 push @at, @$alter_table;
594 my %old_indices = $self->indices;
595 my %new_indices = $new->indices;
597 foreach my $old ( keys %old_indices ) {
599 if ( exists( $new_indices{$old} )
600 && $old_indices{$old}->cmp( $new_indices{$old} )
603 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
604 delete $old_indices{$old};
605 delete $new_indices{$old};
607 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
609 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
614 #warn if there's more than one?
615 my $same = shift @same;
617 warn "index $table.$old is identical to $same; renaming\n"
620 my $temp = 'dbs_temp'.$tempnum++;
622 push @r, "ALTER INDEX $old RENAME TO $temp";
623 push @r_later, "ALTER INDEX $temp RENAME TO $same";
625 delete $old_indices{$old};
626 delete $new_indices{$same};
634 foreach my $old ( keys %old_indices ) {
635 warn "removing obsolete index $table.$old ON ( ".
636 $old_indices{$old}->columns_sql. " )\n"
638 push @r, "DROP INDEX $old".
639 ( $driver eq 'mysql' ? " ON $table" : '');
642 foreach my $new ( keys %new_indices ) {
643 warn "creating new index $table.$new\n" if $DEBUG > 1;
644 push @r, $new_indices{$new}->sql_create_index($table);
651 foreach my $column ( grep !$new->column($_), $self->columns ) {
653 warn "column $table.$column should be dropped.\n" if $DEBUG;
655 push @at, $self->column($column)->sql_drop_column( $dbh );
663 foreach my $foreign_key ( $new->foreign_keys ) {
665 next if grep $foreign_key->cmp($_), $self->foreign_keys;
667 push @at, 'ADD '. $foreign_key->sql_foreign_key;
670 # XXX foreign keys modify / drop
673 # return the statements
676 unshift @r, "ALTER TABLE $table ". join(', ', @at) if @at;
680 warn join('', map "$_\n", @r)
688 my( $self, $dbh ) = ( shift, _dbh(@_) );
690 my $name = $self->name;
692 ("DROP TABLE $name");
695 =item foreign_keys_sql
699 sub foreign_keys_sql {
701 map $_->sql_foreign_key, $self->foreign_keys;
706 Returns a list of foreign keys (DBIx::DBSchema::ForeignKey objects).
712 exists( $self->{'foreign_keys'} )
713 ? @{ $self->{'foreign_keys'} }
719 my($dbh, $table) = @_;
720 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
722 $sth->execute or die $sth->errstr;
730 Ivan Kohler <ivan-dbix-dbschema@420.am>
732 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
737 Copyright (c) 2000-2007 Ivan Kohler
738 Copyright (c) 2000 Mail Abuse Prevention System LLC
739 Copyright (c) 2007-2013 Freeside Internet Services, Inc.
741 This program is free software; you can redistribute it and/or modify it under
742 the same terms as Perl itself.
746 sql_create_table() has database-specific foo that probably ought to be
747 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
749 sql_alter_table() also has database-specific foo that ought to be abstracted
750 into the DBIx::DBSchema::DBD:: modules.
752 sql_create_table() may change or destroy the object's data. If you need to use
753 the object after sql_create_table, make a copy beforehand.
755 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
757 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
759 indices method should be a setter, not just a getter?
763 L<DBIx::DBSchema>, L<DBIx::DBSchema::Column>, L<DBI>,
764 L<DBIx::DBSchema::Index>, L<DBIx::DBSchema::FoeignKey>