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   @sql_statements = $table->sql_create_table;
  49   @sql_statements = $table->sql_create_table $datasrc;
  50
  51 =head1 DESCRIPTION
  52
  53 DBIx::DBSchema::Table objects represent a single database table.
  54
  55 =head1 METHODS
  56
  57 =over 4
  58
  59 =item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]
  60
  61 Creates a new DBIx::DBSchema::Table object.  TABLE_NAME is the name of the
  62 table.  PRIMARY_KEY is the primary key (may be empty).  UNIQUE is a
  63 DBIx::DBSchema::ColGroup::Unique object (see
  64 L<DBIx::DBSchema::ColGroup::Unique>).  INDEX is a
  65 DBIx::DBSchema::ColGroup::Index object (see
  66 L<DBIx::DBSchema::ColGroup::Index>).  The rest of the arguments should be
  67 DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).
  68
  69 =cut
  70
  71 sub new {
  72   my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
  73
  74   my(%columns) = map { $_->name, $_ } @columns;
  75   my(@column_order) = map { $_->name } @columns;
  76
  77   #check $primary_key, $unique and $index to make sure they are $columns ?
  78   # (and sanity check?)
  79
  80   my $class = ref($proto) || $proto;
  81   my $self = {
  82     'name'         => $name,
  83     'primary_key'  => $primary_key,
  84     'unique'       => $unique,
  85     'index'        => $index,
  86     'columns'      => \%columns,
  87     'column_order' => \@column_order,
  88   };
  89
  90   bless ($self, $class);
  91
  92 }
  93
  94 =item new_odbc DATABASE_HANDLE TABLE_NAME
  95
  96 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
  97 handle for the specified table.  This uses the experimental DBI type_info
  98 method to create a table with standard (ODBC) SQL column types that most
  99 closely correspond to any non-portable column types.   Use this to import a
 100 schema that you wish to use with many different database engines.  Although
 101 primary key and (unique) index information will only be imported from databases
 102 with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
 103 column names and attributes *should* work for any database.
 104
 105 =cut
 106
 107 %create_params = (
 108 #  undef             => sub { '' },
 109   ''                => sub { '' },
 110   'max length'      => sub { $_[0]->{PRECISION}->[$_[1]]; },
 111   'precision,scale' =>
 112     sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
 113 );
 114
 115 sub new_odbc {
 116   my( $proto, $dbh, $name) = @_;
 117   my $driver = DBIx::DBSchema::_load_driver($dbh);
 118   my $sth = _null_sth($dbh, $name);
 119   my $sthpos = 0;
 120   $proto->new (
 121     $name,
 122     scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 123     DBIx::DBSchema::ColGroup::Unique->new(
 124       $driver
 125        ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
 126        : []
 127     ),
 128     DBIx::DBSchema::ColGroup::Index->new(
 129       $driver
 130       ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
 131       : []
 132     ),
 133     map {
 134       my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
 135         or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
 136                "returned no results for type ".  $sth->{TYPE}->[$sthpos];
 137       new DBIx::DBSchema::Column
 138           $_,
 139           $type_info->{'TYPE_NAME'},
 140           #"SQL_". uc($type_info->{'TYPE_NAME'}),
 141           $sth->{NULLABLE}->[$sthpos],
 142           &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ),          $driver && #default
 143             ${ [
 144               eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
 145             ] }[4]
 146           # DB-local
 147     } @{$sth->{NAME}}
 148   );
 149 }
 150
 151 =item new_native DATABASE_HANDLE TABLE_NAME
 152
 153 Creates a new DBIx::DBSchema::Table object from the supplied DBI database
 154 handle for the specified table.  This uses database-native methods to read the
 155 schema, and will preserve any non-portable column types.  The method is only
 156 available if there is a DBIx::DBSchema::DBD for the corresponding database
 157 engine (currently, MySQL and PostgreSQL).
 158
 159 =cut
 160
 161 sub new_native {
 162   my( $proto, $dbh, $name) = @_;
 163   my $driver = DBIx::DBSchema::_load_driver($dbh);
 164   $proto->new (
 165     $name,
 166     scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
 167     DBIx::DBSchema::ColGroup::Unique->new(
 168       [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
 169     ),
 170     DBIx::DBSchema::ColGroup::Index->new(
 171       [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
 172     ),
 173     map {
 174       DBIx::DBSchema::Column->new( @{$_} )
 175     } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
 176   );
 177 }
 178
 179 =item addcolumn COLUMN
 180
 181 Adds this DBIx::DBSchema::Column object.
 182
 183 =cut
 184
 185 sub addcolumn {
 186   my($self,$column)=@_;
 187   ${$self->{'columns'}}{$column->name}=$column; #sanity check?
 188   push @{$self->{'column_order'}}, $column->name;
 189 }
 190
 191 =item name [ TABLE_NAME ]
 192
 193 Returns or sets the table name.
 194
 195 =cut
 196
 197 sub name {
 198   my($self,$value)=@_;
 199   if ( defined($value) ) {
 200     $self->{name} = $value;
 201   } else {
 202     $self->{name};
 203   }
 204 }
 205
 206 =item primary_key [ PRIMARY_KEY ]
 207
 208 Returns or sets the primary key.
 209
 210 =cut
 211
 212 sub primary_key {
 213   my($self,$value)=@_;
 214   if ( defined($value) ) {
 215     $self->{primary_key} = $value;
 216   } else {
 217     #$self->{primary_key};
 218     #hmm.  maybe should untaint the entire structure when it comes off disk
 219     # cause if you don't trust that, ?
 220     $self->{primary_key} =~ /^(\w*)$/
 221       #aah!
 222       or die "Illegal primary key: ", $self->{primary_key};
 223     $1;
 224   }
 225 }
 226
 227 =item unique [ UNIQUE ]
 228
 229 Returns or sets the DBIx::DBSchema::ColGroup::Unique object.
 230
 231 =cut
 232
 233 sub unique {
 234   my($self,$value)=@_;
 235   if ( defined($value) ) {
 236     $self->{unique} = $value;
 237   } else {
 238     $self->{unique};
 239   }
 240 }
 241
 242 =item index [ INDEX ]
 243
 244 Returns or sets the DBIx::DBSchema::ColGroup::Index object.
 245
 246 =cut
 247
 248 sub index {
 249   my($self,$value)=@_;
 250   if ( defined($value) ) {
 251     $self->{'index'} = $value;
 252   } else {
 253     $self->{'index'};
 254   }
 255 }
 256
 257 =item columns
 258
 259 Returns a list consisting of the names of all columns.
 260
 261 =cut
 262
 263 sub columns {
 264   my($self)=@_;
 265   #keys %{$self->{'columns'}};
 266   #must preserve order
 267   @{ $self->{'column_order'} };
 268 }
 269
 270 =item column COLUMN_NAME
 271
 272 Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
 273 COLUMN_NAME.
 274
 275 =cut
 276
 277 sub column {
 278   my($self,$column)=@_;
 279   $self->{'columns'}->{$column};
 280 }
 281
 282 =item sql_create_table [ DATASRC ]
 283
 284 Returns a list of SQL statments to create this table.
 285
 286 If passed a DBI data source such as `DBI:mysql:database', will use
 287 MySQL-specific syntax.  PostgreSQL is also supported (requires no special
 288 syntax).  Non-standard syntax for other engines (if applicable) may also be
 289 supported in the future.
 290
 291 =cut
 292
 293 sub sql_create_table {
 294   my($self,$datasrc)=@_;
 295   my(@columns)=map { $self->column($_)->line($datasrc) } $self->columns;
 296   push @columns, "PRIMARY KEY (". $self->primary_key. ")"
 297     if $self->primary_key;
 298   if ( $datasrc =~ /^dbi:mysql:/i ) { #yucky mysql hack
 299     push @columns, map "UNIQUE ($_)", $self->unique->sql_list;
 300     push @columns, map "INDEX ($_)", $self->index->sql_list;
 301   }
 302
 303   "CREATE TABLE ". $self->name. " (\n  ". join(",\n  ", @columns). "\n)\n",
 304   ( map {
 305     my($index) = $self->name. "__". $_ . "_index";
 306     $index =~ s/,\s*/_/g;
 307     "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
 308   } $self->unique->sql_list ),
 309   ( map {
 310     my($index) = $self->name. "__". $_ . "_index";
 311     $index =~ s/,\s*/_/g;
 312     "CREATE INDEX $index ON ". $self->name. " ($_)\n"
 313   } $self->index->sql_list ),
 314   ;
 315
 316 }
 317
 318 #
 319
 320 sub _null_sth {
 321   my($dbh, $table) = @_;
 322   my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
 323     or die $dbh->errstr;
 324   $sth->execute or die $sth->errstr;
 325   $sth;
 326 }
 327
 328 =back
 329
 330 =head1 AUTHOR
 331
 332 Ivan Kohler <ivan-dbix-dbschema@420.am>
 333
 334 =head1 COPYRIGHT
 335
 336 Copyright (c) 2000 Ivan Kohler
 337 Copyright (c) 2000 Mail Abuse Prevention System LLC
 338 All rights reserved.
 339 This program is free software; you can redistribute it and/or modify it under
 340 the same terms as Perl itself.
 341
 342 =head1 BUGS
 343
 344 sql_create_table() has database-specific foo that probably ought to be
 345 abstracted into the DBIx::DBSchema::DBD:: modules.
 346
 347 Some of the logic in new_odbc might be better abstracted into Column.pm etc.
 348
 349 =head1 SEE ALSO
 350
 351 L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
 352 L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>
 353
 354 =cut
 355
 356 1;
 357