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";
386 if ( defined($value) ) {
387 $self->{unique} = $value;
393 =item index [ INDEX ]
395 This method is deprecated and included for backwards-compatibility only.
396 See L</indices> for the current method to access unique and non-unique index
399 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
406 carp ref($self). "->index method is deprecated; see ->indices";
407 #croak ref($self). "->index method is deprecated; see ->indices";
409 if ( defined($value) ) {
410 $self->{'index'} = $value;
418 Returns a list consisting of the names of all columns.
424 #keys %{$self->{'columns'}};
426 @{ $self->{'column_order'} };
429 =item column COLUMN_NAME
431 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
437 my($self,$column)=@_;
438 $self->{'columns'}->{$column};
441 =item indices COLUMN_NAME
443 Returns a list of key-value pairs suitable for assigning to a hash. Keys are
444 index names, and values are index objects (see L<DBIx::DBSchema::Index>).
450 exists( $self->{'indices'} )
451 ? %{ $self->{'indices'} }
457 Meet exciting and unique singles using this method!
459 This method returns a list of column names that are indexed with their own,
460 unique, non-compond (that's the "single" part) indices.
466 my %indices = $self->indices;
468 map { ${ $indices{$_}->columns }[0] }
469 grep { $indices{$_}->unique && scalar(@{$indices{$_}->columns}) == 1 }
473 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
475 Returns a list of SQL statments to create this table.
477 Optionally, the data source can be specified by passing an open DBI database
478 handle, or by passing the DBI data source name, username and password.
480 The data source can be specified by passing an open DBI database handle, or by
481 passing the DBI data source name, username and password.
483 Although the username and password are optional, it is best to call this method
484 with a database handle or data source including a valid username and password -
485 a DBI connection will be opened and the quoting and type mapping will be more
488 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
489 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
490 (if applicable) may also be supported in the future.
494 sub sql_create_table {
495 my($self, $dbh) = ( shift, _dbh(@_) );
497 my $driver = _load_driver($dbh);
499 #should be in the DBD somehwere :/
500 # my $saved_pkey = '';
501 # if ( $driver eq 'Pg' && $self->primary_key ) {
502 # my $pcolumn = $self->column( (
503 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
505 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
506 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
507 # #my $saved_pkey = $self->primary_key;
508 # #$self->primary_key('');
509 # #change it back afterwords :/
512 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
514 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
515 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
520 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
523 if ( $self->unique ) {
525 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
526 " table has deprecated (non-named) unique indices\n";
529 #my($index) = $self->name. "__". $_ . "_idx";
530 #$index =~ s/,\s*/_/g;
531 my $index = $self->name. $indexnum++;
532 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
533 } $self->unique->sql_list;
537 if ( $self->index ) {
539 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
540 " table has deprecated (non-named) indices\n";
543 #my($index) = $self->name. "__". $_ . "_idx";
544 #$index =~ s/,\s*/_/g;
545 my $index = $self->name. $indexnum++;
546 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
547 } $self->index->sql_list;
550 my %indices = $self->indices;
551 #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
552 foreach my $index ( keys %indices ) {
553 push @r, $indices{$index}->sql_create_index( $self->name );
556 #$self->primary_key($saved_pkey) if $saved_pkey;
560 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
562 Returns a list of SQL statements to alter this table so that it is identical
563 to the provided table, also a DBIx::DBSchema::Table object.
565 #Optionally, the data source can be specified by passing an open DBI database
566 #handle, or by passing the DBI data source name, username and password.
568 #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
569 #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
570 #applicable) may also be supported in the future.
572 #If not passed a data source (or handle), or if there is no driver for the
573 #specified database, will attempt to use generic SQL syntax.
577 #gosh, false laziness w/DBSchema::sql_update_schema
579 sub sql_alter_table {
580 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
582 my $driver = _load_driver($dbh);
584 my $table = $self->name;
594 foreach my $column ( $new->columns ) {
596 if ( $self->column($column) ) {
598 warn " $table.$column exists\n" if $DEBUG > 1;
601 $self->column($column)->sql_alter_column( $new->column($column), $dbh );
605 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
608 $new->column($column)->sql_add_column( $dbh );
614 #should eventually drop columns not in $new...
620 my %old_indices = $self->indices;
621 my %new_indices = $new->indices;
623 foreach my $old ( keys %old_indices ) {
625 if ( exists( $new_indices{$old} )
626 && $old_indices{$old}->cmp( $new_indices{$old} )
629 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
630 delete $old_indices{$old};
631 delete $new_indices{$old};
633 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
635 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
640 #warn if there's more than one?
641 my $same = shift @same;
643 warn "index $table.$old is identical to $same; renaming\n"
646 my $temp = 'dbs_temp'.$tempnum++;
648 push @r, "ALTER INDEX $old RENAME TO $temp";
649 push @r_later, "ALTER INDEX $temp RENAME TO $same";
651 delete $old_indices{$old};
652 delete $new_indices{$same};
660 foreach my $old ( keys %old_indices ) {
661 warn "removing obsolete index $table.$old ON ( ".
662 $old_indices{$old}->columns_sql. " )\n"
664 push @r, "DROP INDEX $old".
665 ( $driver eq 'mysql' ? " ON $table" : '');
668 foreach my $new ( keys %new_indices ) {
669 warn "creating new index $table.$new\n" if $DEBUG > 1;
670 push @r, $new_indices{$new}->sql_create_index($table);
674 # return the statements
679 warn join('', map "$_\n", @r)
687 my( $self, $dbh ) = ( shift, _dbh(@_) );
689 my $name = $self->name;
691 ("DROP TABLE $name");
695 my($dbh, $table) = @_;
696 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
698 $sth->execute or die $sth->errstr;
706 Ivan Kohler <ivan-dbix-dbschema@420.am>
708 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
713 Copyright (c) 2000-2007 Ivan Kohler
714 Copyright (c) 2000 Mail Abuse Prevention System LLC
715 Copyright (c) 2007 Freeside Internet Services, Inc.
717 This program is free software; you can redistribute it and/or modify it under
718 the same terms as Perl itself.
722 sql_create_table() has database-specific foo that probably ought to be
723 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
725 sql_alter_table() also has database-specific foo that ought to be abstracted
726 into the DBIx::DBSchema::DBD:: modules.
728 sql_create_table() may change or destroy the object's data. If you need to use
729 the object after sql_create_table, make a copy beforehand.
731 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
733 sql_alter_table ought to drop columns not in $new
735 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
737 indices method should be a setter, not just a getter?
741 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
742 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>