Fixes for dropping nullability on old Pg (<= 7.2)
[DBIx-DBSchema.git] / DBSchema / Column.pm
index a5b054a..f981ede 100644 (file)
@@ -4,12 +4,12 @@ use strict;
 use vars qw(@ISA $VERSION);
 #use Carp;
 #use Exporter;
-use DBIx::DBSchema::_util qw(_load_driver);
+use DBIx::DBSchema::_util qw(_load_driver _dbh);
 
 #@ISA = qw(Exporter);
 @ISA = qw();
 
-$VERSION = '0.03';
+$VERSION = '0.08';
 
 =head1 NAME
 
@@ -25,7 +25,7 @@ DBIx::DBSchema::Column - Column objects
     'type'    => 'varchar'
     'null'    => 'NOT NULL',
     'length'  => 64,
-    'default' => '
+    'default' => '',
     'local'   => '',
   } );
 
@@ -76,6 +76,9 @@ 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
+defaults.
+
 =cut
 
 sub new {
@@ -242,14 +245,8 @@ for other engines (if applicable) may also be supported in the future.
 =cut
 
 sub line {
-  my($self,$dbh) = (shift, shift);
+  my($self, $dbh) = ( shift, _dbh(@_) );
 
-  my $created_dbh = 0;
-  unless ( ref($dbh) || ! @_ ) {
-    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
-    $created_dbh = 1;
-  }
   my $driver = $dbh ? _load_driver($dbh) : '';
 
   my %typemap;
@@ -261,7 +258,7 @@ sub line {
   my $null = $self->null;
 
   my $default;
-  if ( defined($self->default) && $self->default ne ''
+  if ( defined($self->default) && !ref($self->default) && $self->default ne ''
        && ref($dbh)
        # false laziness: nicked from FS::Record::_quote
        && ( $self->default !~ /^\-?\d+(\.\d+)?$/
@@ -270,19 +267,19 @@ sub line {
   ) {
     $default = $dbh->quote($self->default);
   } else {
-    $default = $self->default;
+    $default = ref($self->default) ? ${$self->default} : $self->default;
   }
 
   #this should be a callback into the driver
   if ( $driver eq 'mysql' ) { #yucky mysql hack
     $null ||= "NOT NULL";
     $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
-  } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
+  } elsif ( $driver =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg/SQLite hack
     $null ||= "NOT NULL";
     $null =~ s/^NULL$//;
   }
 
-  my $r = join(' ',
+  join(' ',
     $self->name,
     $type. ( ( defined($self->length) && $self->length )
              ? '('.$self->length.')'
@@ -298,14 +295,13 @@ sub line {
       : ''
     ),
   );
-  $dbh->disconnect if $created_dbh;
-  $r;
 
 }
 
-=item sql_add_column
+=item sql_add_column [ DBH ] 
 
-Returns a list of SQL statements to add this column.
+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.)
 
 The data source can be specified by passing an open DBI database handle, or by
 passing the DBI data source name, username and password.  
@@ -315,30 +311,20 @@ with a database handle or data source including a valid username and password -
 a DBI connection will be opened and the quoting and type mapping will be more
 reliable.
 
-If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
-PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
+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.
 
 =cut
 
 sub sql_add_column {
-  my($self, $dbh) = (shift, shift);
+  my($self, $dbh) = ( shift, _dbh(@_) );
 
   die "$self: this column is not assigned to a table"
     unless $self->table_name;
 
-  #false laziness w/Table::sql_create_driver
-  my $created_dbh = 0;
-  unless ( ref($dbh) || ! @_ ) {
-    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
-    $created_dbh = 1;
-  }
-
   my $driver = $dbh ? _load_driver($dbh) : '';
 
-  #eofalse
-
   my @after_add = ();
 
   my $real_type = '';
@@ -351,7 +337,12 @@ sub sql_add_column {
 
       #needs more work for old Pg
 
-      my $nextval = "nextval('public.${table}_${column}_seq'::text)";
+      my $nextval;
+      if ( $dbh->{'pg_server_version'} > 70300 ) {
+        $nextval = "nextval('public.${table}_${column}_seq'::text)";
+      } else {
+        $nextval = "nextval('${table}_${column}_seq'::text)";
+      }
 
       (
         "ALTER TABLE $table ALTER COLUMN $column SET DEFAULT $nextval",
@@ -369,10 +360,24 @@ sub sql_add_column {
     $real_null = $self->null;
     $self->null('NULL');
 
-    push @after_add, sub {
-      my($table, $column) = @_;
-      "ALTER TABLE $table ALTER $column SET NOT NULL";
-    };
+    #if ( $dbh->{'pg_server_version'} > 70300 ) { #this seemed to work on 7.3
+    if ( $dbh->{'pg_server_version'} > 70400 ) {  #after all...
+
+      push @after_add, sub {
+        my($table, $column) = @_;
+        "ALTER TABLE $table ALTER $column SET NOT NULL";
+      };
+
+    } else {
+
+      push @after_add, sub {
+        my($table, $column) = @_;
+        "UPDATE pg_attribute SET attnotnull = TRUE ".
+        " WHERE attname = '$column' ".
+        " AND attrelid = ( SELECT oid FROM pg_class WHERE relname = '$table' )";
+      };
+
+    }
 
   }
 
@@ -391,7 +396,79 @@ sub sql_add_column {
   $self->type($real_type) if $real_type;
   $self->null($real_null) if defined $real_null;
 
-  $dbh->disconnect if $created_dbh;
+  @r;
+
+}
+
+=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.
+
+ #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.
+
+
+Or should, someday.  Right now it knows how to change NOT NULL into NULL and
+vice-versa.
+
+=cut
+
+sub sql_alter_column {
+  my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
+
+  my $table = $self->table_name;
+  die "$self: this column is not assigned to a table"
+    unless $table;
+
+  my $name = $self->name;
+
+  my $driver = $dbh ? _load_driver($dbh) : '';
+
+  my @r = ();
+
+  # change the name...
+
+  # change the type...
+
+  # change nullability from NOT NULL to NULL
+  if ( ! $self->null && $new->null ) {
+
+    if ( $driver eq 'Pg' && $dbh->{'pg_server_version'} < 70300 ) {
+      push @r, "UPDATE pg_attribute SET attnotnull = FALSE
+                 WHERE attname = '$name'
+                   AND attrelid = ( SELECT oid FROM pg_class
+                                      WHERE relname = '$table'
+                                  )";
+    } else {
+      push @r, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL";
+    }
+  }
+
+  # change nullability from NULL to NOT NULL...
+  # this one could be more complicated, need to set a DEFAULT value and update
+  # the table first...
+  if ( $self->null && ! $new->null ) {
+
+    if ( $driver eq 'Pg' && $dbh->{'pg_server_version'} < 70300 ) {
+      push @r, "UPDATE pg_attribute SET attnotnull = TRUE
+                 WHERE attname = '$name'
+                   AND attrelid = ( SELECT oid FROM pg_class
+                                      WHERE relname = '$table'
+                                  )";
+    } else {
+      push @r, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
+    }
+  }
+
+  # change other stuff...
 
   @r;
 
@@ -405,13 +482,15 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000-2005 Ivan Kohler
+Copyright (c) 2000-2006 Ivan Kohler
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.
 
 =head1 BUGS
 
+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.