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