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 _parse_opt);
   7
   8 $VERSION = '0.14';
   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 $dbd = "DBIx::DBSchema::DBD::$driver";
 252
 253   ##
 254   # type mapping
 255   ##
 256
 257   my %typemap;
 258   %typemap = eval "\%${dbd}::typemap" if $driver;
 259   my $type = defined( $typemap{uc($self->type)} )
 260     ? $typemap{uc($self->type)}
 261     : $self->type;
 262
 263   ##
 264   # callback into the database-specific driver
 265   ##
 266
 267   my $hashref = $dbd->column_callback( $dbh, $self->table_name, $self );
 268
 269   $type = $hashref->{'effective_type'}
 270     if $hashref->{'effective_type'};
 271
 272   my $null = $self->null;
 273
 274   #we seem to do this for mysql/Pg/SQLite, i think this should be the default
 275   #add something to $hashref if drivers need to overrdide?
 276   $null ||= "NOT NULL";
 277
 278   $null =~ s/^NULL$// unless $hashref->{'explicit_null'};
 279
 280   my $default = $hashref->{'effective_default'} || $self->quoted_default($dbh);
 281   $default = "DEFAULT $default" if $default ne '';
 282
 283   my $local = $self->local;
 284   $local = $hashref->{'effective_local'}
 285     if $hashref->{'effective_local'};
 286
 287   ##
 288   # return column line
 289   ##
 290
 291   join(' ',
 292     $self->name,
 293     $type. ( ( defined($self->length) && $self->length )
 294              ? '('.$self->length.')'
 295              : ''
 296            ),
 297     $null,
 298     $default,
 299     ( defined($local) ? $local : ''),
 300   );
 301
 302 }
 303
 304 =item quoted_default DATABASE_HANDLE
 305
 306 Returns this column's default value quoted for the database.
 307
 308 =cut
 309
 310 sub quoted_default {
 311   my($self, $dbh) = @_;
 312   my $driver = $dbh ? _load_driver($dbh) : '';
 313
 314   return ${$self->default} if ref($self->default);
 315
 316   my $dbd = "DBIx::DBSchema::DBD::$driver";
 317
 318   return $dbh->quote($self->default)
 319     if defined($self->default)
 320     && $self->default ne ''
 321     && ref($dbh)
 322     && $dbd->column_value_needs_quoting($self);
 323
 324   return $self->default;
 325
 326 }
 327
 328 =item sql_add_column [ DBH ]
 329
 330 Returns a list of SQL statements to add this column to an existing table.  (To
 331 create a new table, see L<DBIx::DBSchema::Table/sql_create_table> instead.)
 332
 333 The data source can be specified by passing an open DBI database handle, or by
 334 passing the DBI data source name, username and password.
 335
 336 Although the username and password are optional, it is best to call this method
 337 with a database handle or data source including a valid username and password -
 338 a DBI connection will be opened and the quoting and type mapping will be more
 339 reliable.
 340
 341 If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
 342 use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 343 applicable) may also be supported in the future.
 344
 345 =cut
 346
 347 sub sql_add_column {
 348   my($self, $dbh) = ( shift, _dbh(@_) );
 349
 350   die "$self: this column is not assigned to a table"
 351     unless $self->table_name;
 352
 353   my $driver = $dbh ? _load_driver($dbh) : '';
 354
 355   my @sql = ();
 356   my $table = $self->table_name;
 357
 358   my $dbd = "DBIx::DBSchema::DBD::$driver";
 359   my $hashref = $dbd->add_column_callback( $dbh, $table, $self );
 360
 361   my $real_type = '';
 362   if ( $hashref->{'effective_type'} ) {
 363     $real_type = $self->type;
 364     $self->type($hashref->{'effective_type'});
 365   }
 366
 367   my $real_null = undef;
 368   if ( exists($hashref->{'effective_null'}) ) {
 369     $real_null = $self->null;
 370     $self->null($hashref->{'effective_null'});
 371   }
 372
 373   push @sql, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
 374
 375   push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'};
 376
 377   push @sql, "ALTER TABLE $table ADD PRIMARY KEY ( ".
 378              $self->table_obj->primary_key. " )"
 379     if $self->name eq $self->table_obj->primary_key;
 380
 381   $self->type($real_type) if $real_type;
 382   $self->null($real_null) if defined $real_null;
 383
 384   @sql;
 385
 386 }
 387
 388 =item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 389
 390 Returns a list of SQL statements to alter this column so that it is identical
 391 to the provided prototype column, also a DBIx::DBSchema::Column object.
 392
 393 Optionally, the data source can be specified by passing an open DBI database
 394 handle, or by passing the DBI data source name, username and password.
 395
 396 If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
 397 use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 398 applicable) may also be supported in the future.
 399
 400 If not passed a data source (or handle), or if there is no driver for the
 401 specified database, will attempt to use generic SQL syntax.
 402
 403 =cut
 404
 405 sub sql_alter_column {
 406   my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 407
 408   my $table = $self->table_name;
 409   die "$self: this column is not assigned to a table"
 410     unless $table;
 411
 412   my $name = $self->name;
 413
 414   my $driver = $dbh ? _load_driver($dbh) : '';
 415
 416   my @sql = ();
 417
 418   my $dbd = "DBIx::DBSchema::DBD::$driver";
 419   my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new );
 420
 421   if ( $hashref->{'sql_alter'} ) {
 422
 423     push @sql, $hashref->{'sql_alter'};
 424
 425   } else {
 426
 427     # change the name...
 428     # not yet implemented.  how do we tell which old column it was?
 429
 430     # change the type...
 431     if ( $hashref->{'sql_alter_type'} ) {
 432       push @sql, $hashref->{'sql_alter_type'};
 433     }
 434
 435     # change nullability...
 436
 437     if ( $hashref->{'sql_alter_null'} ) {
 438
 439       push @sql, $hashref->{'sql_alter_null'};
 440
 441     } else {
 442
 443       # change nullability from NOT NULL to NULL
 444       if ( ! $self->null && $new->null ) {
 445
 446         push @sql, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL";
 447
 448       }
 449
 450       # change nullability from NULL to NOT NULL...
 451       # this one could be more complicated, need to set a DEFAULT value and update
 452       # the table first...
 453       if ( $self->null && ! $new->null ) {
 454
 455         push @sql, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
 456
 457       }
 458
 459     }
 460
 461     # change default
 462     my $old_default = $self->quoted_default($dbh);
 463     my $new_default = $new->quoted_default($dbh);
 464     if ( $old_default ne $new_default ) {
 465
 466       my $alter = "ALTER TABLE $table ALTER COLUMN $name";
 467
 468       if ( $new_default ne '' ) {
 469         #warn "changing from $old_default to $new_default\n";
 470         push @sql, "$alter SET DEFAULT $new_default";
 471       } elsif ( $old_default !~ /^nextval/i ) { #Pg-specific :(
 472         push @sql, "$alter DROP DEFAULT";
 473
 474         push @sql, "UPDATE TABLE $table SET $name = NULL WHERE $name = ''"
 475           if $opt->{'nullify_default'} && $old_default eq "''" && $new->null;
 476       }
 477
 478     }
 479
 480     # change other stuff... (what next?)
 481
 482   }
 483
 484   @sql;
 485
 486 }
 487
 488 =item sql_drop_column [ DBH ]
 489
 490 Returns a list of SQL statements to drop this column from an existing table.
 491
 492 The optional database handle or DBI data source/username/password is not yet
 493 used.
 494
 495 =cut
 496
 497 sub sql_drop_column {
 498  my( $self, $dbh ) = ( shift, _dbh(@_) );
 499
 500  my $table = $self->table_name;
 501  my $name = $self->name;
 502
 503  ("ALTER TABLE $table DROP COLUMN $name"); # XXX what about indexes???
 504 }
 505
 506 =back
 507
 508 =head1 AUTHOR
 509
 510 Ivan Kohler <ivan-dbix-dbschema@420.am>
 511
 512 =head1 COPYRIGHT
 513
 514 Copyright (c) 2000-2006 Ivan Kohler
 515 Copyright (c) 2007-2010 Freeside Internet Services, Inc.
 516 All rights reserved.
 517 This program is free software; you can redistribute it and/or modify it under
 518 the same terms as Perl itself.
 519
 520 =head1 BUGS
 521
 522 The new() method should warn that
 523 "Old-style $class creation without named parameters is deprecated!"
 524
 525 Better documentation is needed for sql_add_column
 526
 527 sql_alter_column() has database-specific foo that should be abstracted info
 528 DBIx::DBSchema::DBD::Pg
 529
 530 nullify_default option should be documented
 531
 532 =head1 SEE ALSO
 533
 534 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 535
 536 =cut
 537
 538 1;
 539