1 package DBIx::DBSchema::Table;
4 use vars qw(@ISA $VERSION %create_params);
7 use DBIx::DBSchema::_util qw(_load_driver);
8 use DBIx::DBSchema::Column 0.03;
9 use DBIx::DBSchema::ColGroup::Unique;
10 use DBIx::DBSchema::ColGroup::Index;
19 DBIx::DBSchema::Table - Table objects
23 use DBIx::DBSchema::Table;
25 #old style (depriciated)
26 $table = new DBIx::DBSchema::Table (
29 $dbix_dbschema_colgroup_unique_object,
30 $dbix_dbschema_colgroup_index_object,
31 @dbix_dbschema_column_objects,
34 #new style (preferred), pass a hashref of parameters
35 $table = new DBIx::DBSchema::Table (
38 primary_key => "primary_key",
39 unique => $dbix_dbschema_colgroup_unique_object,
40 'index' => $dbix_dbschema_colgroup_index_object,
41 columns => \@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 $dbix_dbschema_colgroup_unique_object = $table->unique;
54 $table->unique( $dbix_dbschema__colgroup_unique_object );
56 $dbix_dbschema_colgroup_index_object = $table->index;
57 $table->index( $dbix_dbschema_colgroup_index_object );
59 @column_names = $table->columns;
61 $dbix_dbschema_column_object = $table->column("column");
64 @sql_statements = $table->sql_create_table( $dbh );
65 @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
68 @sql_statements = $table->sql_create_table( $datasrc );
69 @sql_statements = $table->sql_create_table;
73 DBIx::DBSchema::Table objects represent a single database table.
79 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
83 Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
84 hash reference of named parameters.
88 primary_key => PRIMARY_KEY,
94 TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
95 empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
96 L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
97 DBIx::DBSchema::ColGroup::Index object (see
98 L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of
99 DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
105 my $class = ref($proto) || $proto;
111 $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
112 $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
116 my($name,$primary_key,$unique,$index,@columns) = @_;
118 my %columns = map { $_->name, $_ } @columns;
119 my @column_order = map { $_->name } @columns;
123 'primary_key' => $primary_key,
126 'columns' => \%columns,
127 'column_order' => \@column_order,
132 #check $primary_key, $unique and $index to make sure they are $columns ?
133 # (and sanity check?)
135 bless ($self, $class);
137 $_->table_obj($self) foreach values %{ $self->{columns} };
142 =item new_odbc DATABASE_HANDLE TABLE_NAME
144 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
145 handle for the specified table. This uses the experimental DBI type_info
146 method to create a table with standard (ODBC) SQL column types that most
147 closely correspond to any non-portable column types. Use this to import a
148 schema that you wish to use with many different database engines. Although
149 primary key and (unique) index information will only be imported from databases
150 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
151 column names and attributes *should* work for any database.
153 Note: the _odbc refers to the column types used and nothing else - you do not
154 have to have ODBC installed or connect to the database via ODBC.
159 # undef => sub { '' },
161 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
163 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
167 my( $proto, $dbh, $name) = @_;
168 my $driver = _load_driver($dbh);
169 my $sth = _null_sth($dbh, $name);
173 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
174 DBIx::DBSchema::ColGroup::Unique->new(
176 ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
179 DBIx::DBSchema::ColGroup::Index->new(
181 ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
185 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
186 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
187 "returned no results for type ". $sth->{TYPE}->[$sthpos];
188 new DBIx::DBSchema::Column
190 $type_info->{'TYPE_NAME'},
191 #"SQL_". uc($type_info->{'TYPE_NAME'}),
192 $sth->{NULLABLE}->[$sthpos],
193 &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
195 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
202 =item new_native DATABASE_HANDLE TABLE_NAME
204 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
205 handle for the specified table. This uses database-native methods to read the
206 schema, and will preserve any non-portable column types. The method is only
207 available if there is a DBIx::DBSchema::DBD for the corresponding database
208 engine (currently, MySQL and PostgreSQL).
213 my( $proto, $dbh, $name) = @_;
214 my $driver = _load_driver($dbh);
217 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
218 DBIx::DBSchema::ColGroup::Unique->new(
219 [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
221 DBIx::DBSchema::ColGroup::Index->new(
222 [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
225 DBIx::DBSchema::Column->new( @{$_} )
226 } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
230 =item addcolumn COLUMN
232 Adds this DBIx::DBSchema::Column object.
237 my($self, $column) = @_;
238 $column->table_obj($self);
239 ${$self->{'columns'}}{$column->name} = $column; #sanity check?
240 push @{$self->{'column_order'}}, $column->name;
243 =item delcolumn COLUMN_NAME
245 Deletes this column. Returns false if no column of this name was found to
246 remove, true otherwise.
251 my($self,$column) = @_;
252 return 0 unless exists $self->{'columns'}{$column};
253 $self->{'columns'}{$column}->table_obj('');
254 delete $self->{'columns'}{$column};
255 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
258 =item name [ TABLE_NAME ]
260 Returns or sets the table name.
266 if ( defined($value) ) {
267 $self->{name} = $value;
273 =item primary_key [ PRIMARY_KEY ]
275 Returns or sets the primary key.
281 if ( defined($value) ) {
282 $self->{primary_key} = $value;
284 #$self->{primary_key};
285 #hmm. maybe should untaint the entire structure when it comes off disk
286 # cause if you don't trust that, ?
287 $self->{primary_key} =~ /^(\w*)$/
289 or die "Illegal primary key: ", $self->{primary_key};
294 =item unique [ UNIQUE ]
296 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
302 if ( defined($value) ) {
303 $self->{unique} = $value;
309 =item index [ INDEX ]
311 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
317 if ( defined($value) ) {
318 $self->{'index'} = $value;
326 Returns a list consisting of the names of all columns.
332 #keys %{$self->{'columns'}};
334 @{ $self->{'column_order'} };
337 =item column COLUMN_NAME
339 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
345 my($self,$column)=@_;
346 $self->{'columns'}->{$column};
349 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
351 Returns a list of SQL statments to create this table.
353 The data source can be specified by passing an open DBI database handle, or by
354 passing the DBI data source name, username and password.
356 Although the username and password are optional, it is best to call this method
357 with a database handle or data source including a valid username and password -
358 a DBI connection will be opened and the quoting and type mapping will be more
361 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
362 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
363 (if applicable) may also be supported in the future.
367 sub sql_create_table {
368 my($self, $dbh) = (shift, shift);
371 unless ( ref($dbh) || ! @_ ) {
372 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
373 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
376 my $driver = _load_driver($dbh);
378 #should be in the DBD somehwere :/
379 # my $saved_pkey = '';
380 # if ( $driver eq 'Pg' && $self->primary_key ) {
381 # my $pcolumn = $self->column( (
382 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
384 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
385 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
386 # #my $saved_pkey = $self->primary_key;
387 # #$self->primary_key('');
388 # #change it back afterwords :/
391 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
393 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
394 #if $self->primary_key && $driver ne 'Pg';
395 if $self->primary_key;
400 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
404 #my($index) = $self->name. "__". $_ . "_idx";
405 #$index =~ s/,\s*/_/g;
406 my $index = $self->name. $indexnum++;
407 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
408 } $self->unique->sql_list
412 #my($index) = $self->name. "__". $_ . "_idx";
413 #$index =~ s/,\s*/_/g;
414 my $index = $self->name. $indexnum++;
415 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
416 } $self->index->sql_list
419 #$self->primary_key($saved_pkey) if $saved_pkey;
420 $dbh->disconnect if $created_dbh;
427 my($dbh, $table) = @_;
428 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
430 $sth->execute or die $sth->errstr;
438 Ivan Kohler <ivan-dbix-dbschema@420.am>
440 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
445 Copyright (c) 2000 Ivan Kohler
446 Copyright (c) 2000 Mail Abuse Prevention System LLC
448 This program is free software; you can redistribute it and/or modify it under
449 the same terms as Perl itself.
453 sql_create_table() has database-specific foo that probably ought to be
454 abstracted into the DBIx::DBSchema::DBD:: modules.
456 sql_create_table may change or destroy the object's data. If you need to use
457 the object after sql_create_table, make a copy beforehand.
459 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
463 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
464 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>