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 local_options => OPTIONS,
95 #deprecated# unique => UNIQUE,
96 #deprecated# index => INDEX,
99 TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
100 empty). COLUMNS is a reference to an array of DBIx::DBSchema::Column objects
101 (see L<DBIx::DBSchema::Column>). INDICES is a reference to an array of
102 DBIx::DBSchema::Index objects (see L<DBIx::DBSchema::Index>), or a hash
103 reference of index names (keys) and DBIx::DBSchema::Index objects (values).
104 OPTIONS is a scalar of database-specific table options, such as "WITHOUT OIDS"
105 for Pg or "TYPE=InnoDB" for mysql.
109 UNIQUE was a DBIx::DBSchema::ColGroup::Unique object (see
110 L<DBIx::DBSchema::ColGroup::Unique>). INDEX was a
111 DBIx::DBSchema::ColGroup::Index object (see
112 L<DBIx::DBSchema::ColGroup::Index>).
118 my $class = ref($proto) || $proto;
124 $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
125 $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
127 $self->{indices} = { map { $_->name, $_ } @{$self->{indices}} }
128 if ref($self->{indices}) eq 'ARRAY';
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,
152 #check $primary_key, $unique and $index to make sure they are $columns ?
153 # (and sanity check?)
155 bless ($self, $class);
157 $_->table_obj($self) foreach values %{ $self->{columns} };
162 =item new_odbc DATABASE_HANDLE TABLE_NAME
164 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
165 handle for the specified table. This uses the experimental DBI type_info
166 method to create a table with standard (ODBC) SQL column types that most
167 closely correspond to any non-portable column types. Use this to import a
168 schema that you wish to use with many different database engines. Although
169 primary key and (unique) index information will only be imported from databases
170 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
171 column names and attributes *should* work for any database.
173 Note: the _odbc refers to the column types used and nothing else - you do not
174 have to have ODBC installed or connect to the database via ODBC.
179 # undef => sub { '' },
181 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
183 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
187 my( $proto, $dbh, $name) = @_;
189 my $driver = _load_driver($dbh);
190 my $sth = _null_sth($dbh, $name);
195 ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
201 'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
209 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
210 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
211 "returned no results for type ". $sth->{TYPE}->[$sthpos];
213 my $length = &{ $create_params{ $type_info->{CREATE_PARAMS} } }
219 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
223 DBIx::DBSchema::Column->new({
225 #'type' => "SQL_". uc($type_info->{'TYPE_NAME'}),
226 'type' => $type_info->{'TYPE_NAME'},
227 'null' => $sth->{NULLABLE}->[$sthpos],
229 'default' => $default,
230 #'local' => # DB-local
239 #DBIx::DBSchema::ColGroup::Unique->new(
241 # ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
244 #DBIx::DBSchema::ColGroup::Index->new(
246 # ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
251 'indices' => { map { my $indexname = $_;
253 DBIx::DBSchema::Index->new($indices_hr->{$indexname})
261 =item new_native DATABASE_HANDLE TABLE_NAME
263 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
264 handle for the specified table. This uses database-native methods to read the
265 schema, and will preserve any non-portable column types. The method is only
266 available if there is a DBIx::DBSchema::DBD for the corresponding database
267 engine (currently, MySQL and PostgreSQL).
272 my( $proto, $dbh, $name) = @_;
273 my $driver = _load_driver($dbh);
277 ? eval "DBIx::DBSchema::DBD::$driver->indices(\$dbh, \$name)"
283 'primary_key' => scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
286 map DBIx::DBSchema::Column->new( @{$_} ),
287 eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
291 #DBIx::DBSchema::ColGroup::Unique->new(
292 # [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
294 #DBIx::DBSchema::ColGroup::Index->new(
295 # [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
299 'indices' => { map { my $indexname = $_;
301 DBIx::DBSchema::Index->new($indices_hr->{$indexname})
309 =item addcolumn COLUMN
311 Adds this DBIx::DBSchema::Column object.
316 my($self, $column) = @_;
317 $column->table_obj($self);
318 ${$self->{'columns'}}{$column->name} = $column; #sanity check?
319 push @{$self->{'column_order'}}, $column->name;
322 =item delcolumn COLUMN_NAME
324 Deletes this column. Returns false if no column of this name was found to
325 remove, true otherwise.
330 my($self,$column) = @_;
331 return 0 unless exists $self->{'columns'}{$column};
332 $self->{'columns'}{$column}->table_obj('');
333 delete $self->{'columns'}{$column};
334 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
337 =item name [ TABLE_NAME ]
339 Returns or sets the table name.
345 if ( defined($value) ) {
346 $self->{name} = $value;
352 =item local_options [ OPTIONS ]
354 Returns or sets the database-specific table options string.
360 if ( defined($value) ) {
361 $self->{local_options} = $value;
363 defined $self->{local_options} ? $self->{local_options} : '';
367 =item primary_key [ PRIMARY_KEY ]
369 Returns or sets the primary key.
375 if ( defined($value) ) {
376 $self->{primary_key} = $value;
378 #$self->{primary_key};
379 #hmm. maybe should untaint the entire structure when it comes off disk
380 # cause if you don't trust that, ?
381 $self->{primary_key} =~ /^(\w*)$/
383 or die "Illegal primary key: ", $self->{primary_key};
388 =item unique [ UNIQUE ]
390 This method is deprecated and included for backwards-compatibility only.
391 See L</indices> for the current method to access unique and non-unique index
394 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
401 carp ref($self) . "->unique method is deprecated; see ->indices";
402 #croak ref($self). "->unique method is deprecated; see ->indices";
409 my ($self,$value)=@_;
411 if ( defined($value) ) {
412 $self->{unique} = $value;
418 =item index [ INDEX ]
420 This method is deprecated and included for backwards-compatibility only.
421 See L</indices> for the current method to access unique and non-unique index
424 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
431 carp ref($self). "->index method is deprecated; see ->indices";
432 #croak ref($self). "->index method is deprecated; see ->indices";
441 if ( defined($value) ) {
442 $self->{'index'} = $value;
450 Returns a list consisting of the names of all columns.
456 #keys %{$self->{'columns'}};
458 @{ $self->{'column_order'} };
461 =item column COLUMN_NAME
463 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
469 my($self,$column)=@_;
470 $self->{'columns'}->{$column};
473 =item indices COLUMN_NAME
475 Returns a list of key-value pairs suitable for assigning to a hash. Keys are
476 index names, and values are index objects (see L<DBIx::DBSchema::Index>).
482 exists( $self->{'indices'} )
483 ? %{ $self->{'indices'} }
489 Meet exciting and unique singles using this method!
491 This method returns a list of column names that are indexed with their own,
492 unique, non-compond (that's the "single" part) indices.
498 my %indices = $self->indices;
500 map { ${ $indices{$_}->columns }[0] }
501 grep { $indices{$_}->unique && scalar(@{$indices{$_}->columns}) == 1 }
505 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
507 Returns a list of SQL statments to create this table.
509 Optionally, the data source can be specified by passing an open DBI database
510 handle, or by passing the DBI data source name, username and password.
512 The data source can be specified by passing an open DBI database handle, or by
513 passing the DBI data source name, username and password.
515 Although the username and password are optional, it is best to call this method
516 with a database handle or data source including a valid username and password -
517 a DBI connection will be opened and the quoting and type mapping will be more
520 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
521 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
522 (if applicable) may also be supported in the future.
526 sub sql_create_table {
527 my($self, $dbh) = ( shift, _dbh(@_) );
529 my $driver = _load_driver($dbh);
531 #should be in the DBD somehwere :/
532 # my $saved_pkey = '';
533 # if ( $driver eq 'Pg' && $self->primary_key ) {
534 # my $pcolumn = $self->column( (
535 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
537 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
538 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
539 # #my $saved_pkey = $self->primary_key;
540 # #$self->primary_key('');
541 # #change it back afterwords :/
544 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
546 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
547 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
552 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n".
556 if ( $self->_unique ) {
558 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
559 " table has deprecated (non-named) unique indices\n";
562 #my($index) = $self->name. "__". $_ . "_idx";
563 #$index =~ s/,\s*/_/g;
564 my $index = $self->name. $indexnum++;
565 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
566 } $self->unique->sql_list;
570 if ( $self->_index ) {
572 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
573 " table has deprecated (non-named) indices\n";
576 #my($index) = $self->name. "__". $_ . "_idx";
577 #$index =~ s/,\s*/_/g;
578 my $index = $self->name. $indexnum++;
579 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
580 } $self->index->sql_list;
583 my %indices = $self->indices;
584 #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
585 foreach my $index ( keys %indices ) {
586 push @r, $indices{$index}->sql_create_index( $self->name );
589 #$self->primary_key($saved_pkey) if $saved_pkey;
593 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
595 Returns a list of SQL statements to alter this table so that it is identical
596 to the provided table, also a DBIx::DBSchema::Table object.
598 The data source can be specified by passing an open DBI database handle, or by
599 passing the DBI data source name, username and password.
601 Although the username and password are optional, it is best to call this method
602 with a database handle or data source including a valid username and password -
603 a DBI connection will be opened and used to check the database version as well
604 as for more reliable quoting and type mapping. Note that the database
605 connection will be used passively, B<not> to actually run the CREATE
608 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
609 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
610 Currently supported databases are MySQL and PostgreSQL.
612 If not passed a data source (or handle), or if there is no driver for the
613 specified database, will attempt to use generic SQL syntax.
617 #gosh, false laziness w/DBSchema::sql_update_schema
619 sub sql_alter_table {
620 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
622 my $driver = _load_driver($dbh);
624 my $table = $self->name;
631 # columns (add/alter)
634 foreach my $column ( $new->columns ) {
636 if ( $self->column($column) ) {
638 warn " $table.$column exists\n" if $DEBUG > 1;
641 $self->column($column)->sql_alter_column( $new->column($column), $dbh );
645 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
648 $new->column($column)->sql_add_column( $dbh );
654 #should eventually drop columns not in $new...
660 my %old_indices = $self->indices;
661 my %new_indices = $new->indices;
663 foreach my $old ( keys %old_indices ) {
665 if ( exists( $new_indices{$old} )
666 && $old_indices{$old}->cmp( $new_indices{$old} )
669 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
670 delete $old_indices{$old};
671 delete $new_indices{$old};
673 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
675 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
680 #warn if there's more than one?
681 my $same = shift @same;
683 warn "index $table.$old is identical to $same; renaming\n"
686 my $temp = 'dbs_temp'.$tempnum++;
688 push @r, "ALTER INDEX $old RENAME TO $temp";
689 push @r_later, "ALTER INDEX $temp RENAME TO $same";
691 delete $old_indices{$old};
692 delete $new_indices{$same};
700 foreach my $old ( keys %old_indices ) {
701 warn "removing obsolete index $table.$old ON ( ".
702 $old_indices{$old}->columns_sql. " )\n"
704 push @r, "DROP INDEX $old".
705 ( $driver eq 'mysql' ? " ON $table" : '');
708 foreach my $new ( keys %new_indices ) {
709 warn "creating new index $table.$new\n" if $DEBUG > 1;
710 push @r, $new_indices{$new}->sql_create_index($table);
717 foreach my $column ( grep !$new->column($_), $self->columns ) {
719 warn "column $table.$column should be dropped.\n" if $DEBUG;
721 push @r, $self->column($column)->sql_drop_column( $dbh );
726 # return the statements
731 warn join('', map "$_\n", @r)
739 my( $self, $dbh ) = ( shift, _dbh(@_) );
741 my $name = $self->name;
743 ("DROP TABLE $name");
747 my($dbh, $table) = @_;
748 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
750 $sth->execute or die $sth->errstr;
758 Ivan Kohler <ivan-dbix-dbschema@420.am>
760 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
765 Copyright (c) 2000-2007 Ivan Kohler
766 Copyright (c) 2000 Mail Abuse Prevention System LLC
767 Copyright (c) 2007 Freeside Internet Services, Inc.
769 This program is free software; you can redistribute it and/or modify it under
770 the same terms as Perl itself.
774 sql_create_table() has database-specific foo that probably ought to be
775 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
777 sql_alter_table() also has database-specific foo that ought to be abstracted
778 into the DBIx::DBSchema::DBD:: modules.
780 sql_create_table() may change or destroy the object's data. If you need to use
781 the object after sql_create_table, make a copy beforehand.
783 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
785 sql_alter_table ought to drop columns not in $new
787 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
789 indices method should be a setter, not just a getter?
793 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
794 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>