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'} }
455 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
457 Returns a list of SQL statments to create this table.
459 Optionally, the data source can be specified by passing an open DBI database
460 handle, or by passing the DBI data source name, username and password.
462 The data source can be specified by passing an open DBI database handle, or by
463 passing the DBI data source name, username and password.
465 Although the username and password are optional, it is best to call this method
466 with a database handle or data source including a valid username and password -
467 a DBI connection will be opened and the quoting and type mapping will be more
470 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
471 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
472 (if applicable) may also be supported in the future.
476 sub sql_create_table {
477 my($self, $dbh) = ( shift, _dbh(@_) );
479 my $driver = _load_driver($dbh);
481 #should be in the DBD somehwere :/
482 # my $saved_pkey = '';
483 # if ( $driver eq 'Pg' && $self->primary_key ) {
484 # my $pcolumn = $self->column( (
485 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
487 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
488 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
489 # #my $saved_pkey = $self->primary_key;
490 # #$self->primary_key('');
491 # #change it back afterwords :/
494 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
496 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
497 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
502 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
505 if ( $self->unique ) {
507 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
508 " table has deprecated (non-named) unique indices\n";
511 #my($index) = $self->name. "__". $_ . "_idx";
512 #$index =~ s/,\s*/_/g;
513 my $index = $self->name. $indexnum++;
514 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
515 } $self->unique->sql_list;
519 if ( $self->index ) {
521 warn "WARNING: DBIx::DBSchema::Table object for ". $self->name.
522 " table has deprecated (non-named) indices\n";
525 #my($index) = $self->name. "__". $_ . "_idx";
526 #$index =~ s/,\s*/_/g;
527 my $index = $self->name. $indexnum++;
528 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
529 } $self->index->sql_list;
532 my %indices = $self->indices;
533 #push @r, map { $indices{$_}->sql_create_index( $self->name ) } keys %indices;
534 foreach my $index ( keys %indices ) {
535 push @r, $indices{$index}->sql_create_index( $self->name );
538 #$self->primary_key($saved_pkey) if $saved_pkey;
542 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
544 Returns a list of SQL statements to alter this table so that it is identical
545 to the provided table, also a DBIx::DBSchema::Table object.
547 #Optionally, the data source can be specified by passing an open DBI database
548 #handle, or by passing the DBI data source name, username and password.
550 #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
551 #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
552 #applicable) may also be supported in the future.
554 #If not passed a data source (or handle), or if there is no driver for the
555 #specified database, will attempt to use generic SQL syntax.
559 #gosh, false laziness w/DBSchema::sql_update_schema
561 sub sql_alter_table {
562 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
564 my $driver = _load_driver($dbh);
566 my $table = $self->name;
576 foreach my $column ( $new->columns ) {
578 if ( $self->column($column) ) {
580 warn " $table.$column exists\n" if $DEBUG > 1;
583 $self->column($column)->sql_alter_column( $new->column($column), $dbh );
587 warn "column $table.$column does not exist.\n" if $DEBUG > 1;
590 $new->column($column)->sql_add_column( $dbh );
596 #should eventually drop columns not in $new...
602 my %old_indices = $self->indices;
603 my %new_indices = $new->indices;
605 foreach my $old ( keys %old_indices ) {
607 if ( exists( $new_indices{$old} )
608 && $old_indices{$old}->cmp( $new_indices{$old} )
611 warn "index $table.$old is identical; not changing\n" if $DEBUG > 1;
612 delete $old_indices{$old};
613 delete $new_indices{$old};
615 } elsif ( $driver eq 'Pg' and $dbh->{'pg_server_version'} >= 80000 ) {
617 my @same = grep { $old_indices{$old}->cmp_noname( $new_indices{$_} ) }
622 #warn if there's more than one?
623 my $same = shift @same;
625 warn "index $table.$old is identical to $same; renaming\n"
628 my $temp = 'dbs_temp'.$tempnum++;
630 push @r, "ALTER INDEX $old RENAME TO $temp";
631 push @r_later, "ALTER INDEX $temp RENAME TO $same";
633 delete $old_indices{$old};
634 delete $new_indices{$same};
642 foreach my $old ( keys %old_indices ) {
643 warn "removing obsolete index $table.$old ON ( ".
644 $old_indices{$old}->columns_sql. " )\n"
646 push @r, "DROP INDEX $old".
647 ( $driver eq 'mysql' ? " ON $table" : '');
650 foreach my $new ( keys %new_indices ) {
651 warn "creating new index $table.$new\n" if $DEBUG > 1;
652 push @r, $new_indices{$new}->sql_create_index($table);
656 # return the statements
661 warn join('', map "$_\n", @r)
669 my($dbh, $table) = @_;
670 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
672 $sth->execute or die $sth->errstr;
680 Ivan Kohler <ivan-dbix-dbschema@420.am>
682 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
687 Copyright (c) 2000-2007 Ivan Kohler
688 Copyright (c) 2000 Mail Abuse Prevention System LLC
689 Copyright (c) 2007 Freeside Internet Services, Inc.
691 This program is free software; you can redistribute it and/or modify it under
692 the same terms as Perl itself.
696 sql_create_table() has database-specific foo that probably ought to be
697 abstracted into the DBIx::DBSchema::DBD:: modules (or no? it doesn't anymore?).
699 sql_alter_table() also has database-specific foo that ought to be abstracted
700 into the DBIx::DBSchema::DBD:: modules.
702 sql_create_table() may change or destroy the object's data. If you need to use
703 the object after sql_create_table, make a copy beforehand.
705 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
707 sql_alter_table ought to drop columns not in $new
709 Add methods to get and set specific indices, by name? (like column COLUMN_NAME)
711 indices method should be a setter, not just a getter?
715 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
716 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>