DBSchema/Column.pm

   1 package DBIx::DBSchema::Column;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5 use Carp;
   6 use DBIx::DBSchema::_util qw(_load_driver _dbh);
   7
   8 $VERSION = '0.13';
   9
  10 =head1 NAME
  11
  12 DBIx::DBSchema::Column - Column objects
  13
  14 =head1 SYNOPSIS
  15
  16   use DBIx::DBSchema::Column;
  17
  18   #named params with a hashref (preferred)
  19   $column = new DBIx::DBSchema::Column ( {
  20     'name'    => 'column_name',
  21     'type'    => 'varchar'
  22     'null'    => 'NOT NULL',
  23     'length'  => 64,
  24     'default' => '',
  25     'local'   => '',
  26   } );
  27
  28   #list
  29   $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
  30
  31   $name = $column->name;
  32   $column->name( 'name' );
  33
  34   $sql_type = $column->type;
  35   $column->type( 'sql_type' );
  36
  37   $null = $column->null;
  38   $column->null( 'NULL' );
  39   $column->null( 'NOT NULL' );
  40   $column->null( '' );
  41
  42   $length = $column->length;
  43   $column->length( '10' );
  44   $column->length( '8,2' );
  45
  46   $default = $column->default;
  47   $column->default( 'Roo' );
  48
  49   $sql_line = $column->line;
  50   $sql_line = $column->line($datasrc);
  51
  52   $sql_add_column = $column->sql_add_column;
  53   $sql_add_column = $column->sql_add_column($datasrc);
  54
  55 =head1 DESCRIPTION
  56
  57 DBIx::DBSchema::Column objects represent columns in tables (see
  58 L<DBIx::DBSchema::Table>).
  59
  60 =head1 METHODS
  61
  62 =over 4
  63
  64 =item new HASHREF
  65
  66 =item new [ name [ , type [ , null [ , length  [ , default [ , local ] ] ] ] ] ]
  67
  68 Creates a new DBIx::DBSchema::Column object.  Takes a hashref of named
  69 parameters, or a list.  B<name> is the name of the column.  B<type> is the SQL
  70 data type.  B<null> is the nullability of the column (intrepreted using Perl's
  71 rules for truth, with one exception: `NOT NULL' is false).  B<length> is the
  72 SQL length of the column.  B<default> is the default value of the column.
  73 B<local> is reserved for database-specific information.
  74
  75 Note: If you pass a scalar reference as the B<default> rather than a scalar value, it will be dereferenced and quoting will be forced off.  This can be used to pass SQL functions such as C<$now()> or explicit empty strings as C<''> as
  76 defaults.
  77
  78 =cut
  79
  80 sub new {
  81   my $proto = shift;
  82   my $class = ref($proto) || $proto;
  83
  84   my $self;
  85   if ( ref($_[0]) ) {
  86     $self = shift;
  87   } else {
  88     #carp "Old-style $class creation without named parameters is deprecated!";
  89     #croak "FATAL: old-style $class creation no longer supported;".
  90     #      " use named parameters";
  91
  92     $self = { map { $_ => shift } qw(name type null length default local) };
  93   }
  94
  95   #croak "Illegal name: ". $self->{'name'}
  96   #  if grep $self->{'name'} eq $_, @reserved_words;
  97
  98   $self->{'null'} =~ s/^NOT NULL$//i;
  99   $self->{'null'} = 'NULL' if $self->{'null'};
 100
 101   bless ($self, $class);
 102
 103 }
 104
 105 =item name [ NAME ]
 106
 107 Returns or sets the column name.
 108
 109 =cut
 110
 111 sub name {
 112   my($self,$value)=@_;
 113   if ( defined($value) ) {
 114   #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
 115     $self->{'name'} = $value;
 116   } else {
 117     $self->{'name'};
 118   }
 119 }
 120
 121 =item type [ TYPE ]
 122
 123 Returns or sets the column type.
 124
 125 =cut
 126
 127 sub type {
 128   my($self,$value)=@_;
 129   if ( defined($value) ) {
 130     $self->{'type'} = $value;
 131   } else {
 132     $self->{'type'};
 133   }
 134 }
 135
 136 =item null [ NULL ]
 137
 138 Returns or sets the column null flag (the empty string is equivalent to
 139 `NOT NULL')
 140
 141 =cut
 142
 143 sub null {
 144   my($self,$value)=@_;
 145   if ( defined($value) ) {
 146     $value =~ s/^NOT NULL$//i;
 147     $value = 'NULL' if $value;
 148     $self->{'null'} = $value;
 149   } else {
 150     $self->{'null'};
 151   }
 152 }
 153
 154 =item length [ LENGTH ]
 155
 156 Returns or sets the column length.
 157
 158 =cut
 159
 160 sub length {
 161   my($self,$value)=@_;
 162   if ( defined($value) ) {
 163     $self->{'length'} = $value;
 164   } else {
 165     $self->{'length'};
 166   }
 167 }
 168
 169 =item default [ LOCAL ]
 170
 171 Returns or sets the default value.
 172
 173 =cut
 174
 175 sub default {
 176   my($self,$value)=@_;
 177   if ( defined($value) ) {
 178     $self->{'default'} = $value;
 179   } else {
 180     $self->{'default'};
 181   }
 182 }
 183
 184
 185 =item local [ LOCAL ]
 186
 187 Returns or sets the database-specific field.
 188
 189 =cut
 190
 191 sub local {
 192   my($self,$value)=@_;
 193   if ( defined($value) ) {
 194     $self->{'local'} = $value;
 195   } else {
 196     $self->{'local'};
 197   }
 198 }
 199
 200 =item table_obj [ TABLE_OBJ ]
 201
 202 Returns or sets the table object (see L<DBIx::DBSchema::Table>).  Typically
 203 set internally when a column object is added to a table object.
 204
 205 =cut
 206
 207 sub table_obj {
 208   my($self,$value)=@_;
 209   if ( defined($value) ) {
 210     $self->{'table_obj'} = $value;
 211   } else {
 212     $self->{'table_obj'};
 213   }
 214 }
 215
 216 =item table_name
 217
 218 Returns the table name, or the empty string if this column has not yet been
 219 assigned to a table.
 220
 221 =cut
 222
 223 sub table_name {
 224   my $self = shift;
 225   $self->{'table_obj'} ? $self->{'table_obj'}->name : '';
 226 }
 227
 228 =item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 229
 230 Returns an SQL column definition.
 231
 232 The data source can be specified by passing an open DBI database handle, or by
 233 passing the DBI data source name, username and password.
 234
 235 Although the username and password are optional, it is best to call this method
 236 with a database handle or data source including a valid username and password -
 237 a DBI connection will be opened and the quoting and type mapping will be more
 238 reliable.
 239
 240 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
 241 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
 242 Currently supported databases are MySQL and PostgreSQL.  Non-standard syntax
 243 for other engines (if applicable) may also be supported in the future.
 244
 245 =cut
 246
 247 sub line {
 248   my($self, $dbh) = ( shift, _dbh(@_) );
 249
 250   my $driver = $dbh ? _load_driver($dbh) : '';
 251   my $driver_class = "DBIx::DBSchema::DBD::${driver}";
 252
 253   ##
 254   # type mapping
 255   ##
 256
 257   my %typemap;
 258   %typemap = eval "\%${driver_class}::typemap" if $driver;
 259   my $type = defined( $typemap{uc($self->type)} )
 260     ? $typemap{uc($self->type)}
 261     : $self->type;
 262
 263   ##
 264   # set default for the callback...
 265   ##
 266
 267   my $default;
 268   my $orig_default = $self->default;
 269   if ( $driver_class->can("_column_value_needs_quoting") ) {
 270     if ( $driver_class->_column_value_needs_quoting($self)
 271          && !ref($self->default)
 272        )
 273     {
 274       $default = $dbh->quote($self->default);
 275     } else {
 276       $default = ref($self->default) ? ${$self->default} : $self->default;
 277     }
 278   } elsif ( defined($self->default) && !ref($self->default) && $self->default ne ''
 279        && ref($dbh)
 280        # false laziness: nicked from FS::Record::_quote
 281        && ( $self->default !~ /^\-?\d+(\.\d+)?$/
 282             || $type =~ /(char|binary|blob|text)$/i
 283           )
 284   ) {
 285     $default = $dbh->quote($self->default);
 286   } else {
 287     $default = ref($self->default) ? ${$self->default} : $self->default;
 288   }
 289   $self->default($default);
 290
 291   ##
 292   # callback into the database-specific driver
 293   ##
 294
 295   my $dbd = "DBIx::DBSchema::DBD::$driver";
 296   my $hashref = $dbd->column_callback( $dbh, $self->table_name, $self );
 297
 298   $self->default($orig_default);
 299
 300   $type = $hashref->{'effective_type'}
 301     if $hashref->{'effective_type'};
 302
 303   my $null = $self->null;
 304
 305   #we seem to do this for mysql/Pg/SQLite, i think this should be the default
 306   #add something to $hashref if drivers need to overrdide?
 307   $null ||= "NOT NULL";
 308
 309   $null =~ s/^NULL$// unless $hashref->{'explicit_null'};
 310
 311   $default = $hashref->{'effective_default'}
 312     if $hashref->{'effective_default'};
 313
 314   my $local = $self->local;
 315   $local = $hashref->{'effective_local'}
 316     if $hashref->{'effective_local'};
 317
 318   ##
 319   # return column line
 320   ##
 321
 322   join(' ',
 323     $self->name,
 324     $type. ( ( defined($self->length) && $self->length )
 325              ? '('.$self->length.')'
 326              : ''
 327            ),
 328     $null,
 329     ( ( defined($default) && $default ne '' )
 330       ? 'DEFAULT '. $default
 331       : ''
 332     ),
 333     ( defined($local) ? $local : ''),
 334   );
 335
 336 }
 337
 338 =item sql_add_column [ DBH ]
 339
 340 Returns a list of SQL statements to add this column to an existing table.  (To
 341 create a new table, see L<DBIx::DBSchema::Table/sql_create_table> instead.)
 342
 343 The data source can be specified by passing an open DBI database handle, or by
 344 passing the DBI data source name, username and password.
 345
 346 Although the username and password are optional, it is best to call this method
 347 with a database handle or data source including a valid username and password -
 348 a DBI connection will be opened and the quoting and type mapping will be more
 349 reliable.
 350
 351 If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
 352 use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 353 applicable) may also be supported in the future.
 354
 355 =cut
 356
 357 sub sql_add_column {
 358   my($self, $dbh) = ( shift, _dbh(@_) );
 359
 360   die "$self: this column is not assigned to a table"
 361     unless $self->table_name;
 362
 363   my $driver = $dbh ? _load_driver($dbh) : '';
 364
 365   my @sql = ();
 366   my $table = $self->table_name;
 367
 368   my $dbd = "DBIx::DBSchema::DBD::$driver";
 369   my $hashref = $dbd->add_column_callback( $dbh, $table, $self );
 370
 371   my $real_type = '';
 372   if ( $hashref->{'effective_type'} ) {
 373     $real_type = $self->type;
 374     $self->type($hashref->{'effective_type'});
 375   }
 376
 377   my $real_null = undef;
 378   if ( exists($hashref->{'effective_null'}) ) {
 379     $real_null = $self->null;
 380     $self->null($hashref->{'effective_null'});
 381   }
 382
 383   push @sql, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
 384
 385   push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'};
 386
 387   push @sql, "ALTER TABLE $table ADD PRIMARY KEY ( ".
 388              $self->table_obj->primary_key. " )"
 389     if $self->name eq $self->table_obj->primary_key;
 390
 391   $self->type($real_type) if $real_type;
 392   $self->null($real_null) if defined $real_null;
 393
 394   @sql;
 395
 396 }
 397
 398 =item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 399
 400 Returns a list of SQL statements to alter this column so that it is identical
 401 to the provided prototype column, also a DBIx::DBSchema::Column object.
 402
 403  #Optionally, the data source can be specified by passing an open DBI database
 404  #handle, or by passing the DBI data source name, username and password.
 405  #
 406  #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
 407  #use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 408  #applicable) may also be supported in the future.
 409  #
 410  #If not passed a data source (or handle), or if there is no driver for the
 411  #specified database, will attempt to use generic SQL syntax.
 412
 413
 414 Or should, someday.  Right now it knows how to change NOT NULL into NULL and
 415 vice-versa.
 416
 417 =cut
 418
 419 sub sql_alter_column {
 420   my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
 421
 422   my $table = $self->table_name;
 423   die "$self: this column is not assigned to a table"
 424     unless $table;
 425
 426   my $name = $self->name;
 427
 428   my $driver = $dbh ? _load_driver($dbh) : '';
 429
 430   my @sql = ();
 431
 432   my $dbd = "DBIx::DBSchema::DBD::$driver";
 433   my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new );
 434
 435   if ( $hashref->{'sql_alter'} ) {
 436
 437     push @sql, $hashref->{'sql_alter'};
 438
 439   } else {
 440
 441     # change the name...
 442     # not yet implemented.  how do we tell which old column it was?
 443
 444     # change the type...
 445     if ( $hashref->{'sql_alter_type'} ) {
 446       push @sql, $hashref->{'sql_alter_type'};
 447     }
 448
 449     # change nullability...
 450
 451     if ( $hashref->{'sql_alter_null'} ) {
 452
 453       push @sql, $hashref->{'sql_alter_null'};
 454
 455     } else {
 456
 457       # change nullability from NOT NULL to NULL
 458       if ( ! $self->null && $new->null ) {
 459
 460         push @sql, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL";
 461
 462       }
 463
 464       # change nullability from NULL to NOT NULL...
 465       # this one could be more complicated, need to set a DEFAULT value and update
 466       # the table first...
 467       if ( $self->null && ! $new->null ) {
 468
 469         push @sql, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
 470
 471       }
 472
 473     }
 474
 475     # change default
 476
 477     # change other stuff...
 478
 479   }
 480
 481   @sql;
 482
 483 }
 484 =item sql_drop_column [ DBH ]
 485
 486 Returns a list of SQL statements to drop this column from an existing table.
 487
 488 The optional database handle or DBI data source/username/password is not yet
 489 used.
 490
 491 =cut
 492
 493 sub sql_drop_column {
 494  my( $self, $dbh ) = ( shift, _dbh(@_) );
 495
 496  my $table = $self->table_name;
 497  my $name = $self->name;
 498
 499  ("ALTER TABLE $table DROP COLUMN $name"); # XXX what about indexes???
 500 }
 501
 502 =back
 503
 504 =head1 AUTHOR
 505
 506 Ivan Kohler <ivan-dbix-dbschema@420.am>
 507
 508 =head1 COPYRIGHT
 509
 510 Copyright (c) 2000-2006 Ivan Kohler
 511 Copyright (c) 2007 Freeside Internet Services, Inc.
 512 All rights reserved.
 513 This program is free software; you can redistribute it and/or modify it under
 514 the same terms as Perl itself.
 515
 516 =head1 BUGS
 517
 518 The new() method should warn that
 519 "Old-style $class creation without named parameters is deprecated!"
 520
 521 Better documentation is needed for sql_add_column
 522
 523 line() and sql_add_column() hav database-specific foo that should be abstracted
 524 into the DBIx::DBSchema:DBD:: modules.
 525
 526 =head1 SEE ALSO
 527
 528 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 529
 530 =cut
 531
 532 1;
 533