DBSchema/Table.pm

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