package DBIx::DBSchema::Table;
use strict;
-use vars qw(@ISA %create_params);
+use vars qw(@ISA $VERSION $DEBUG %create_params);
#use Carp;
#use Exporter;
-use DBIx::DBSchema::Column;
+use DBIx::DBSchema::_util qw(_load_driver _dbh);
+use DBIx::DBSchema::Column 0.03;
use DBIx::DBSchema::ColGroup::Unique;
use DBIx::DBSchema::ColGroup::Index;
#@ISA = qw(Exporter);
@ISA = qw();
+$VERSION = '0.02';
+$DEBUG = 0;
+
=head1 NAME
DBIx::DBSchema::Table - Table objects
#new style (preferred), pass a hashref of parameters
$table = new DBIx::DBSchema::Table (
{
- table => "table_name",
+ name => "table_name",
primary_key => "primary_key",
unique => $dbix_dbschema_colgroup_unique_object,
'index' => $dbix_dbschema_colgroup_index_object,
$dbix_dbschema_column_object = $table->column("column");
#preferred
- @sql_statements = $table->sql_create_table $dbh;
- @sql_statements = $table->sql_create_table $datasrc, $username, $password;
+ @sql_statements = $table->sql_create_table( $dbh );
+ @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
#possible problems
- @sql_statements = $table->sql_create_table $datasrc;
+ @sql_statements = $table->sql_create_table( $datasrc );
@sql_statements = $table->sql_create_table;
=head1 DESCRIPTION
if ( ref($_[0]) ) {
$self = shift;
- $self->{column_order} = [ map { $_->_name } @{$self->{columns}} ];
+ $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
$self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
} else {
bless ($self, $class);
+ $_->table_obj($self) foreach values %{ $self->{columns} };
+
+ $self;
}
=item new_odbc DATABASE_HANDLE TABLE_NAME
with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
column names and attributes *should* work for any database.
+Note: the _odbc refers to the column types used and nothing else - you do not
+have to have ODBC installed or connect to the database via ODBC.
+
=cut
%create_params = (
sub new_odbc {
my( $proto, $dbh, $name) = @_;
- my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my $driver = _load_driver($dbh);
my $sth = _null_sth($dbh, $name);
my $sthpos = 0;
$proto->new (
sub new_native {
my( $proto, $dbh, $name) = @_;
- my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my $driver = _load_driver($dbh);
$proto->new (
$name,
scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
=cut
sub addcolumn {
- my($self,$column)=@_;
- ${$self->{'columns'}}{$column->name}=$column; #sanity check?
+ my($self, $column) = @_;
+ $column->table_obj($self);
+ ${$self->{'columns'}}{$column->name} = $column; #sanity check?
push @{$self->{'column_order'}}, $column->name;
}
+=item delcolumn COLUMN_NAME
+
+Deletes this column. Returns false if no column of this name was found to
+remove, true otherwise.
+
+=cut
+
+sub delcolumn {
+ my($self,$column) = @_;
+ return 0 unless exists $self->{'columns'}{$column};
+ $self->{'columns'}{$column}->table_obj('');
+ delete $self->{'columns'}{$column};
+ @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
+}
+
=item name [ TABLE_NAME ]
Returns or sets the table name.
Returns a list of SQL statments to create this table.
+Optionally, the data source can be specified by passing an open DBI database
+handle, or by passing the DBI data source name, username and password.
+
The data source can be specified by passing an open DBI database handle, or by
passing the DBI data source name, username and password.
=cut
sub sql_create_table {
- my($self, $dbh) = (shift, shift);
+ my($self, $dbh) = ( shift, _dbh(@_) );
- my $created_dbh = 0;
- unless ( ref($dbh) || ! @_ ) {
- $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
- my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
- $created_dbh = 1;
- }
- #false laziness: nicked from DBSchema::_load_driver
- my $driver;
- if ( ref($dbh) ) {
- $driver = $dbh->{Driver}->{Name};
- } else {
- my $discard = $dbh;
- $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
- or '' =~ /()/; # ensure $1 etc are empty if match fails
- $driver = $1 or die "can't parse data source: $dbh";
- }
- #eofalse
+ my $driver = _load_driver($dbh);
+#should be in the DBD somehwere :/
+# my $saved_pkey = '';
# if ( $driver eq 'Pg' && $self->primary_key ) {
# my $pcolumn = $self->column( (
# grep { $self->column($_)->name eq $self->primary_key } $self->columns
# )[0] );
-# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
-## $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
-## $self->primary_key('');
-# #prolly shoudl change it back afterwords :/
+##AUTO-INCREMENT# $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
+# $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
+# #my $saved_pkey = $self->primary_key;
+# #$self->primary_key('');
+# #change it back afterwords :/
# }
- my(@columns)=map { $self->column($_)->line($dbh) } $self->columns;
+ my @columns = map { $self->column($_)->line($dbh) } $self->columns;
push @columns, "PRIMARY KEY (". $self->primary_key. ")"
- if $self->primary_key && $driver ne 'Pg';
-
- if ( $driver eq 'mysql' ) { #yucky mysql hack
- push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
- push @columns, map "INDEX ($_)", $self->index->sql_list;
- }
+ if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
my $indexnum = 1;
my @r = (
- "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n",
- ( map {
- #my($index) = $self->name. "__". $_ . "_idx";
- #$index =~ s/,\s*/_/g;
- my $index = $self->name. $indexnum++;
- "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
- } $self->unique->sql_list ),
- ( map {
- #my($index) = $self->name. "__". $_ . "_idx";
- #$index =~ s/,\s*/_/g;
- my $index = $self->name. $indexnum++;
- "CREATE INDEX $index ON ". $self->name. " ($_)\n"
- } $self->index->sql_list ),
- );
- $dbh->disconnect if $created_dbh;
+ "CREATE TABLE ". $self->name. " (\n ". join(",\n ", @columns). "\n)\n"
+ );
+
+ push @r, map {
+ #my($index) = $self->name. "__". $_ . "_idx";
+ #$index =~ s/,\s*/_/g;
+ my $index = $self->name. $indexnum++;
+ "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
+ } $self->unique->sql_list
+ if $self->unique;
+
+ push @r, map {
+ #my($index) = $self->name. "__". $_ . "_idx";
+ #$index =~ s/,\s*/_/g;
+ my $index = $self->name. $indexnum++;
+ "CREATE INDEX $index ON ". $self->name. " ($_)\n"
+ } $self->index->sql_list
+ if $self->index;
+
+ #$self->primary_key($saved_pkey) if $saved_pkey;
@r;
}
-#
+=item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statements to alter this table so that it is identical
+to the provided table, also a DBIx::DBSchema::Table object.
+
+ #Optionally, the data source can be specified by passing an open DBI database
+ #handle, or by passing the DBI data source name, username and password.
+ #
+ #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
+ #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
+ #applicable) may also be supported in the future.
+ #
+ #If not passed a data source (or handle), or if there is no driver for the
+ #specified database, will attempt to use generic SQL syntax.
+
+=cut
+
+#gosh, false laziness w/DBSchema::sql_update_schema
+
+sub sql_alter_table {
+ my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+
+ my $table = $self->name;
+
+ my @r = ();
+
+ foreach my $column ( $new->columns ) {
+
+ if ( $self->column($column) ) {
+
+ warn " $table.$column exists\n" if $DEBUG > 2;
+
+ push @r,
+ $self->column($column)->sql_alter_column( $new->column($column), $dbh );
+
+ } else {
+
+ warn "column $table.$column does not exist.\n" if $DEBUG;
+
+ push @r,
+ $new->column($column)->sql_add_column( $dbh );
+
+ }
+
+ }
+
+ #should eventually check & create missing indices ( & delete ones not in $new)
+
+ #should eventually drop columns not in $new
+
+ warn join("\n", @r). "\n"
+ if $DEBUG;
+
+ @r;
+
+}
sub _null_sth {
my($dbh, $table) = @_;
Ivan Kohler <ivan-dbix-dbschema@420.am>
+Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
+with no indices.
+
=head1 COPYRIGHT
-Copyright (c) 2000 Ivan Kohler
+Copyright (c) 2000-2006 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
Some of the logic in new_odbc might be better abstracted into Column.pm etc.
+sql_alter_table ought to update indices, and drop columns not in $new
+
=head1 SEE ALSO
L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,