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.
306 sub sql_create_table {
307 my($self, $dbh) = (shift, shift);
308 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr
309 unless ref($dbh) || ! @_;
311 #false laziness: nicked from DBSchema::_load_driver
314 $driver = $dbh->{Driver}->{Name};
316 $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
317 or '' =~ /()/; # ensure $1 etc are empty if match fails
318 $driver = $1 or die "can't parse data source: $dbh";
322 my(@columns)=map { $self->column($_)->line($dbh) } $self->columns;
323 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
324 if $self->primary_key;
325 if ( $driver eq 'mysql' ) { #yucky mysql hack
326 push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
327 push @columns, map "INDEX ($_)", $self->index->sql_list;
330 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n",
332 my($index) = $self->name. "__". $_ . "_index";
333 $index =~ s/,\s*/_/g;
334 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
335 } $self->unique->sql_list ),
337 my($index) = $self->name. "__". $_ . "_index";
338 $index =~ s/,\s*/_/g;
339 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
340 } $self->index->sql_list ),
348 my($dbh, $table) = @_;
349 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
351 $sth->execute or die $sth->errstr;
359 Ivan Kohler <ivan-dbix-dbschema@420.am>
363 Copyright (c) 2000 Ivan Kohler
364 Copyright (c) 2000 Mail Abuse Prevention System LLC
366 This program is free software; you can redistribute it and/or modify it under
367 the same terms as Perl itself.
371 sql_create_table() has database-specific foo that probably ought to be
372 abstracted into the DBIx::DBSchema::DBD:: modules.
374 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
378 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
379 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>