1 package DBIx::DBSchema::Table;
4 use vars qw(@ISA %create_params);
7 use DBIx::DBSchema::Column 0.02;
8 use DBIx::DBSchema::ColGroup::Unique;
9 use DBIx::DBSchema::ColGroup::Index;
16 DBIx::DBSchema::Table - Table objects
20 use DBIx::DBSchema::Table;
22 #old style (depriciated)
23 $table = new DBIx::DBSchema::Table (
26 $dbix_dbschema_colgroup_unique_object,
27 $dbix_dbschema_colgroup_index_object,
28 @dbix_dbschema_column_objects,
31 #new style (preferred), pass a hashref of parameters
32 $table = new DBIx::DBSchema::Table (
34 table => "table_name",
35 primary_key => "primary_key",
36 unique => $dbix_dbschema_colgroup_unique_object,
37 'index' => $dbix_dbschema_colgroup_index_object,
38 columns => \@dbix_dbschema_column_objects,
42 $table->addcolumn ( $dbix_dbschema_column_object );
44 $table_name = $table->name;
45 $table->name("table_name");
47 $primary_key = $table->primary_key;
48 $table->primary_key("primary_key");
50 $dbix_dbschema_colgroup_unique_object = $table->unique;
51 $table->unique( $dbix_dbschema__colgroup_unique_object );
53 $dbix_dbschema_colgroup_index_object = $table->index;
54 $table->index( $dbix_dbschema_colgroup_index_object );
56 @column_names = $table->columns;
58 $dbix_dbschema_column_object = $table->column("column");
61 @sql_statements = $table->sql_create_table( $dbh );
62 @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
65 @sql_statements = $table->sql_create_table( $datasrc );
66 @sql_statements = $table->sql_create_table;
70 DBIx::DBSchema::Table objects represent a single database table.
76 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
80 Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
81 hash reference of named parameters.
85 primary_key => PRIMARY_KEY,
91 TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
92 empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
93 L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
94 DBIx::DBSchema::ColGroup::Index object (see
95 L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of
96 DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
102 my $class = ref($proto) || $proto;
108 $self->{column_order} = [ map { $_->_name } @{$self->{columns}} ];
109 $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
113 my($name,$primary_key,$unique,$index,@columns) = @_;
115 my %columns = map { $_->name, $_ } @columns;
116 my @column_order = map { $_->name } @columns;
120 'primary_key' => $primary_key,
123 'columns' => \%columns,
124 'column_order' => \@column_order,
129 #check $primary_key, $unique and $index to make sure they are $columns ?
130 # (and sanity check?)
132 bless ($self, $class);
136 =item new_odbc DATABASE_HANDLE TABLE_NAME
138 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
139 handle for the specified table. This uses the experimental DBI type_info
140 method to create a table with standard (ODBC) SQL column types that most
141 closely correspond to any non-portable column types. Use this to import a
142 schema that you wish to use with many different database engines. Although
143 primary key and (unique) index information will only be imported from databases
144 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
145 column names and attributes *should* work for any database.
150 # undef => sub { '' },
152 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
154 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
158 my( $proto, $dbh, $name) = @_;
159 my $driver = DBIx::DBSchema::_load_driver($dbh);
160 my $sth = _null_sth($dbh, $name);
164 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
165 DBIx::DBSchema::ColGroup::Unique->new(
167 ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
170 DBIx::DBSchema::ColGroup::Index->new(
172 ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
176 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
177 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
178 "returned no results for type ". $sth->{TYPE}->[$sthpos];
179 new DBIx::DBSchema::Column
181 $type_info->{'TYPE_NAME'},
182 #"SQL_". uc($type_info->{'TYPE_NAME'}),
183 $sth->{NULLABLE}->[$sthpos],
184 &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
186 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
193 =item new_native DATABASE_HANDLE TABLE_NAME
195 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
196 handle for the specified table. This uses database-native methods to read the
197 schema, and will preserve any non-portable column types. The method is only
198 available if there is a DBIx::DBSchema::DBD for the corresponding database
199 engine (currently, MySQL and PostgreSQL).
204 my( $proto, $dbh, $name) = @_;
205 my $driver = DBIx::DBSchema::_load_driver($dbh);
208 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
209 DBIx::DBSchema::ColGroup::Unique->new(
210 [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
212 DBIx::DBSchema::ColGroup::Index->new(
213 [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
216 DBIx::DBSchema::Column->new( @{$_} )
217 } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
221 =item addcolumn COLUMN
223 Adds this DBIx::DBSchema::Column object.
228 my($self,$column)=@_;
229 ${$self->{'columns'}}{$column->name}=$column; #sanity check?
230 push @{$self->{'column_order'}}, $column->name;
233 =item delcolumn COLUMN_NAME
235 Deletes this column. Returns false if no column of this name was found to
236 remove, true otherwise.
241 my($self,$column) = @_;
242 return 0 unless exists $self->{'columns'}{$column};
243 delete $self->{'columns'}{$column};
244 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
247 =item name [ TABLE_NAME ]
249 Returns or sets the table name.
255 if ( defined($value) ) {
256 $self->{name} = $value;
262 =item primary_key [ PRIMARY_KEY ]
264 Returns or sets the primary key.
270 if ( defined($value) ) {
271 $self->{primary_key} = $value;
273 #$self->{primary_key};
274 #hmm. maybe should untaint the entire structure when it comes off disk
275 # cause if you don't trust that, ?
276 $self->{primary_key} =~ /^(\w*)$/
278 or die "Illegal primary key: ", $self->{primary_key};
283 =item unique [ UNIQUE ]
285 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
291 if ( defined($value) ) {
292 $self->{unique} = $value;
298 =item index [ INDEX ]
300 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
306 if ( defined($value) ) {
307 $self->{'index'} = $value;
315 Returns a list consisting of the names of all columns.
321 #keys %{$self->{'columns'}};
323 @{ $self->{'column_order'} };
326 =item column COLUMN_NAME
328 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
334 my($self,$column)=@_;
335 $self->{'columns'}->{$column};
338 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
340 Returns a list of SQL statments to create this table.
342 The data source can be specified by passing an open DBI database handle, or by
343 passing the DBI data source name, username and password.
345 Although the username and password are optional, it is best to call this method
346 with a database handle or data source including a valid username and password -
347 a DBI connection will be opened and the quoting and type mapping will be more
350 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
351 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
352 (if applicable) may also be supported in the future.
356 sub sql_create_table {
357 my($self, $dbh) = (shift, shift);
360 unless ( ref($dbh) || ! @_ ) {
361 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
362 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
365 #false laziness: nicked from DBSchema::_load_driver
368 $driver = $dbh->{Driver}->{Name};
371 $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
372 or '' =~ /()/; # ensure $1 etc are empty if match fails
373 $driver = $1 or die "can't parse data source: $dbh";
377 #should be in the DBD somehwere :/
378 # my $saved_pkey = '';
379 # if ( $driver eq 'Pg' && $self->primary_key ) {
380 # my $pcolumn = $self->column( (
381 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
383 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
384 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
385 # #my $saved_pkey = $self->primary_key;
386 # #$self->primary_key('');
387 # #change it back afterwords :/
390 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
392 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
393 #if $self->primary_key && $driver ne 'Pg';
394 if $self->primary_key;
399 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
403 #my($index) = $self->name. "__". $_ . "_idx";
404 #$index =~ s/,\s*/_/g;
405 my $index = $self->name. $indexnum++;
406 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
407 } $self->unique->sql_list
411 #my($index) = $self->name. "__". $_ . "_idx";
412 #$index =~ s/,\s*/_/g;
413 my $index = $self->name. $indexnum++;
414 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
415 } $self->index->sql_list
418 #$self->primary_key($saved_pkey) if $saved_pkey;
419 $dbh->disconnect if $created_dbh;
426 my($dbh, $table) = @_;
427 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
429 $sth->execute or die $sth->errstr;
437 Ivan Kohler <ivan-dbix-dbschema@420.am>
439 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
444 Copyright (c) 2000 Ivan Kohler
445 Copyright (c) 2000 Mail Abuse Prevention System LLC
447 This program is free software; you can redistribute it and/or modify it under
448 the same terms as Perl itself.
452 sql_create_table() has database-specific foo that probably ought to be
453 abstracted into the DBIx::DBSchema::DBD:: modules.
455 sql_create_table may change or destroy the object's data. If you need to use
456 the object after sql_create_table, make a copy beforehand.
458 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
462 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
463 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>