DBSchema/Table.pm

   1 package DBIx::DBSchema::Table;
   2
   3 use strict;
   4 use vars qw(@ISA %create_params);
   5 #use Carp;
   6 use Exporter;
   7 use DBIx::DBSchema::Column;
   8 use DBIx::DBSchema::ColGroup::Unique;
   9 use DBIx::DBSchema::ColGroup::Index;
  10
  11 #@ISA = qw(Exporter);
  12 @ISA = qw();
  13
  14 =head1 NAME
  15
  16 DBIx::DBSchema::Table - Table objects
  17
  18 =head1 SYNOPSIS
  19
  20   use DBIx::DBSchema::Table;
  21
  22   $table = new DBIx::DBSchema::Table (
  23     "table_name",
  24     "primary_key",
  25     $dbix_dbschema_colgroup_unique_object,
  26     $dbix_dbschema_colgroup_index_object,
  27     @dbix_dbschema_column_objects,
  28   );
  29
  30   $table->addcolumn ( $dbix_dbschema_column_object );
  31
  32   $table_name = $table->name;
  33   $table->name("table_name");
  34
  35   $primary_key = $table->primary_key;
  36   $table->primary_key("primary_key");
  37
  38   $dbix_dbschema_colgroup_unique_object = $table->unique;
  39   $table->unique( $dbix_dbschema__colgroup_unique_object );
  40
  41   $dbix_dbschema_colgroup_index_object = $table->index;
  42   $table->index( $dbix_dbschema_colgroup_index_object );
  43
  44   @column_names = $table->columns;
  45
  46   $dbix_dbschema_column_object = $table->column("column");
  47
  48   #preferred
  49   @sql_statements = $table->sql_create_table $dbh;
  50   @sql_statements = $table->sql_create_table $datasrc, $username, $password;
  51
  52   #possible problems
  53   @sql_statements = $table->sql_create_table $datasrc;
  54   @sql_statements = $table->sql_create_table;
  55
  56 =head1 DESCRIPTION
  57
  58 DBIx::DBSchema::Table objects represent a single database table.
  59
  60 =head1 METHODS
  61
  62 =over 4
  63
  64 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
  65
  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>).
  73
  74 =cut
  75
  76 sub new {
  77   my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
  78
  79   my(%columns) = map { $_->name, $_ } @columns;
  80   my(@column_order) = map { $_->name } @columns;
  81
  82   #check $primary_key, $unique and $index to make sure they are $columns ?
  83   # (and sanity check?)
  84
  85   my $class = ref($proto) || $proto;
  86   my $self = {
  87     'name'         => $name,
  88     'primary_key'  => $primary_key,
  89     'unique'       => $unique,
  90     'index'        => $index,
  91     'columns'      => \%columns,
  92     'column_order' => \@column_order,
  93   };
  94
  95   bless ($self, $class);
  96
  97 }
  98
  99 =item new_odbc DATABASE_HANDLE TABLE_NAME
 100
 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.
 109
 110 =cut
 111
 112 %create_params = (
 113 #  undef             => sub { '' },
 114   ''                => sub { '' },
 115   'max length'      => sub { $_[0]->{PRECISION}->[$_[1]]; },
 116   'precision,scale' =>
 117     sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
 118 );
 119
 120 sub new_odbc {
 121   my( $proto, $dbh, $name) = @_;
 122   my $driver = DBIx::DBSchema::_load_driver($dbh);
 123   my $sth = _null_sth($dbh, $name);
 124   my $sthpos = 0;
 125   $proto->new (
 126     $name,
 127     scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 128     DBIx::DBSchema::ColGroup::Unique->new(
 129       $driver
 130        ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
 131        : []
 132     ),
 133     DBIx::DBSchema::ColGroup::Index->new(
 134       $driver
 135       ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
 136       : []
 137     ),
 138     map {
 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
 143           $_,
 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
 148             ${ [
 149               eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
 150             ] }[4]
 151           # DB-local
 152     } @{$sth->{NAME}}
 153   );
 154 }
 155
 156 =item new_native DATABASE_HANDLE TABLE_NAME
 157
 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).
 163
 164 =cut
 165
 166 sub new_native {
 167   my( $proto, $dbh, $name) = @_;
 168   my $driver = DBIx::DBSchema::_load_driver($dbh);
 169   $proto->new (
 170     $name,
 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)"} ]
 174     ),
 175     DBIx::DBSchema::ColGroup::Index->new(
 176       [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
 177     ),
 178     map {
 179       DBIx::DBSchema::Column->new( @{$_} )
 180     } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
 181   );
 182 }
 183
 184 =item addcolumn COLUMN
 185
 186 Adds this DBIx::DBSchema::Column object.
 187
 188 =cut
 189
 190 sub addcolumn {
 191   my($self,$column)=@_;
 192   ${$self->{'columns'}}{$column->name}=$column; #sanity check?
 193   push @{$self->{'column_order'}}, $column->name;
 194 }
 195
 196 =item name [ TABLE_NAME ]
 197
 198 Returns or sets the table name.
 199
 200 =cut
 201
 202 sub name {
 203   my($self,$value)=@_;
 204   if ( defined($value) ) {
 205     $self->{name} = $value;
 206   } else {
 207     $self->{name};
 208   }
 209 }
 210
 211 =item primary_key [ PRIMARY_KEY ]
 212
 213 Returns or sets the primary key.
 214
 215 =cut
 216
 217 sub primary_key {
 218   my($self,$value)=@_;
 219   if ( defined($value) ) {
 220     $self->{primary_key} = $value;
 221   } else {
 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*)$/
 226       #aah!
 227       or die "Illegal primary key: ", $self->{primary_key};
 228     $1;
 229   }
 230 }
 231
 232 =item unique [ UNIQUE ]
 233
 234 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
 235
 236 =cut
 237
 238 sub unique {
 239   my($self,$value)=@_;
 240   if ( defined($value) ) {
 241     $self->{unique} = $value;
 242   } else {
 243     $self->{unique};
 244   }
 245 }
 246
 247 =item index [ INDEX ]
 248
 249 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
 250
 251 =cut
 252
 253 sub index {
 254   my($self,$value)=@_;
 255   if ( defined($value) ) {
 256     $self->{'index'} = $value;
 257   } else {
 258     $self->{'index'};
 259   }
 260 }
 261
 262 =item columns
 263
 264 Returns a list consisting of the names of all columns.
 265
 266 =cut
 267
 268 sub columns {
 269   my($self)=@_;
 270   #keys %{$self->{'columns'}};
 271   #must preserve order
 272   @{ $self->{'column_order'} };
 273 }
 274
 275 =item column COLUMN_NAME
 276
 277 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
 278 COLUMN_NAME.
 279
 280 =cut
 281
 282 sub column {
 283   my($self,$column)=@_;
 284   $self->{'columns'}->{$column};
 285 }
 286
 287 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 288
 289 Returns a list of SQL statments to create this table.
 290
 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.
 293
 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
 297 reliable.
 298
 299 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
 300 MySQL- or PostgreSQL-specific syntax.  Non-standard syntax for other engines
 301 (if applicable) may also be supported in the future.
 302
 303 =cut
 304
 305 sub sql_create_table {
 306   my($self, $dbh) = (shift, shift);
 307
 308   my $created_dbh = 0;
 309   unless ( ref($dbh) || ! @_ ) {
 310     $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
 311     my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
 312     $created_dbh = 1;
 313   }
 314   #false laziness: nicked from DBSchema::_load_driver
 315   my $driver;
 316   if ( ref($dbh) ) {
 317     $driver = $dbh->{Driver}->{Name};
 318   } else {
 319     my $discard = $dbh;
 320     $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
 321                         or '' =~ /()/; # ensure $1 etc are empty if match fails
 322     $driver = $1 or die "can't parse data source: $dbh";
 323   }
 324   #eofalse
 325
 326 #  if ( $driver eq 'Pg' && $self->primary_key ) {
 327 #    my $pcolumn = $self->column( (
 328 #      grep { $self->column($_)->name eq $self->primary_key } $self->columns
 329 #    )[0] );
 330 #    $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
 331 ##    $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
 332 ##    $self->primary_key('');
 333 #    #prolly shoudl change it back afterwords :/
 334 #  }
 335
 336   my(@columns)=map { $self->column($_)->line($dbh) } $self->columns;
 337
 338   push @columns, "PRIMARY KEY (". $self->primary_key. ")"
 339     if $self->primary_key && $driver ne 'Pg';
 340
 341   if ( $driver eq 'mysql' ) { #yucky mysql hack
 342     push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
 343     push @columns, map "INDEX ($_)", $self->index->sql_list;
 344   }
 345
 346   my $indexnum = 1;
 347
 348   my @r = (
 349     "CREATE TABLE ". $self->name. " (\n  ". join(",\n  ", @columns). "\n)\n",
 350     ( map {
 351       #my($index) = $self->name. "__". $_ . "_idx";
 352       #$index =~ s/,\s*/_/g;
 353       my $index = $self->name. $indexnum++;
 354       "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
 355     } $self->unique->sql_list ),
 356     ( map {
 357       #my($index) = $self->name. "__". $_ . "_idx";
 358       #$index =~ s/,\s*/_/g;
 359       my $index = $self->name. $indexnum++;
 360       "CREATE INDEX $index ON ". $self->name. " ($_)\n"
 361     } $self->index->sql_list ),
 362   );
 363   $dbh->disconnect if $created_dbh;
 364   @r;
 365 }
 366
 367 #
 368
 369 sub _null_sth {
 370   my($dbh, $table) = @_;
 371   my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
 372     or die $dbh->errstr;
 373   $sth->execute or die $sth->errstr;
 374   $sth;
 375 }
 376
 377 =back
 378
 379 =head1 AUTHOR
 380
 381 Ivan Kohler <ivan-dbix-dbschema@420.am>
 382
 383 =head1 COPYRIGHT
 384
 385 Copyright (c) 2000 Ivan Kohler
 386 Copyright (c) 2000 Mail Abuse Prevention System LLC
 387 All rights reserved.
 388 This program is free software; you can redistribute it and/or modify it under
 389 the same terms as Perl itself.
 390
 391 =head1 BUGS
 392
 393 sql_create_table() has database-specific foo that probably ought to be
 394 abstracted into the DBIx::DBSchema::DBD:: modules.
 395
 396 sql_create_table may change or destroy the object's data.  If you need to use
 397 the object after sql_create_table, make a copy beforehand.
 398
 399 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
 400
 401 =head1 SEE ALSO
 402
 403 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
 404 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
 405
 406 =cut
 407
 408 1;
 409