DBSchema/Table.pm

   1 package DBIx::DBSchema::Table;
   2
   3 use strict;
   4 use vars qw(@ISA $VERSION $DEBUG %create_params);
   5 #use Carp;
   6 #use Exporter;
   7 use DBIx::DBSchema::_util qw(_load_driver _dbh);
   8 use DBIx::DBSchema::Column 0.07;
   9 use DBIx::DBSchema::ColGroup::Unique;
  10 use DBIx::DBSchema::ColGroup::Index;
  11
  12 #@ISA = qw(Exporter);
  13 @ISA = qw();
  14
  15 $VERSION = '0.03';
  16 $DEBUG = 0;
  17
  18 =head1 NAME
  19
  20 DBIx::DBSchema::Table - Table objects
  21
  22 =head1 SYNOPSIS
  23
  24   use DBIx::DBSchema::Table;
  25
  26   #old style (depriciated)
  27   $table = new DBIx::DBSchema::Table (
  28     "table_name",
  29     "primary_key",
  30     $dbix_dbschema_colgroup_unique_object,
  31     $dbix_dbschema_colgroup_index_object,
  32     @dbix_dbschema_column_objects,
  33   );
  34
  35   #new style (preferred), pass a hashref of parameters
  36   $table = new DBIx::DBSchema::Table (
  37     {
  38       name        => "table_name",
  39       primary_key => "primary_key",
  40       unique      => $dbix_dbschema_colgroup_unique_object,
  41       'index'     => $dbix_dbschema_colgroup_index_object,
  42       columns     => \@dbix_dbschema_column_objects,
  43     }
  44   );
  45
  46   $table->addcolumn ( $dbix_dbschema_column_object );
  47
  48   $table_name = $table->name;
  49   $table->name("table_name");
  50
  51   $primary_key = $table->primary_key;
  52   $table->primary_key("primary_key");
  53
  54   $dbix_dbschema_colgroup_unique_object = $table->unique;
  55   $table->unique( $dbix_dbschema__colgroup_unique_object );
  56
  57   $dbix_dbschema_colgroup_index_object = $table->index;
  58   $table->index( $dbix_dbschema_colgroup_index_object );
  59
  60   @column_names = $table->columns;
  61
  62   $dbix_dbschema_column_object = $table->column("column");
  63
  64   #preferred
  65   @sql_statements = $table->sql_create_table( $dbh );
  66   @sql_statements = $table->sql_create_table( $datasrc, $username, $password );
  67
  68   #possible problems
  69   @sql_statements = $table->sql_create_table( $datasrc );
  70   @sql_statements = $table->sql_create_table;
  71
  72 =head1 DESCRIPTION
  73
  74 DBIx::DBSchema::Table objects represent a single database table.
  75
  76 =head1 METHODS
  77
  78 =over 4
  79
  80 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
  81
  82 =item new HASHREF
  83
  84 Creates a new DBIx::DBSchema::Table object.  The preferred usage is to pass a
  85 hash reference of named parameters.
  86
  87   {
  88     name        => TABLE_NAME,
  89     primary_key => PRIMARY_KEY,
  90     unique      => UNIQUE,
  91     'index'     => INDEX,
  92     columns     => COLUMNS
  93   }
  94
  95 TABLE_NAME is the name of the table.  PRIMARY_KEY is the primary key (may be
  96 empty).  UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
  97 L<DBIx::DBSchema::ColGroup::Unique>).  INDEX is a
  98 DBIx::DBSchema::ColGroup::Index object (see
  99 L<DBIx::DBSchema::ColGroup::Index>).  COLUMNS is a reference to an array of
 100 DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
 101
 102 =cut
 103
 104 sub new {
 105   my $proto = shift;
 106   my $class = ref($proto) || $proto;
 107
 108   my $self;
 109   if ( ref($_[0]) ) {
 110
 111     $self = shift;
 112     $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
 113     $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };
 114
 115   } else {
 116
 117     my($name,$primary_key,$unique,$index,@columns) = @_;
 118
 119     my %columns = map { $_->name, $_ } @columns;
 120     my @column_order = map { $_->name } @columns;
 121
 122     $self = {
 123       'name'         => $name,
 124       'primary_key'  => $primary_key,
 125       'unique'       => $unique,
 126       'index'        => $index,
 127       'columns'      => \%columns,
 128       'column_order' => \@column_order,
 129     };
 130
 131   }
 132
 133   #check $primary_key, $unique and $index to make sure they are $columns ?
 134   # (and sanity check?)
 135
 136   bless ($self, $class);
 137
 138   $_->table_obj($self) foreach values %{ $self->{columns} };
 139
 140   $self;
 141 }
 142
 143 =item new_odbc DATABASE_HANDLE TABLE_NAME
 144
 145 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
 146 handle for the specified table.  This uses the experimental DBI type_info
 147 method to create a table with standard (ODBC) SQL column types that most
 148 closely correspond to any non-portable column types.   Use this to import a
 149 schema that you wish to use with many different database engines.  Although
 150 primary key and (unique) index information will only be imported from databases
 151 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
 152 column names and attributes *should* work for any database.
 153
 154 Note: the _odbc refers to the column types used and nothing else - you do not
 155 have to have ODBC installed or connect to the database via ODBC.
 156
 157 =cut
 158
 159 %create_params = (
 160 #  undef             => sub { '' },
 161   ''                => sub { '' },
 162   'max length'      => sub { $_[0]->{PRECISION}->[$_[1]]; },
 163   'precision,scale' =>
 164     sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
 165 );
 166
 167 sub new_odbc {
 168   my( $proto, $dbh, $name) = @_;
 169   my $driver = _load_driver($dbh);
 170   my $sth = _null_sth($dbh, $name);
 171   my $sthpos = 0;
 172   $proto->new (
 173     $name,
 174     scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 175     DBIx::DBSchema::ColGroup::Unique->new(
 176       $driver
 177        ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
 178        : []
 179     ),
 180     DBIx::DBSchema::ColGroup::Index->new(
 181       $driver
 182       ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
 183       : []
 184     ),
 185     map {
 186       my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
 187         or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
 188                "returned no results for type ".  $sth->{TYPE}->[$sthpos];
 189       new DBIx::DBSchema::Column
 190           $_,
 191           $type_info->{'TYPE_NAME'},
 192           #"SQL_". uc($type_info->{'TYPE_NAME'}),
 193           $sth->{NULLABLE}->[$sthpos],
 194           &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ),          $driver && #default
 195             ${ [
 196               eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
 197             ] }[4]
 198           # DB-local
 199     } @{$sth->{NAME}}
 200   );
 201 }
 202
 203 =item new_native DATABASE_HANDLE TABLE_NAME
 204
 205 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
 206 handle for the specified table.  This uses database-native methods to read the
 207 schema, and will preserve any non-portable column types.  The method is only
 208 available if there is a DBIx::DBSchema::DBD for the corresponding database
 209 engine (currently, MySQL and PostgreSQL).
 210
 211 =cut
 212
 213 sub new_native {
 214   my( $proto, $dbh, $name) = @_;
 215   my $driver = _load_driver($dbh);
 216   $proto->new (
 217     $name,
 218     scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 219     DBIx::DBSchema::ColGroup::Unique->new(
 220       [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
 221     ),
 222     DBIx::DBSchema::ColGroup::Index->new(
 223       [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
 224     ),
 225     map {
 226       DBIx::DBSchema::Column->new( @{$_} )
 227     } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
 228   );
 229 }
 230
 231 =item addcolumn COLUMN
 232
 233 Adds this DBIx::DBSchema::Column object.
 234
 235 =cut
 236
 237 sub addcolumn {
 238   my($self, $column) = @_;
 239   $column->table_obj($self);
 240   ${$self->{'columns'}}{$column->name} = $column; #sanity check?
 241   push @{$self->{'column_order'}}, $column->name;
 242 }
 243
 244 =item delcolumn COLUMN_NAME
 245
 246 Deletes this column.  Returns false if no column of this name was found to
 247 remove, true otherwise.
 248
 249 =cut
 250
 251 sub delcolumn {
 252   my($self,$column) = @_;
 253   return 0 unless exists $self->{'columns'}{$column};
 254   $self->{'columns'}{$column}->table_obj('');
 255   delete $self->{'columns'}{$column};
 256   @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}};  1;
 257 }
 258
 259 =item name [ TABLE_NAME ]
 260
 261 Returns or sets the table name.
 262
 263 =cut
 264
 265 sub name {
 266   my($self,$value)=@_;
 267   if ( defined($value) ) {
 268     $self->{name} = $value;
 269   } else {
 270     $self->{name};
 271   }
 272 }
 273
 274 =item primary_key [ PRIMARY_KEY ]
 275
 276 Returns or sets the primary key.
 277
 278 =cut
 279
 280 sub primary_key {
 281   my($self,$value)=@_;
 282   if ( defined($value) ) {
 283     $self->{primary_key} = $value;
 284   } else {
 285     #$self->{primary_key};
 286     #hmm.  maybe should untaint the entire structure when it comes off disk
 287     # cause if you don't trust that, ?
 288     $self->{primary_key} =~ /^(\w*)$/
 289       #aah!
 290       or die "Illegal primary key: ", $self->{primary_key};
 291     $1;
 292   }
 293 }
 294
 295 =item unique [ UNIQUE ]
 296
 297 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
 298
 299 =cut
 300
 301 sub unique {
 302   my($self,$value)=@_;
 303   if ( defined($value) ) {
 304     $self->{unique} = $value;
 305   } else {
 306     $self->{unique};
 307   }
 308 }
 309
 310 =item index [ INDEX ]
 311
 312 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
 313
 314 =cut
 315
 316 sub index {
 317   my($self,$value)=@_;
 318   if ( defined($value) ) {
 319     $self->{'index'} = $value;
 320   } else {
 321     $self->{'index'};
 322   }
 323 }
 324
 325 =item columns
 326
 327 Returns a list consisting of the names of all columns.
 328
 329 =cut
 330
 331 sub columns {
 332   my($self)=@_;
 333   #keys %{$self->{'columns'}};
 334   #must preserve order
 335   @{ $self->{'column_order'} };
 336 }
 337
 338 =item column COLUMN_NAME
 339
 340 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
 341 COLUMN_NAME.
 342
 343 =cut
 344
 345 sub column {
 346   my($self,$column)=@_;
 347   $self->{'columns'}->{$column};
 348 }
 349
 350 =item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 351
 352 Returns a list of SQL statments to create this table.
 353
 354 Optionally, the data source can be specified by passing an open DBI database
 355 handle, or by passing the DBI data source name, username and password.
 356
 357 The data source can be specified by passing an open DBI database handle, or by
 358 passing the DBI data source name, username and password.
 359
 360 Although the username and password are optional, it is best to call this method
 361 with a database handle or data source including a valid username and password -
 362 a DBI connection will be opened and the quoting and type mapping will be more
 363 reliable.
 364
 365 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
 366 MySQL- or PostgreSQL-specific syntax.  Non-standard syntax for other engines
 367 (if applicable) may also be supported in the future.
 368
 369 =cut
 370
 371 sub sql_create_table {
 372   my($self, $dbh) = ( shift, _dbh(@_) );
 373
 374   my $driver = _load_driver($dbh);
 375
 376 #should be in the DBD somehwere :/
 377 #  my $saved_pkey = '';
 378 #  if ( $driver eq 'Pg' && $self->primary_key ) {
 379 #    my $pcolumn = $self->column( (
 380 #      grep { $self->column($_)->name eq $self->primary_key } $self->columns
 381 #    )[0] );
 382 ##AUTO-INCREMENT#    $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
 383 #    $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
 384 #    #my $saved_pkey = $self->primary_key;
 385 #    #$self->primary_key('');
 386 #    #change it back afterwords :/
 387 #  }
 388
 389   my @columns = map { $self->column($_)->line($dbh) } $self->columns;
 390
 391   push @columns, "PRIMARY KEY (". $self->primary_key. ")"
 392     if $self->primary_key && ! grep /PRIMARY KEY/i, @columns;
 393
 394   my $indexnum = 1;
 395
 396   my @r = (
 397     "CREATE TABLE ". $self->name. " (\n  ". join(",\n  ", @columns). "\n)\n"
 398   );
 399
 400   push @r, map {
 401                  #my($index) = $self->name. "__". $_ . "_idx";
 402                  #$index =~ s/,\s*/_/g;
 403                  my $index = $self->name. $indexnum++;
 404                  "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
 405                } $self->unique->sql_list
 406     if $self->unique;
 407
 408   push @r, map {
 409                  #my($index) = $self->name. "__". $_ . "_idx";
 410                  #$index =~ s/,\s*/_/g;
 411                  my $index = $self->name. $indexnum++;
 412                  "CREATE INDEX $index ON ". $self->name. " ($_)\n"
 413                } $self->index->sql_list
 414     if $self->index;
 415
 416   #$self->primary_key($saved_pkey) if $saved_pkey;
 417   @r;
 418 }
 419
 420 =item sql_alter_table PROTOTYPE_TABLE, [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 421
 422 Returns a list of SQL statements to alter this table so that it is identical
 423 to the provided table, also a DBIx::DBSchema::Table object.
 424
 425  #Optionally, the data source can be specified by passing an open DBI database
 426  #handle, or by passing the DBI data source name, username and password.
 427  #
 428  #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
 429  #use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 430  #applicable) may also be supported in the future.
 431  #
 432  #If not passed a data source (or handle), or if there is no driver for the
 433  #specified database, will attempt to use generic SQL syntax.
 434
 435 =cut
 436
 437 #gosh, false laziness w/DBSchema::sql_update_schema
 438
 439 sub sql_alter_table {
 440   my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
 441
 442   my $table = $self->name;
 443
 444   my @r = ();
 445
 446   foreach my $column ( $new->columns ) {
 447
 448     if ( $self->column($column) )  {
 449
 450       warn "  $table.$column exists\n" if $DEBUG > 2;
 451
 452       push @r,
 453         $self->column($column)->sql_alter_column( $new->column($column), $dbh );
 454
 455     } else {
 456
 457       warn "column $table.$column does not exist.\n" if $DEBUG;
 458
 459       push @r,
 460         $new->column($column)->sql_add_column( $dbh );
 461
 462     }
 463
 464   }
 465
 466   #should eventually check & create missing indices ( & delete ones not in $new)
 467
 468   #should eventually drop columns not in $new
 469
 470   warn join("\n", @r). "\n"
 471     if $DEBUG;
 472
 473   @r;
 474
 475 }
 476
 477 sub _null_sth {
 478   my($dbh, $table) = @_;
 479   my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
 480     or die $dbh->errstr;
 481   $sth->execute or die $sth->errstr;
 482   $sth;
 483 }
 484
 485 =back
 486
 487 =head1 AUTHOR
 488
 489 Ivan Kohler <ivan-dbix-dbschema@420.am>
 490
 491 Thanks to Mark Ethan Trostler <mark@zzo.com> for a patch to allow tables
 492 with no indices.
 493
 494 =head1 COPYRIGHT
 495
 496 Copyright (c) 2000-2006 Ivan Kohler
 497 Copyright (c) 2000 Mail Abuse Prevention System LLC
 498 All rights reserved.
 499 This program is free software; you can redistribute it and/or modify it under
 500 the same terms as Perl itself.
 501
 502 =head1 BUGS
 503
 504 sql_create_table() has database-specific foo that probably ought to be
 505 abstracted into the DBIx::DBSchema::DBD:: modules.
 506
 507 sql_create_table may change or destroy the object's data.  If you need to use
 508 the object after sql_create_table, make a copy beforehand.
 509
 510 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
 511
 512 sql_alter_table ought to update indices, and drop columns not in $new
 513
 514 =head1 SEE ALSO
 515
 516 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
 517 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
 518
 519 =cut
 520
 521 1;
 522