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