1 package DBIx::DBSchema::Table;
4 use vars qw(@ISA $VERSION $DEBUG %create_params);
7 use DBIx::DBSchema::_util qw(_load_driver _dbh);
8 use DBIx::DBSchema::Column 0.07;
9 use DBIx::DBSchema::ColGroup::Unique;
10 use DBIx::DBSchema::ColGroup::Index;
20 DBIx::DBSchema::Table - Table objects
24 use DBIx::DBSchema::Table;
26 #old style (depriciated)
27 $table = new DBIx::DBSchema::Table (
30 $dbix_dbschema_colgroup_unique_object,
31 $dbix_dbschema_colgroup_index_object,
32 @dbix_dbschema_column_objects,
35 #new style (preferred), pass a hashref of parameters
36 $table = new DBIx::DBSchema::Table (
39 primary_key => "primary_key",
40 unique => $dbix_dbschema_colgroup_unique_object,
41 'index' => $dbix_dbschema_colgroup_index_object,
42 columns => \@dbix_dbschema_column_objects,
46 $table->addcolumn ( $dbix_dbschema_column_object );
48 $table_name = $table->name;
49 $table->name("table_name");
51 $primary_key = $table->primary_key;
52 $table->primary_key("primary_key");
54 $dbix_dbschema_colgroup_unique_object = $table->unique;
55 $table->unique( $dbix_dbschema__colgroup_unique_object );
57 $dbix_dbschema_colgroup_index_object = $table->index;
58 $table->index( $dbix_dbschema_colgroup_index_object );
60 @column_names = $table->columns;
62 $dbix_dbschema_column_object = $table->column("column");
65 @sql_statements = $table->sql_create_table( $dbh );
66 @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
69 @sql_statements = $table->sql_create_table( $datasrc );
70 @sql_statements = $table->sql_create_table;
74 DBIx::DBSchema::Table objects represent a single database table.
80 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
84 Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
85 hash reference of named parameters.
89 primary_key => PRIMARY_KEY,
95 TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
96 empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
97 L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
98 DBIx::DBSchema::ColGroup::Index object (see
99 L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of
100 DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
106 my $class = ref($proto) || $proto;
112 $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
113 $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
117 my($name,$primary_key,$unique,$index,@columns) = @_;
119 my %columns = map { $_->name, $_ } @columns;
120 my @column_order = map { $_->name } @columns;
124 'primary_key' => $primary_key,
127 'columns' => \%columns,
128 'column_order' => \@column_order,
133 #check $primary_key, $unique and $index to make sure they are $columns ?
134 # (and sanity check?)
136 bless ($self, $class);
138 $_->table_obj($self) foreach values %{ $self->{columns} };
143 =item new_odbc DATABASE_HANDLE TABLE_NAME
145 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
146 handle for the specified table. This uses the experimental DBI type_info
147 method to create a table with standard (ODBC) SQL column types that most
148 closely correspond to any non-portable column types. Use this to import a
149 schema that you wish to use with many different database engines. Although
150 primary key and (unique) index information will only be imported from databases
151 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
152 column names and attributes *should* work for any database.
154 Note: the _odbc refers to the column types used and nothing else - you do not
155 have to have ODBC installed or connect to the database via ODBC.
160 # undef => sub { '' },
162 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
164 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
168 my( $proto, $dbh, $name) = @_;
169 my $driver = _load_driver($dbh);
170 my $sth = _null_sth($dbh, $name);
174 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
175 DBIx::DBSchema::ColGroup::Unique->new(
177 ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
180 DBIx::DBSchema::ColGroup::Index->new(
182 ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
186 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
187 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
188 "returned no results for type ". $sth->{TYPE}->[$sthpos];
189 new DBIx::DBSchema::Column
191 $type_info->{'TYPE_NAME'},
192 #"SQL_". uc($type_info->{'TYPE_NAME'}),
193 $sth->{NULLABLE}->[$sthpos],
194 &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
196 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
203 =item new_native DATABASE_HANDLE TABLE_NAME
205 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
206 handle for the specified table. This uses database-native methods to read the
207 schema, and will preserve any non-portable column types. The method is only
208 available if there is a DBIx::DBSchema::DBD for the corresponding database
209 engine (currently, MySQL and PostgreSQL).
214 my( $proto, $dbh, $name) = @_;
215 my $driver = _load_driver($dbh);
218 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
219 DBIx::DBSchema::ColGroup::Unique->new(
220 [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
222 DBIx::DBSchema::ColGroup::Index->new(
223 [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
226 DBIx::DBSchema::Column->new( @{$_} )
227 } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
231 =item addcolumn COLUMN
233 Adds this DBIx::DBSchema::Column object.
238 my($self, $column) = @_;
239 $column->table_obj($self);
240 ${$self->{'columns'}}{$column->name} = $column; #sanity check?
241 push @{$self->{'column_order'}}, $column->name;
244 =item delcolumn COLUMN_NAME
246 Deletes this column. Returns false if no column of this name was found to
247 remove, true otherwise.
252 my($self,$column) = @_;
253 return 0 unless exists $self->{'columns'}{$column};
254 $self->{'columns'}{$column}->table_obj('');
255 delete $self->{'columns'}{$column};
256 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
259 =item name [ TABLE_NAME ]
261 Returns or sets the table name.
267 if ( defined($value) ) {
268 $self->{name} = $value;
274 =item primary_key [ PRIMARY_KEY ]
276 Returns or sets the primary key.
282 if ( defined($value) ) {
283 $self->{primary_key} = $value;
285 #$self->{primary_key};
286 #hmm. maybe should untaint the entire structure when it comes off disk
287 # cause if you don't trust that, ?
288 $self->{primary_key} =~ /^(\w*)$/
290 or die "Illegal primary key: ", $self->{primary_key};
295 =item unique [ UNIQUE ]
297 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
303 if ( defined($value) ) {
304 $self->{unique} = $value;
310 =item index [ INDEX ]
312 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
318 if ( defined($value) ) {
319 $self->{'index'} = $value;
327 Returns a list consisting of the names of all columns.
333 #keys %{$self->{'columns'}};
335 @{ $self->{'column_order'} };
338 =item column COLUMN_NAME
340 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
346 my($self,$column)=@_;
347 $self->{'columns'}->{$column};
350 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
352 Returns a list of SQL statments to create this table.
354 Optionally, the data source can be specified by passing an open DBI database
355 handle, or by passing the DBI data source name, username and password.
357 The data source can be specified by passing an open DBI database handle, or by
358 passing the DBI data source name, username and password.
360 Although the username and password are optional, it is best to call this method
361 with a database handle or data source including a valid username and password -
362 a DBI connection will be opened and the quoting and type mapping will be more
365 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
366 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
367 (if applicable) may also be supported in the future.
371 sub sql_create_table {
372 my($self, $dbh) = ( shift, _dbh(@_) );
374 my $driver = _load_driver($dbh);
376 #should be in the DBD somehwere :/
377 # my $saved_pkey = '';
378 # if ( $driver eq 'Pg' && $self->primary_key ) {
379 # my $pcolumn = $self->column( (
380 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
382 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
383 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
384 # #my $saved_pkey = $self->primary_key;
385 # #$self->primary_key('');
386 # #change it back afterwords :/
389 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
391 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
392 if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
397 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
401 #my($index) = $self->name. "__". $_ . "_idx";
402 #$index =~ s/,\s*/_/g;
403 my $index = $self->name. $indexnum++;
404 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
405 } $self->unique->sql_list
409 #my($index) = $self->name. "__". $_ . "_idx";
410 #$index =~ s/,\s*/_/g;
411 my $index = $self->name. $indexnum++;
412 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
413 } $self->index->sql_list
416 #$self->primary_key($saved_pkey) if $saved_pkey;
420 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
422 Returns a list of SQL statements to alter this table so that it is identical
423 to the provided table, also a DBIx::DBSchema::Table object.
425 #Optionally, the data source can be specified by passing an open DBI database
426 #handle, or by passing the DBI data source name, username and password.
428 #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
429 #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
430 #applicable) may also be supported in the future.
432 #If not passed a data source (or handle), or if there is no driver for the
433 #specified database, will attempt to use generic SQL syntax.
437 #gosh, false laziness w/DBSchema::sql_update_schema
439 sub sql_alter_table {
440 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
442 my $table = $self->name;
446 foreach my $column ( $new->columns ) {
448 if ( $self->column($column) ) {
450 warn " $table.$column exists\n" if $DEBUG > 2;
453 $self->column($column)->sql_alter_column( $new->column($column), $dbh );
457 warn "column $table.$column does not exist.\n" if $DEBUG;
460 $new->column($column)->sql_add_column( $dbh );
466 #should eventually check & create missing indices ( & delete ones not in $new)
468 #should eventually drop columns not in $new
470 warn join("\n", @r). "\n"
478 my($dbh, $table) = @_;
479 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
481 $sth->execute or die $sth->errstr;
489 Ivan Kohler <ivan-dbix-dbschema@420.am>
491 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
496 Copyright (c) 2000-2006 Ivan Kohler
497 Copyright (c) 2000 Mail Abuse Prevention System LLC
499 This program is free software; you can redistribute it and/or modify it under
500 the same terms as Perl itself.
504 sql_create_table() has database-specific foo that probably ought to be
505 abstracted into the DBIx::DBSchema::DBD:: modules.
507 sql_create_table may change or destroy the object's data. If you need to use
508 the object after sql_create_table, make a copy beforehand.
510 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
512 sql_alter_table ought to update indices, and drop columns not in $new
516 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
517 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>