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