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 $table = new DBIx::DBSchema::Table (
25 $dbix_dbschema_colgroup_unique_object,
26 $dbix_dbschema_colgroup_index_object,
27 @dbix_dbschema_column_objects,
30 $table->addcolumn ( $dbix_dbschema_column_object );
32 $table_name = $table->name;
33 $table->name("table_name");
35 $primary_key = $table->primary_key;
36 $table->primary_key("primary_key");
38 $dbix_dbschema_colgroup_unique_object = $table->unique;
39 $table->unique( $dbix_dbschema__colgroup_unique_object );
41 $dbix_dbschema_colgroup_index_object = $table->index;
42 $table->index( $dbix_dbschema_colgroup_index_object );
44 @column_names = $table->columns;
46 $dbix_dbschema_column_object = $table->column("column");
49 @sql_statements = $table->sql_create_table $dbh;
50 @sql_statements = $table->sql_create_table $datasrc, $username, $password;
53 @sql_statements = $table->sql_create_table $datasrc;
54 @sql_statements = $table->sql_create_table;
58 DBIx::DBSchema::Table objects represent a single database table.
64 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
66 Creates a new DBIx::DBSchema::Table object. TABLE_NAME is the name of the
67 table. PRIMARY_KEY is the primary key (may be empty). UNIQUE is a
68 DBIx::DBSchema::ColGroup::Unique object (see
69 L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
70 DBIx::DBSchema::ColGroup::Index object (see
71 L<DBIx::DBSchema::ColGroup::Index>). The rest of the arguments should be
72 DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
77 my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
79 my(%columns) = map { $_->name, $_ } @columns;
80 my(@column_order) = map { $_->name } @columns;
82 #check $primary_key, $unique and $index to make sure they are $columns ?
85 my $class = ref($proto) || $proto;
88 'primary_key' => $primary_key,
91 'columns' => \%columns,
92 'column_order' => \@column_order,
95 bless ($self, $class);
99 =item new_odbc DATABASE_HANDLE TABLE_NAME
101 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
102 handle for the specified table. This uses the experimental DBI type_info
103 method to create a table with standard (ODBC) SQL column types that most
104 closely correspond to any non-portable column types. Use this to import a
105 schema that you wish to use with many different database engines. Although
106 primary key and (unique) index information will only be imported from databases
107 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
108 column names and attributes *should* work for any database.
113 # undef => sub { '' },
115 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
117 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
121 my( $proto, $dbh, $name) = @_;
122 my $driver = DBIx::DBSchema::_load_driver($dbh);
123 my $sth = _null_sth($dbh, $name);
127 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
128 DBIx::DBSchema::ColGroup::Unique->new(
130 ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
133 DBIx::DBSchema::ColGroup::Index->new(
135 ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
139 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
140 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
141 "returned no results for type ". $sth->{TYPE}->[$sthpos];
142 new DBIx::DBSchema::Column
144 $type_info->{'TYPE_NAME'},
145 #"SQL_". uc($type_info->{'TYPE_NAME'}),
146 $sth->{NULLABLE}->[$sthpos],
147 &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
149 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
156 =item new_native DATABASE_HANDLE TABLE_NAME
158 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
159 handle for the specified table. This uses database-native methods to read the
160 schema, and will preserve any non-portable column types. The method is only
161 available if there is a DBIx::DBSchema::DBD for the corresponding database
162 engine (currently, MySQL and PostgreSQL).
167 my( $proto, $dbh, $name) = @_;
168 my $driver = DBIx::DBSchema::_load_driver($dbh);
171 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
172 DBIx::DBSchema::ColGroup::Unique->new(
173 [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
175 DBIx::DBSchema::ColGroup::Index->new(
176 [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
179 DBIx::DBSchema::Column->new( @{$_} )
180 } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
184 =item addcolumn COLUMN
186 Adds this DBIx::DBSchema::Column object.
191 my($self,$column)=@_;
192 ${$self->{'columns'}}{$column->name}=$column; #sanity check?
193 push @{$self->{'column_order'}}, $column->name;
196 =item name [ TABLE_NAME ]
198 Returns or sets the table name.
204 if ( defined($value) ) {
205 $self->{name} = $value;
211 =item primary_key [ PRIMARY_KEY ]
213 Returns or sets the primary key.
219 if ( defined($value) ) {
220 $self->{primary_key} = $value;
222 #$self->{primary_key};
223 #hmm. maybe should untaint the entire structure when it comes off disk
224 # cause if you don't trust that, ?
225 $self->{primary_key} =~ /^(\w*)$/
227 or die "Illegal primary key: ", $self->{primary_key};
232 =item unique [ UNIQUE ]
234 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
240 if ( defined($value) ) {
241 $self->{unique} = $value;
247 =item index [ INDEX ]
249 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
255 if ( defined($value) ) {
256 $self->{'index'} = $value;
264 Returns a list consisting of the names of all columns.
270 #keys %{$self->{'columns'}};
272 @{ $self->{'column_order'} };
275 =item column COLUMN_NAME
277 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
283 my($self,$column)=@_;
284 $self->{'columns'}->{$column};
287 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
289 Returns a list of SQL statments to create this table.
291 The data source can be specified by passing an open DBI database handle, or by
292 passing the DBI data source name, username and password.
294 Although the username and password are optional, it is best to call this method
295 with a database handle or data source including a valid username and password -
296 a DBI connection will be opened and the quoting and type mapping will be more
299 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
300 MySQL-specific syntax. PostgreSQL is also supported (requires no special
301 syntax). Non-standard syntax for other engines (if applicable) may also be
302 supported in the future.
307 sub sql_create_table {
308 my($self, $dbh) = (shift, shift);
311 unless ( ref($dbh) || ! @_ ) {
312 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
313 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
316 #false laziness: nicked from DBSchema::_load_driver
319 $driver = $dbh->{Driver}->{Name};
322 $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
323 or '' =~ /()/; # ensure $1 etc are empty if match fails
324 $driver = $1 or die "can't parse data source: $dbh";
328 my(@columns)=map { $self->column($_)->line($dbh) } $self->columns;
329 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
330 if $self->primary_key;
331 if ( $driver eq 'mysql' ) { #yucky mysql hack
332 push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
333 push @columns, map "INDEX ($_)", $self->index->sql_list;
337 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n",
339 my($index) = $self->name. "__". $_ . "_index";
340 $index =~ s/,\s*/_/g;
341 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
342 } $self->unique->sql_list ),
344 my($index) = $self->name. "__". $_ . "_index";
345 $index =~ s/,\s*/_/g;
346 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
347 } $self->index->sql_list ),
349 $dbh->disconnect if $created_dbh;
356 my($dbh, $table) = @_;
357 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
359 $sth->execute or die $sth->errstr;
367 Ivan Kohler <ivan-dbix-dbschema@420.am>
371 Copyright (c) 2000 Ivan Kohler
372 Copyright (c) 2000 Mail Abuse Prevention System LLC
374 This program is free software; you can redistribute it and/or modify it under
375 the same terms as Perl itself.
379 sql_create_table() has database-specific foo that probably ought to be
380 abstracted into the DBIx::DBSchema::DBD:: modules.
382 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
386 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
387 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>