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