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.
382 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 #Optionally, the data source can be specified by passing an open DBI database
580 #handle, or by passing the DBI data source name, username and password.
582 #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
583 #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
584 #applicable) may also be supported in the future.
586 #If not passed a data source (or handle), or if there is no driver for the
587 #specified database, will attempt to use generic SQL syntax.
591 #gosh, false laziness w/DBSchema::sql_update_schema
593 sub sql_alter_table {
594 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
596 my $driver = _load_driver($dbh);
598 my $table = $self->name;
608 foreach my $column ( $new->columns ) {
610 if ( $self->column($column) ) {
612 warn " $table.$column exists\n" if $DEBUG > 1;
615 $self->column($column)->sql_alter_column( $new->column($column), $dbh );
619 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
622 $new->column($column)->sql_add_column( $dbh );
628 #should eventually drop columns not in $new...
634 my %old_indices = $self->indices;
635 my %new_indices = $new->indices;
637 foreach my $old ( keys %old_indices ) {
639 if ( exists( $new_indices{$old} )
640 && $old_indices{$old}->cmp( $new_indices{$old} )
643 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
644 delete $old_indices{$old};
645 delete $new_indices{$old};
647 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
649 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
654 #warn if there's more than one?
655 my $same = shift @same;
657 warn "index $table.$old is identical to $same; renaming\n"
660 my $temp = 'dbs_temp'.$tempnum++;
662 push @r, "ALTER INDEX $old RENAME TO $temp";
663 push @r_later, "ALTER INDEX $temp RENAME TO $same";
665 delete $old_indices{$old};
666 delete $new_indices{$same};
674 foreach my $old ( keys %old_indices ) {
675 warn "removing obsolete index $table.$old ON ( ".
676 $old_indices{$old}->columns_sql. " )\n"
678 push @r, "DROP INDEX $old".
679 ( $driver eq 'mysql' ? " ON $table" : '');
682 foreach my $new ( keys %new_indices ) {
683 warn "creating new index $table.$new\n" if $DEBUG > 1;
684 push @r, $new_indices{$new}->sql_create_index($table);
688 # return the statements
693 warn join('', map "$_\n", @r)
701 my( $self, $dbh ) = ( shift, _dbh(@_) );
703 my $name = $self->name;
705 ("DROP TABLE $name");
709 my($dbh, $table) = @_;
710 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
712 $sth->execute or die $sth->errstr;
720 Ivan Kohler <ivan-dbix-dbschema@420.am>
722 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
727 Copyright (c) 2000-2007 Ivan Kohler
728 Copyright (c) 2000 Mail Abuse Prevention System LLC
729 Copyright (c) 2007 Freeside Internet Services, Inc.
731 This program is free software; you can redistribute it and/or modify it under
732 the same terms as Perl itself.
736 sql_create_table() has database-specific foo that probably ought to be
737 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
739 sql_alter_table() also has database-specific foo that ought to be abstracted
740 into the DBIx::DBSchema::DBD:: modules.
742 sql_create_table() may change or destroy the object's data. If you need to use
743 the object after sql_create_table, make a copy beforehand.
745 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
747 sql_alter_table ought to drop columns not in $new
749 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
751 indices method should be a setter, not just a getter?
755 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
756 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>