1 package DBIx::DBSchema::Table;
4 use vars qw(@ISA %create_params);
7 use DBIx::DBSchema::Column;
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 name [ TABLE_NAME ]
235 Returns or sets the table name.
241 if ( defined($value) ) {
242 $self->{name} = $value;
248 =item primary_key [ PRIMARY_KEY ]
250 Returns or sets the primary key.
256 if ( defined($value) ) {
257 $self->{primary_key} = $value;
259 #$self->{primary_key};
260 #hmm. maybe should untaint the entire structure when it comes off disk
261 # cause if you don't trust that, ?
262 $self->{primary_key} =~ /^(\w*)$/
264 or die "Illegal primary key: ", $self->{primary_key};
269 =item unique [ UNIQUE ]
271 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
277 if ( defined($value) ) {
278 $self->{unique} = $value;
284 =item index [ INDEX ]
286 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
292 if ( defined($value) ) {
293 $self->{'index'} = $value;
301 Returns a list consisting of the names of all columns.
307 #keys %{$self->{'columns'}};
309 @{ $self->{'column_order'} };
312 =item column COLUMN_NAME
314 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
320 my($self,$column)=@_;
321 $self->{'columns'}->{$column};
324 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
326 Returns a list of SQL statments to create this table.
328 The data source can be specified by passing an open DBI database handle, or by
329 passing the DBI data source name, username and password.
331 Although the username and password are optional, it is best to call this method
332 with a database handle or data source including a valid username and password -
333 a DBI connection will be opened and the quoting and type mapping will be more
336 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
337 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
338 (if applicable) may also be supported in the future.
342 sub sql_create_table {
343 my($self, $dbh) = (shift, shift);
346 unless ( ref($dbh) || ! @_ ) {
347 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
348 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
351 #false laziness: nicked from DBSchema::_load_driver
354 $driver = $dbh->{Driver}->{Name};
357 $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
358 or '' =~ /()/; # ensure $1 etc are empty if match fails
359 $driver = $1 or die "can't parse data source: $dbh";
363 # if ( $driver eq 'Pg' && $self->primary_key ) {
364 # my $pcolumn = $self->column( (
365 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
367 # $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
368 ## $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
369 ## $self->primary_key('');
370 # #prolly shoudl change it back afterwords :/
373 my(@columns)=map { $self->column($_)->line($dbh) } $self->columns;
375 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
376 if $self->primary_key && $driver ne 'Pg';
381 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
385 #my($index) = $self->name. "__". $_ . "_idx";
386 #$index =~ s/,\s*/_/g;
387 my $index = $self->name. $indexnum++;
388 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
389 } $self->unique->sql_list
393 #my($index) = $self->name. "__". $_ . "_idx";
394 #$index =~ s/,\s*/_/g;
395 my $index = $self->name. $indexnum++;
396 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
397 } $self->index->sql_list
400 $dbh->disconnect if $created_dbh;
407 my($dbh, $table) = @_;
408 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
410 $sth->execute or die $sth->errstr;
418 Ivan Kohler <ivan-dbix-dbschema@420.am>
422 Copyright (c) 2000 Ivan Kohler
423 Copyright (c) 2000 Mail Abuse Prevention System LLC
425 This program is free software; you can redistribute it and/or modify it under
426 the same terms as Perl itself.
430 sql_create_table() has database-specific foo that probably ought to be
431 abstracted into the DBIx::DBSchema::DBD:: modules.
433 sql_create_table may change or destroy the object's data. If you need to use
434 the object after sql_create_table, make a copy beforehand.
436 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
440 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
441 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>