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 (
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.
147 Note: the _odbc refers to the column types used and nothing else - you do not
148 have to have ODBC installed or connect to the database via ODBC.
153 # undef => sub { '' },
155 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
157 sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
161 my( $proto, $dbh, $name) = @_;
162 my $driver = DBIx::DBSchema::_load_driver($dbh);
163 my $sth = _null_sth($dbh, $name);
167 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
168 DBIx::DBSchema::ColGroup::Unique->new(
170 ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
173 DBIx::DBSchema::ColGroup::Index->new(
175 ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
179 my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
180 or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
181 "returned no results for type ". $sth->{TYPE}->[$sthpos];
182 new DBIx::DBSchema::Column
184 $type_info->{'TYPE_NAME'},
185 #"SQL_". uc($type_info->{'TYPE_NAME'}),
186 $sth->{NULLABLE}->[$sthpos],
187 &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
189 eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
196 =item new_native DATABASE_HANDLE TABLE_NAME
198 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
199 handle for the specified table. This uses database-native methods to read the
200 schema, and will preserve any non-portable column types. The method is only
201 available if there is a DBIx::DBSchema::DBD for the corresponding database
202 engine (currently, MySQL and PostgreSQL).
207 my( $proto, $dbh, $name) = @_;
208 my $driver = DBIx::DBSchema::_load_driver($dbh);
211 scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
212 DBIx::DBSchema::ColGroup::Unique->new(
213 [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
215 DBIx::DBSchema::ColGroup::Index->new(
216 [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
219 DBIx::DBSchema::Column->new( @{$_} )
220 } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
224 =item addcolumn COLUMN
226 Adds this DBIx::DBSchema::Column object.
231 my($self,$column)=@_;
232 ${$self->{'columns'}}{$column->name}=$column; #sanity check?
233 push @{$self->{'column_order'}}, $column->name;
236 =item delcolumn COLUMN_NAME
238 Deletes this column. Returns false if no column of this name was found to
239 remove, true otherwise.
244 my($self,$column) = @_;
245 return 0 unless exists $self->{'columns'}{$column};
246 delete $self->{'columns'}{$column};
247 @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
250 =item name [ TABLE_NAME ]
252 Returns or sets the table name.
258 if ( defined($value) ) {
259 $self->{name} = $value;
265 =item primary_key [ PRIMARY_KEY ]
267 Returns or sets the primary key.
273 if ( defined($value) ) {
274 $self->{primary_key} = $value;
276 #$self->{primary_key};
277 #hmm. maybe should untaint the entire structure when it comes off disk
278 # cause if you don't trust that, ?
279 $self->{primary_key} =~ /^(\w*)$/
281 or die "Illegal primary key: ", $self->{primary_key};
286 =item unique [ UNIQUE ]
288 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
294 if ( defined($value) ) {
295 $self->{unique} = $value;
301 =item index [ INDEX ]
303 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
309 if ( defined($value) ) {
310 $self->{'index'} = $value;
318 Returns a list consisting of the names of all columns.
324 #keys %{$self->{'columns'}};
326 @{ $self->{'column_order'} };
329 =item column COLUMN_NAME
331 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
337 my($self,$column)=@_;
338 $self->{'columns'}->{$column};
341 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
343 Returns a list of SQL statments to create this table.
345 The data source can be specified by passing an open DBI database handle, or by
346 passing the DBI data source name, username and password.
348 Although the username and password are optional, it is best to call this method
349 with a database handle or data source including a valid username and password -
350 a DBI connection will be opened and the quoting and type mapping will be more
353 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
354 MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
355 (if applicable) may also be supported in the future.
359 sub sql_create_table {
360 my($self, $dbh) = (shift, shift);
363 unless ( ref($dbh) || ! @_ ) {
364 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
365 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
368 #false laziness: nicked from DBSchema::_load_driver
371 $driver = $dbh->{Driver}->{Name};
374 $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
375 or '' =~ /()/; # ensure $1 etc are empty if match fails
376 $driver = $1 or die "can't parse data source: $dbh";
380 #should be in the DBD somehwere :/
381 # my $saved_pkey = '';
382 # if ( $driver eq 'Pg' && $self->primary_key ) {
383 # my $pcolumn = $self->column( (
384 # grep { $self->column($_)->name eq $self->primary_key } $self->columns
386 ##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
387 # $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
388 # #my $saved_pkey = $self->primary_key;
389 # #$self->primary_key('');
390 # #change it back afterwords :/
393 my @columns = map { $self->column($_)->line($dbh) } $self->columns;
395 push @columns, "PRIMARY KEY (". $self->primary_key. ")"
396 #if $self->primary_key && $driver ne 'Pg';
397 if $self->primary_key;
402 "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
406 #my($index) = $self->name. "__". $_ . "_idx";
407 #$index =~ s/,\s*/_/g;
408 my $index = $self->name. $indexnum++;
409 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
410 } $self->unique->sql_list
414 #my($index) = $self->name. "__". $_ . "_idx";
415 #$index =~ s/,\s*/_/g;
416 my $index = $self->name. $indexnum++;
417 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
418 } $self->index->sql_list
421 #$self->primary_key($saved_pkey) if $saved_pkey;
422 $dbh->disconnect if $created_dbh;
429 my($dbh, $table) = @_;
430 my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
432 $sth->execute or die $sth->errstr;
440 Ivan Kohler <ivan-dbix-dbschema@420.am>
442 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
447 Copyright (c) 2000 Ivan Kohler
448 Copyright (c) 2000 Mail Abuse Prevention System LLC
450 This program is free software; you can redistribute it and/or modify it under
451 the same terms as Perl itself.
455 sql_create_table() has database-specific foo that probably ought to be
456 abstracted into the DBIx::DBSchema::DBD:: modules.
458 sql_create_table may change or destroy the object's data. If you need to use
459 the object after sql_create_table, make a copy beforehand.
461 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
465 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
466 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>