--- /dev/null
+package DBIx::DBSchema::Table;
+
+use strict;
+use vars qw(@ISA %create_params);
+#use Carp;
+#use Exporter;
+use DBIx::DBSchema::Column 0.02;
+use DBIx::DBSchema::ColGroup::Unique;
+use DBIx::DBSchema::ColGroup::Index;
+
+#@ISA = qw(Exporter);
+@ISA = qw();
+
+=head1 NAME
+
+DBIx::DBSchema::Table - Table objects
+
+=head1 SYNOPSIS
+
+ use DBIx::DBSchema::Table;
+
+ #old style (depriciated)
+ $table = new DBIx::DBSchema::Table (
+ "table_name",
+ "primary_key",
+ $dbix_dbschema_colgroup_unique_object,
+ $dbix_dbschema_colgroup_index_object,
+ @dbix_dbschema_column_objects,
+ );
+
+ #new style (preferred), pass a hashref of parameters
+ $table = new DBIx::DBSchema::Table (
+ {
+ name => "table_name",
+ primary_key => "primary_key",
+ unique => $dbix_dbschema_colgroup_unique_object,
+ 'index' => $dbix_dbschema_colgroup_index_object,
+ columns => \@dbix_dbschema_column_objects,
+ }
+ );
+
+ $table->addcolumn ( $dbix_dbschema_column_object );
+
+ $table_name = $table->name;
+ $table->name("table_name");
+
+ $primary_key = $table->primary_key;
+ $table->primary_key("primary_key");
+
+ $dbix_dbschema_colgroup_unique_object = $table->unique;
+ $table->unique( $dbix_dbschema__colgroup_unique_object );
+
+ $dbix_dbschema_colgroup_index_object = $table->index;
+ $table->index( $dbix_dbschema_colgroup_index_object );
+
+ @column_names = $table->columns;
+
+ $dbix_dbschema_column_object = $table->column("column");
+
+ #preferred
+ @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;
+
+=head1 DESCRIPTION
+
+DBIx::DBSchema::Table objects represent a single database table.
+
+=head1 METHODS
+
+=over 4
+
+=item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
+
+=item new HASHREF
+
+Creates a new DBIx::DBSchema::Table object. The preferred usage is to pass a
+hash reference of named parameters.
+
+ {
+ name => TABLE_NAME,
+ primary_key => PRIMARY_KEY,
+ unique => UNIQUE,
+ 'index' => INDEX,
+ columns => COLUMNS
+ }
+
+TABLE_NAME is the name of the table. PRIMARY_KEY is the primary key (may be
+empty). UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
+L<DBIx::DBSchema::ColGroup::Unique>). INDEX is a
+DBIx::DBSchema::ColGroup::Index object (see
+L<DBIx::DBSchema::ColGroup::Index>). COLUMNS is a reference to an array of
+DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $self;
+ if ( ref($_[0]) ) {
+
+ $self = shift;
+ $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
+ $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
+
+ } else {
+
+ my($name,$primary_key,$unique,$index,@columns) = @_;
+
+ my %columns = map { $_->name, $_ } @columns;
+ my @column_order = map { $_->name } @columns;
+
+ $self = {
+ 'name' => $name,
+ 'primary_key' => $primary_key,
+ 'unique' => $unique,
+ 'index' => $index,
+ 'columns' => \%columns,
+ 'column_order' => \@column_order,
+ };
+
+ }
+
+ #check $primary_key, $unique and $index to make sure they are $columns ?
+ # (and sanity check?)
+
+ bless ($self, $class);
+
+}
+
+=item new_odbc DATABASE_HANDLE TABLE_NAME
+
+Creates a new DBIx::DBSchema::Table object from the supplied DBI database
+handle for the specified table. This uses the experimental DBI type_info
+method to create a table with standard (ODBC) SQL column types that most
+closely correspond to any non-portable column types. Use this to import a
+schema that you wish to use with many different database engines. Although
+primary key and (unique) index information will only be imported from databases
+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 = (
+# undef => sub { '' },
+ '' => sub { '' },
+ 'max length' => sub { $_[0]->{PRECISION}->[$_[1]]; },
+ 'precision,scale' =>
+ sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
+);
+
+sub new_odbc {
+ my( $proto, $dbh, $name) = @_;
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ my $sth = _null_sth($dbh, $name);
+ my $sthpos = 0;
+ $proto->new (
+ $name,
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+ DBIx::DBSchema::ColGroup::Unique->new(
+ $driver
+ ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
+ : []
+ ),
+ DBIx::DBSchema::ColGroup::Index->new(
+ $driver
+ ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
+ : []
+ ),
+ map {
+ my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
+ or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
+ "returned no results for type ". $sth->{TYPE}->[$sthpos];
+ new DBIx::DBSchema::Column
+ $_,
+ $type_info->{'TYPE_NAME'},
+ #"SQL_". uc($type_info->{'TYPE_NAME'}),
+ $sth->{NULLABLE}->[$sthpos],
+ &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ), $driver && #default
+ ${ [
+ eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
+ ] }[4]
+ # DB-local
+ } @{$sth->{NAME}}
+ );
+}
+
+=item new_native DATABASE_HANDLE TABLE_NAME
+
+Creates a new DBIx::DBSchema::Table object from the supplied DBI database
+handle for the specified table. This uses database-native methods to read the
+schema, and will preserve any non-portable column types. The method is only
+available if there is a DBIx::DBSchema::DBD for the corresponding database
+engine (currently, MySQL and PostgreSQL).
+
+=cut
+
+sub new_native {
+ my( $proto, $dbh, $name) = @_;
+ my $driver = DBIx::DBSchema::_load_driver($dbh);
+ $proto->new (
+ $name,
+ scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
+ DBIx::DBSchema::ColGroup::Unique->new(
+ [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
+ ),
+ DBIx::DBSchema::ColGroup::Index->new(
+ [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
+ ),
+ map {
+ DBIx::DBSchema::Column->new( @{$_} )
+ } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
+ );
+}
+
+=item addcolumn COLUMN
+
+Adds this DBIx::DBSchema::Column object.
+
+=cut
+
+sub addcolumn {
+ my($self,$column)=@_;
+ ${$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};
+ delete $self->{'columns'}{$column};
+ @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1;
+}
+
+=item name [ TABLE_NAME ]
+
+Returns or sets the table name.
+
+=cut
+
+sub name {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{name} = $value;
+ } else {
+ $self->{name};
+ }
+}
+
+=item primary_key [ PRIMARY_KEY ]
+
+Returns or sets the primary key.
+
+=cut
+
+sub primary_key {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{primary_key} = $value;
+ } else {
+ #$self->{primary_key};
+ #hmm. maybe should untaint the entire structure when it comes off disk
+ # cause if you don't trust that, ?
+ $self->{primary_key} =~ /^(\w*)$/
+ #aah!
+ or die "Illegal primary key: ", $self->{primary_key};
+ $1;
+ }
+}
+
+=item unique [ UNIQUE ]
+
+Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
+
+=cut
+
+sub unique {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{unique} = $value;
+ } else {
+ $self->{unique};
+ }
+}
+
+=item index [ INDEX ]
+
+Returns or sets the DBIx::DBSchema::ColGroup::Index object.
+
+=cut
+
+sub index {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'index'} = $value;
+ } else {
+ $self->{'index'};
+ }
+}
+
+=item columns
+
+Returns a list consisting of the names of all columns.
+
+=cut
+
+sub columns {
+ my($self)=@_;
+ #keys %{$self->{'columns'}};
+ #must preserve order
+ @{ $self->{'column_order'} };
+}
+
+=item column COLUMN_NAME
+
+Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
+COLUMN_NAME.
+
+=cut
+
+sub column {
+ my($self,$column)=@_;
+ $self->{'columns'}->{$column};
+}
+
+=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns a list of SQL statments to create this table.
+
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.
+
+Although the username and password are optional, it is best to call this method
+with a database handle or data source including a valid username and password -
+a DBI connection will be opened and the quoting and type mapping will be more
+reliable.
+
+If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
+MySQL- or PostgreSQL-specific syntax. Non-standard syntax for other engines
+(if applicable) may also be supported in the future.
+
+=cut
+
+sub sql_create_table {
+ my($self, $dbh) = (shift, shift);
+
+ 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
+
+#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] );
+##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;
+
+ push @columns, "PRIMARY KEY (". $self->primary_key. ")"
+ #if $self->primary_key && $driver ne 'Pg';
+ if $self->primary_key;
+
+ my $indexnum = 1;
+
+ my @r = (
+ "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;
+ $dbh->disconnect if $created_dbh;
+ @r;
+}
+
+#
+
+sub _null_sth {
+ my($dbh, $table) = @_;
+ my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
+ or die $dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ $sth;
+}
+
+=back
+
+=head1 AUTHOR
+
+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 Mail Abuse Prevention System LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 BUGS
+
+sql_create_table() has database-specific foo that probably ought to be
+abstracted into the DBIx::DBSchema::DBD:: modules.
+
+sql_create_table may change or destroy the object's data. If you need to use
+the object after sql_create_table, make a copy beforehand.
+
+Some of the logic in new_odbc might be better abstracted into Column.pm etc.
+
+=head1 SEE ALSO
+
+L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
+L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
+
+=cut
+
+1;
+
projects / freeside.git / blobdiff