1 package DBIx::DBSchema::Table;
4 use vars qw($VERSION $DEBUG %create_params);
7 use DBIx::DBSchema::_util qw(_load_driver _dbh);
8 use DBIx::DBSchema::Column 0.07;
9 use DBIx::DBSchema::Index;
10 use DBIx::DBSchema::ColGroup::Unique;
11 use DBIx::DBSchema::ColGroup::Index;
18 DBIx::DBSchema::Table - Table objects
22 use DBIx::DBSchema::Table;
24 #new style (preferred), pass a hashref of parameters
25 $table = new DBIx::DBSchema::Table (
28 primary_key => "primary_key",
29 columns => \@dbix_dbschema_column_objects,
30 #deprecated# unique => $dbix_dbschema_colgroup_unique_object,
31 #deprecated# 'index' => $dbix_dbschema_colgroup_index_object,
32 indices => \@dbix_dbschema_index_objects,
36 #old style (VERY deprecated)
37 $table = new DBIx::DBSchema::Table (
40 $dbix_dbschema_colgroup_unique_object,
41 $dbix_dbschema_colgroup_index_object,
42 @dbix_dbschema_column_objects,
45 $table->addcolumn ( $dbix_dbschema_column_object );
47 $table_name = $table->name;
48 $table->name("table_name");
50 $primary_key = $table->primary_key;
51 $table->primary_key("primary_key");
53 #deprecated# $dbix_dbschema_colgroup_unique_object = $table->unique;
54 #deprecated# $table->unique( $dbix_dbschema__colgroup_unique_object );
56 #deprecated# $dbix_dbschema_colgroup_index_object = $table->index;
57 #deprecated# $table->index( $dbix_dbschema_colgroup_index_object );
59 %indices = $table->indices;
60 $dbix_dbschema_index_object = $indices{'index_name'};
61 @all_index_names = keys %indices;
62 @all_dbix_dbschema_index_objects = values %indices;
64 @column_names = $table->columns;
66 $dbix_dbschema_column_object = $table->column("column");
69 @sql_statements = $table->sql_create_table( $dbh );
70 @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
73 @sql_statements = $table->sql_create_table( $datasrc );
74 @sql_statements = $table->sql_create_table;
78 DBIx::DBSchema::Table objects represent a single database table.
86 Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
87 hash reference of named parameters.
91 primary_key => PRIMARY_KEY,
94 #deprecated# unique => UNIQUE,
95 #deprecated# index => INDEX,
98 TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
99 empty). COLUMNS is a reference to an array of DBIx::DBSchema::Column objects
100 (see L<DBIx::DBSchema::Column>). INDICES is a reference to an array of
101 DBIx::DBSchema::Index objects (see L<DBIx::DBSchema::Index>), or a hash
102 reference of index names (keys) and DBIx::DBSchema::Index objects (values).
106 UNIQUE was a DBIx::DBSchema::ColGroup::Unique object (see
107 L<DBIx::DBSchema::ColGroup::Unique>). INDEX was a
108 DBIx::DBSchema::ColGroup::Index object (see
109 L<DBIx::DBSchema::ColGroup::Index>).
115 my $class = ref($proto) || $proto;
121 $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
122 $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
124 $self->{indices} = { map { $_->name, $_ } @{$self->{indices}} }
125 if ref($self->{indices}) eq 'ARRAY';
129 carp "Old-style $class creation without named parameters is deprecated!";
130 #croak "FATAL: old-style $class creation no longer supported;".
131 # " use named parameters";
133 my($name,$primary_key,$unique,$index,@columns) = @_;
135 my %columns = map { $_->name, $_ } @columns;
136 my @column_order = map { $_->name } @columns;
140 'primary_key' => $primary_key,
143 'columns' => \%columns,
144 'column_order' => \@column_order,
149 #check $primary_key, $unique and $index to make sure they are $columns ?
150 # (and sanity check?)
152 bless ($self, $class);
154 $_->table_obj($self) foreach values %{ $self->{columns} };
159 =item new_odbc DATABASE_HANDLE TABLE_NAME
161 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
162 handle for the specified table. This uses the experimental DBI type_info
163 method to create a table with standard (ODBC) SQL column types that most
164 closely correspond to any non-portable column types. Use this to import a
165 schema that you wish to use with many different database engines. Although
166 primary key and (unique) index information will only be imported from databases
167 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
168 column names and attributes *should* work for any database.
170 Note: the _odbc refers to the column types used and nothing else - you do not
171 have to have ODBC installed or connect to the database via ODBC.
176 # undef => sub { '' },
178 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
180 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
184 my( $proto, $dbh, $name) = @_;
186 my $driver = _load_driver($dbh);
187 my $sth = _null_sth($dbh, $name);
192 ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
198 'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
206 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
207 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
208 "returned no results for type ". $sth->{TYPE}->[$sthpos];
210 my $length = &{ $create_params{ $type_info->{CREATE_PARAMS} } }
216 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
220 DBIx::DBSchema::Column->new({
222 #'type' => "SQL_". uc($type_info->{'TYPE_NAME'}),
223 'type' => $type_info->{'TYPE_NAME'},
224 'null' => $sth->{NULLABLE}->[$sthpos],
226 'default' => $default,
227 #'local' => # DB-local
236 #DBIx::DBSchema::ColGroup::Unique->new(
238 # ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
241 #DBIx::DBSchema::ColGroup::Index->new(
243 # ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
248 'indices' => { map { my $indexname = $_;
250 DBIx::DBSchema::Index->new($indices_hr->{$indexname})
258 =item new_native DATABASE_HANDLE TABLE_NAME
260 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
261 handle for the specified table. This uses database-native methods to read the
262 schema, and will preserve any non-portable column types. The method is only
263 available if there is a DBIx::DBSchema::DBD for the corresponding database
264 engine (currently, MySQL and PostgreSQL).
269 my( $proto, $dbh, $name) = @_;
270 my $driver = _load_driver($dbh);
274 ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
280 'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
283 map DBIx::DBSchema::Column->new( @{$_} ),
284 eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
288 #DBIx::DBSchema::ColGroup::Unique->new(
289 # [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
291 #DBIx::DBSchema::ColGroup::Index->new(
292 # [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
296 'indices' => { map { my $indexname = $_;
298 DBIx::DBSchema::Index->new($indices_hr->{$indexname})
306 =item addcolumn COLUMN
308 Adds this DBIx::DBSchema::Column object.
313 my($self, $column) = @_;
314 $column->table_obj($self);
315 ${$self->{'columns'}}{$column->name} = $column; #sanity check?
316 push @{$self->{'column_order'}}, $column->name;
319 =item delcolumn COLUMN_NAME
321 Deletes this column. Returns false if no column of this name was found to
322 remove, true otherwise.
327 my($self,$column) = @_;
328 return 0 unless exists $self->{'columns'}{$column};
329 $self->{'columns'}{$column}->table_obj('');
330 delete $self->{'columns'}{$column};
331 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
334 =item name [ TABLE_NAME ]
336 Returns or sets the table name.
342 if ( defined($value) ) {
343 $self->{name} = $value;
349 =item primary_key [ PRIMARY_KEY ]
351 Returns or sets the primary key.
357 if ( defined($value) ) {
358 $self->{primary_key} = $value;
360 #$self->{primary_key};
361 #hmm. maybe should untaint the entire structure when it comes off disk
362 # cause if you don't trust that, ?
363 $self->{primary_key} =~ /^(\w*)$/
365 or die "Illegal primary key: ", $self->{primary_key};
370 =item unique [ UNIQUE ]
372 This method is deprecated and included for backwards-compatibility only.
373 See L</indices> for the current method to access unique and non-unique index
376 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
383 carp ref($self) . "->unique method is deprecated; see ->indices";
384 #croak ref($self). "->unique method is deprecated; see ->indices";
391 my ($self,$value)=@_;
393 if ( defined($value) ) {
394 $self->{unique} = $value;
400 =item index [ INDEX ]
402 This method is deprecated and included for backwards-compatibility only.
403 See L</indices> for the current method to access unique and non-unique index
406 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
413 carp ref($self). "->index method is deprecated; see ->indices";
414 #croak ref($self). "->index method is deprecated; see ->indices";
423 if ( defined($value) ) {
424 $self->{'index'} = $value;
432 Returns a list consisting of the names of all columns.
438 #keys %{$self->{'columns'}};
440 @{ $self->{'column_order'} };
443 =item column COLUMN_NAME
445 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
451 my($self,$column)=@_;
452 $self->{'columns'}->{$column};
455 =item indices COLUMN_NAME
457 Returns a list of key-value pairs suitable for assigning to a hash. Keys are
458 index names, and values are index objects (see L<DBIx::DBSchema::Index>).
464 exists( $self->{'indices'} )
465 ? %{ $self->{'indices'} }
471 Meet exciting and unique singles using this method!
473 This method returns a list of column names that are indexed with their own,
474 unique, non-compond (that's the "single" part) indices.
480 my %indices = $self->indices;
482 map { ${ $indices{$_}->columns }[0] }
483 grep { $indices{$_}->unique && scalar(@{$indices{$_}->columns}) == 1 }
487 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
489 Returns a list of SQL statments to create this table.
491 Optionally, the data source can be specified by passing an open DBI database
492 handle, or by passing the DBI data source name, username and password.
494 The data source can be specified by passing an open DBI database handle, or by
495 passing the DBI data source name, username and password.
497 Although the username and password are optional, it is best to call this method
498 with a database handle or data source including a valid username and password -
499 a DBI connection will be opened and the quoting and type mapping will be more
502 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
503 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
504 (if applicable) may also be supported in the future.
508 sub sql_create_table {
509 my($self, $dbh) = ( shift, _dbh(@_) );
511 my $driver = _load_driver($dbh);
513 #should be in the DBD somehwere :/
514 # my $saved_pkey = '';
515 # if ( $driver eq 'Pg' && $self->primary_key ) {
516 # my $pcolumn = $self->column( (
517 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
519 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
520 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
521 # #my $saved_pkey = $self->primary_key;
522 # #$self->primary_key('');
523 # #change it back afterwords :/
526 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
528 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
529 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
534 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
537 if ( $self->_unique ) {
539 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
540 " table has deprecated (non-named) unique indices\n";
543 #my($index) = $self->name. "__". $_ . "_idx";
544 #$index =~ s/,\s*/_/g;
545 my $index = $self->name. $indexnum++;
546 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
547 } $self->unique->sql_list;
551 if ( $self->_index ) {
553 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
554 " table has deprecated (non-named) indices\n";
557 #my($index) = $self->name. "__". $_ . "_idx";
558 #$index =~ s/,\s*/_/g;
559 my $index = $self->name. $indexnum++;
560 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
561 } $self->index->sql_list;
564 my %indices = $self->indices;
565 #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
566 foreach my $index ( keys %indices ) {
567 push @r, $indices{$index}->sql_create_index( $self->name );
570 #$self->primary_key($saved_pkey) if $saved_pkey;
574 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
576 Returns a list of SQL statements to alter this table so that it is identical
577 to the provided table, also a DBIx::DBSchema::Table object.
579 The data source can be specified by passing an open DBI database handle, or by
580 passing the DBI data source name, username and password.
582 Although the username and password are optional, it is best to call this method
583 with a database handle or data source including a valid username and password -
584 a DBI connection will be opened and used to check the database version as well
585 as for more reliable quoting and type mapping. Note that the database
586 connection will be used passively, B<not> to actually run the CREATE
589 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
590 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
591 Currently supported databases are MySQL and PostgreSQL.
593 If not passed a data source (or handle), or if there is no driver for the
594 specified database, will attempt to use generic SQL syntax.
598 #gosh, false laziness w/DBSchema::sql_update_schema
600 sub sql_alter_table {
601 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
603 my $driver = _load_driver($dbh);
605 my $table = $self->name;
612 # columns (add/alter)
615 foreach my $column ( $new->columns ) {
617 if ( $self->column($column) ) {
619 warn " $table.$column exists\n" if $DEBUG > 1;
622 $self->column($column)->sql_alter_column( $new->column($column), $dbh );
626 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
629 $new->column($column)->sql_add_column( $dbh );
635 #should eventually drop columns not in $new...
641 my %old_indices = $self->indices;
642 my %new_indices = $new->indices;
644 foreach my $old ( keys %old_indices ) {
646 if ( exists( $new_indices{$old} )
647 && $old_indices{$old}->cmp( $new_indices{$old} )
650 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
651 delete $old_indices{$old};
652 delete $new_indices{$old};
654 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
656 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
661 #warn if there's more than one?
662 my $same = shift @same;
664 warn "index $table.$old is identical to $same; renaming\n"
667 my $temp = 'dbs_temp'.$tempnum++;
669 push @r, "ALTER INDEX $old RENAME TO $temp";
670 push @r_later, "ALTER INDEX $temp RENAME TO $same";
672 delete $old_indices{$old};
673 delete $new_indices{$same};
681 foreach my $old ( keys %old_indices ) {
682 warn "removing obsolete index $table.$old ON ( ".
683 $old_indices{$old}->columns_sql. " )\n"
685 push @r, "DROP INDEX $old".
686 ( $driver eq 'mysql' ? " ON $table" : '');
689 foreach my $new ( keys %new_indices ) {
690 warn "creating new index $table.$new\n" if $DEBUG > 1;
691 push @r, $new_indices{$new}->sql_create_index($table);
698 foreach my $column ( grep !$new->column($_), $self->columns ) {
700 warn "column $table.$column should be dropped.\n" if $DEBUG;
702 push @r, $self->column($column)->sql_drop_column( $dbh );
707 # return the statements
712 warn join('', map "$_\n", @r)
720 my( $self, $dbh ) = ( shift, _dbh(@_) );
722 my $name = $self->name;
724 ("DROP TABLE $name");
728 my($dbh, $table) = @_;
729 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
731 $sth->execute or die $sth->errstr;
739 Ivan Kohler <ivan-dbix-dbschema@420.am>
741 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
746 Copyright (c) 2000-2007 Ivan Kohler
747 Copyright (c) 2000 Mail Abuse Prevention System LLC
748 Copyright (c) 2007 Freeside Internet Services, Inc.
750 This program is free software; you can redistribute it and/or modify it under
751 the same terms as Perl itself.
755 sql_create_table() has database-specific foo that probably ought to be
756 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
758 sql_alter_table() also has database-specific foo that ought to be abstracted
759 into the DBIx::DBSchema::DBD:: modules.
761 sql_create_table() may change or destroy the object's data. If you need to use
762 the object after sql_create_table, make a copy beforehand.
764 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
766 sql_alter_table ought to drop columns not in $new
768 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
770 indices method should be a setter, not just a getter?
774 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
775 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>