doc
[DBIx-DBSchema.git] / DBSchema / Column.pm
index 0d00159..27c4c22 100644 (file)
@@ -3,9 +3,9 @@ package DBIx::DBSchema::Column;
 use strict;
 use vars qw($VERSION);
 use Carp;
-use DBIx::DBSchema::_util qw(_load_driver _dbh);
+use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
 
-$VERSION = '0.13';
+$VERSION = '0.14';
 
 =head1 NAME
 
@@ -72,7 +72,7 @@ rules for truth, with one exception: `NOT NULL' is false).  B<length> is the
 SQL length of the column.  B<default> is the default value of the column.
 B<local> is reserved for database-specific information.
 
-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
+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
 defaults.
 
 =cut
@@ -248,55 +248,24 @@ sub line {
   my($self, $dbh) = ( shift, _dbh(@_) );
 
   my $driver = $dbh ? _load_driver($dbh) : '';
-  my $driver_class = "DBIx::DBSchema::DBD::${driver}";
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
 
   ##
   # type mapping
   ## 
 
   my %typemap;
-  %typemap = eval "\%${driver_class}::typemap" if $driver;
+  %typemap = eval "\%${dbd}::typemap" if $driver;
   my $type = defined( $typemap{uc($self->type)} )
     ? $typemap{uc($self->type)}
     : $self->type;
 
   ##
-  # set default for the callback...
-  ##
-
-  my $default;
-  my $orig_default = $self->default;
-  if ( $driver_class->can("_column_value_needs_quoting") ) {
-    if ( $driver_class->_column_value_needs_quoting($self)
-         && !ref($self->default)
-       )
-    {
-      $default = $dbh->quote($self->default);
-    } else {
-      $default = ref($self->default) ? ${$self->default} : $self->default;
-    }
-  } elsif ( defined($self->default) && !ref($self->default) && $self->default ne ''
-       && ref($dbh)
-       # false laziness: nicked from FS::Record::_quote
-       && ( $self->default !~ /^\-?\d+(\.\d+)?$/
-            || $type =~ /(char|binary|blob|text)$/i
-          )
-  ) {
-    $default = $dbh->quote($self->default);
-  } else {
-    $default = ref($self->default) ? ${$self->default} : $self->default;
-  }
-  $self->default($default);
-
-  ##
   # callback into the database-specific driver
   ##
 
-  my $dbd = "DBIx::DBSchema::DBD::$driver";
   my $hashref = $dbd->column_callback( $dbh, $self->table_name, $self );
 
-  $self->default($orig_default);
-
   $type = $hashref->{'effective_type'}
     if $hashref->{'effective_type'};
 
@@ -308,8 +277,8 @@ sub line {
 
   $null =~ s/^NULL$// unless $hashref->{'explicit_null'};
 
-  $default = $hashref->{'effective_default'}
-    if $hashref->{'effective_default'};
+  my $default = $hashref->{'effective_default'} || $self->quoted_default($dbh);
+  $default = "DEFAULT $default" if $default ne '';
 
   my $local = $self->local;
   $local = $hashref->{'effective_local'}
@@ -326,19 +295,46 @@ sub line {
              : ''
            ),
     $null,
-    ( ( defined($default) && $default ne '' )
-      ? 'DEFAULT '. $default
-      : ''
-    ),
+    $default,
     ( defined($local) ? $local : ''),
   );
 
 }
 
-=item sql_add_column [ DBH ] 
+=item quoted_default DATABASE_HANDLE
+
+Returns this column's default value quoted for the database.
+
+=cut
+
+sub quoted_default {
+  my($self, $dbh) = @_;
+  my $driver = $dbh ? _load_driver($dbh) : '';
 
-Returns a list of SQL statements to add this column to an existing table.  (To
-create a new table, see L<DBIx::DBSchema::Table/sql_create_table> instead.)
+  return ${$self->default} if ref($self->default);
+
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
+
+  return $dbh->quote($self->default)
+    if defined($self->default)
+    && $self->default ne ''
+    && ref($dbh)
+    && $dbd->column_value_needs_quoting($self);
+  
+  return $self->default;
+
+}
+
+=item sql_add_column [ DBH ]
+
+Returns SQL to add this column to an existing table.  (To create a new table,
+see L<DBIx::DBSchema::Table/sql_create_table> instead.)
+
+NOTE: This interface has changed in 0.41
+
+Returns two listrefs.  The first is a list of column alteration SQL fragments
+for an ALTER TABLE statement.  The second is a list of full SQL statements that
+should be run after the ALTER TABLE statement.
 
 The data source can be specified by passing an open DBI database handle, or by
 passing the DBI data source name, username and password.  
@@ -362,6 +358,7 @@ sub sql_add_column {
 
   my $driver = $dbh ? _load_driver($dbh) : '';
 
+  my @alter_table = ();
   my @sql = ();
   my $table = $self->table_name;
 
@@ -380,7 +377,7 @@ sub sql_add_column {
     $self->null($hashref->{'effective_null'});
   }
 
-  push @sql, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
+  push @alter_table, "ADD COLUMN ". $self->line($dbh);
 
   push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'};
 
@@ -391,33 +388,35 @@ sub sql_add_column {
   $self->type($real_type) if $real_type;
   $self->null($real_null) if defined $real_null;
 
-  @sql;
+  (\@alter_table, \@sql);
 
 }
 
 =item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 
-Returns a list of SQL statements to alter this column so that it is identical
-to the provided prototype column, also a DBIx::DBSchema::Column object.
+Returns SQL to alter this column so that it is identical to the provided
+prototype column, also a DBIx::DBSchema::Column object.
 
- #Optionally, the data source can be specified by passing an open DBI database
- #handle, or by passing the DBI data source name, username and password.  
- #
- #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
- #use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
- #applicable) may also be supported in the future.
- #
- #If not passed a data source (or handle), or if there is no driver for the
- #specified database, will attempt to use generic SQL syntax.
+NOTE: This interface has changed in 0.41
 
+Returns two listrefs.  The first is a list of column alteration SQL fragments
+for an ALTER TABLE statement.  The second is a list of full SQL statements that
+should be run after the ALTER TABLE statement.
 
-Or should, someday.  Right now it knows how to change NOT NULL into NULL and
-vice-versa.
+Optionally, the data source can be specified by passing an open DBI database
+handle, or by passing the DBI data source name, username and password.  
+
+If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
+use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
+applicable) may also be supported in the future.
+
+If not passed a data source (or handle), or if there is no driver for the
+specified database, will attempt to use generic SQL syntax.
 
 =cut
 
 sub sql_alter_column {
-  my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+  my($self, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), shift, _dbh(@_) );
 
   my $table = $self->table_name;
   die "$self: this column is not assigned to a table"
@@ -427,6 +426,7 @@ sub sql_alter_column {
 
   my $driver = $dbh ? _load_driver($dbh) : '';
 
+  my @alter_table = ();
   my @sql = ();
 
   my $dbd = "DBIx::DBSchema::DBD::$driver";
@@ -443,7 +443,7 @@ sub sql_alter_column {
 
     # change the type...
     if ( $hashref->{'sql_alter_type'} ) {
-      push @sql, $hashref->{'sql_alter_type'};
+      push @alter_table, $hashref->{'sql_alter_type'};
     }
 
     # change nullability...
@@ -457,7 +457,7 @@ sub sql_alter_column {
       # change nullability from NOT NULL to NULL
       if ( ! $self->null && $new->null ) {
     
-        push @sql, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL";
+        push @alter_table, "ALTER COLUMN $name DROP NOT NULL";
     
       }
     
@@ -466,24 +466,51 @@ sub sql_alter_column {
       # the table first...
       if ( $self->null && ! $new->null ) {
     
-        push @sql, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
+        push @alter_table, "ALTER COLUMN $name SET NOT NULL";
     
       }
 
     }
 
     # change default
+    my $old_default = $self->quoted_default($dbh);
+    my $new_default = $new->quoted_default($dbh);
+    if ( $old_default ne $new_default
+         && ( uc($old_default) ne 'NOW()' || uc($new_default) ne 'NOW()' )
+       )
+    {
 
-    # change other stuff...
+      #warn "old default: $old_default / new default: $new_default\n";
+
+      my $alter = "ALTER COLUMN $name";
+
+      if ( $new_default ne '' ) {
+        #warn "changing from $old_default to $new_default\n";
+        push @alter_table, "$alter SET DEFAULT $new_default";
+      } elsif ( $old_default !~ /^nextval/i ) { #Pg-specific :(
+        push @alter_table, "$alter DROP DEFAULT";
+
+        push @sql, "UPDATE TABLE $table SET $name = NULL WHERE $name = ''"
+          if $opt->{'nullify_default'} && $old_default eq "''" && $new->null;
+      }
+
+    }
+
+    # change other stuff... (what next?)
 
   }
 
-  @sql;
+  (\@alter_table, \@sql);
 
 }
+
 =item sql_drop_column [ DBH ] 
 
-Returns a list of SQL statements to drop this column from an existing table.
+Returns SQL to drop this column from an existing table.
+
+NOTE: This interface has changed in 0.41
+
+Returns a list of column alteration SQL fragments for an ALTER TABLE statement. 
 
 The optional database handle or DBI data source/username/password is not yet
 used.
@@ -496,7 +523,7 @@ sub sql_drop_column {
  my $table = $self->table_name;
  my $name = $self->name;
  
- ("ALTER TABLE $table DROP COLUMN $name"); # XXX what about indexes???
+ ("DROP COLUMN $name"); # XXX what about indexes???
 }
 
 =back
@@ -508,7 +535,7 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 =head1 COPYRIGHT
 
 Copyright (c) 2000-2006 Ivan Kohler
-Copyright (c) 2007 Freeside Internet Services, Inc.
+Copyright (c) 2007-2013 Freeside Internet Services, Inc.
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.
@@ -520,8 +547,10 @@ The new() method should warn that
 
 Better documentation is needed for sql_add_column
 
-line() and sql_add_column() hav database-specific foo that should be abstracted
-into the DBIx::DBSchema:DBD:: modules.
+sql_alter_column() has database-specific foo that should be abstracted info
+DBIx::DBSchema::DBD::Pg
+
+nullify_default option should be documented
 
 =head1 SEE ALSO