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