fix bug preventing adding new columns as primary keys under Pg

[DBIx-DBSchema.git] / DBSchema / Column.pm

diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm
index 9a067a5..431e69c 100644 (file)
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -1,15 +1,11 @@
 package DBIx::DBSchema::Column;
 
 use strict;
 package DBIx::DBSchema::Column;
 
 use strict;

-use vars qw(@ISA $VERSION);
-#use Carp;
-#use Exporter;
-use DBIx::DBSchema::_util qw(_load_driver);
+use vars qw($VERSION);
+use Carp;
+use DBIx::DBSchema::_util qw(_load_driver _dbh);

 
 

-#@ISA = qw(Exporter);
-@ISA = qw();
-
-$VERSION = '0.03';
+$VERSION = '0.11';

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -25,7 +21,7 @@ DBIx::DBSchema::Column - Column objects
     'type'    => 'varchar'
     'null'    => 'NOT NULL',
     'length'  => 64,
     'type'    => 'varchar'
     'null'    => 'NOT NULL',
     'length'  => 64,

-    'default' => '
+    'default' => '',

     'local'   => '',
   } );
 
     'local'   => '',
   } );
 


@@ -76,6 +72,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.
 
 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 {
 =cut
 
 sub new {


@@ -86,6 +85,10 @@ sub new {
   if ( ref($_[0]) ) {
     $self = shift;
   } else {
   if ( ref($_[0]) ) {
     $self = shift;
   } else {

+    #carp "Old-style $class creation without named parameters is deprecated!";
+    #croak "FATAL: old-style $class creation no longer supported;".
+    #      " use named parameters";
+

     $self = { map { $_ => shift } qw(name type null length default local) };
   }
 
     $self = { map { $_ => shift } qw(name type null length default local) };
   }
 


@@ -242,26 +245,27 @@ for other engines (if applicable) may also be supported in the future.
 =cut
 
 sub line {
 =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 $driver = $dbh ? _load_driver($dbh) : '';
 

+  ##
+  # type mapping
+  ## 
+

   my %typemap;
   %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
   my $type = defined( $typemap{uc($self->type)} )
     ? $typemap{uc($self->type)}
     : $self->type;
 
   my %typemap;
   %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
   my $type = defined( $typemap{uc($self->type)} )
     ? $typemap{uc($self->type)}
     : $self->type;
 

-  my $null = $self->null;
+  ##
+  # set default for the callback...
+  ##

 
   my $default;
 
   my $default;

-  if ( defined($self->default) && $self->default ne ''
+  my $orig_default = $self->default;
+  if ( defined($self->default) && !ref($self->default) && $self->default ne ''

        && ref($dbh)
        # false laziness: nicked from FS::Record::_quote
        && ( $self->default !~ /^\-?\d+(\.\d+)?$/
        && ref($dbh)
        # false laziness: nicked from FS::Record::_quote
        && ( $self->default !~ /^\-?\d+(\.\d+)?$/


@@ -270,19 +274,42 @@ sub line {
   ) {
     $default = $dbh->quote($self->default);
   } else {
   ) {
     $default = $dbh->quote($self->default);
   } else {

-    $default = $self->default;
+    $default = ref($self->default) ? ${$self->default} : $self->default;

   }
   }

+  $self->default($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 =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg/SQLite hack
-    $null ||= "NOT NULL";
-    $null =~ s/^NULL$//;
-  }
+  ##
+  # 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'};
+
+  my $null = $self->null;
+
+  #we seem to do this for mysql/Pg/SQLite, i think this should be the default
+  #add something to $hashref if drivers need to overrdide?
+  $null ||= "NOT NULL";
+
+  $null =~ s/^NULL$// unless $hashref->{'explicit_null'};
+
+  $default = $hashref->{'effective_default'}
+    if $hashref->{'effective_default'};
+
+  my $local = $self->local;
+  $local = $hashref->{'effective_local'}
+    if $hashref->{'effective_local'};

 
 

-  my $r = join(' ',
+  ##
+  # return column line
+  ## 
+
+  join(' ',

     $self->name,
     $type. ( ( defined($self->length) && $self->length )
              ? '('.$self->length.')'
     $self->name,
     $type. ( ( defined($self->length) && $self->length )
              ? '('.$self->length.')'


@@ -293,19 +320,15 @@ sub line {
       ? 'DEFAULT '. $default
       : ''
     ),
       ? 'DEFAULT '. $default
       : ''
     ),

-    ( ( $driver eq 'mysql' && defined($self->local) )
-      ? $self->local
-      : ''
-    ),
+    ( defined($local) ? $local : ''),

   );
   );

-  $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.  
 
 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,105 +338,140 @@ 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.
 
 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 {
 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;
 
 
   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) : '';
 
   my $driver = $dbh ? _load_driver($dbh) : '';
 

-  #eofalse
+  my @sql = ();
+  my $table = $self->table_name;

 
 

-  my @after_add = ();
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
+  my $hashref = $dbd->add_column_callback( $dbh, $table, $self );

 
   my $real_type = '';
 
   my $real_type = '';

-  if (  $driver eq 'Pg' && $self->type eq 'serial' ) {
-    $real_type = 'serial';
-    $self->type('int');
+  if ( $hashref->{'effective_type'} ) {
+    $real_type = $self->type;
+    $self->type($hashref->{'effective_type'});
+  }

 
 

-    push @after_add, sub {
-      my($table, $column) = @_;
+  my $real_null = undef;
+  if ( exists($hashref->{'effective_null'}) ) {
+    $real_null = $self->null;
+    $self->null($hashref->{'effective_null'});
+  }

 
 

-      #needs more work for old Pg
+  push @sql, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);

 
 

-      my $nextval;
-      if ( $dbh->{'pg_server_version'} > 70300 ) {
-        $nextval = "nextval('public.${table}_${column}_seq'::text)";
-      } else {
-        $nextval = "nextval('${table}_${column}_seq'::text)";
-      }
+  push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'};

 
 

-      (
-        "ALTER TABLE $table ALTER COLUMN $column SET DEFAULT $nextval",
-        "CREATE SEQUENCE ${table}_${column}_seq",
-        "UPDATE $table SET $column = $nextval WHERE $column IS NULL",
-        #"ALTER TABLE $table ALTER $column SET NOT NULL",
-      );
+  push @sql, "ALTER TABLE $table ADD PRIMARY KEY ( ".
+             $self->table_obj->primary_key. " )"
+    if $self->name eq $self->table_obj->primary_key;

 
 

-    };
+  $self->type($real_type) if $real_type;
+  $self->null($real_null) if defined $real_null;

 
 

-  }
+  @sql;

 
 

-  my $real_null = undef;
-  if ( $driver eq 'Pg' && ! $self->null ) {
-    $real_null = $self->null;
-    $self->null('NULL');
+}

 
 

-    if ( $dbh->{'pg_server_version'} > 70300 ) {
+=item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]

 
 

-      push @after_add, sub {
-        my($table, $column) = @_;
-        "ALTER TABLE $table ALTER $column SET NOT NULL";
-      };
+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.

 
 

-    } else {
+ #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.

 
 

-      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' )";
-      };

 
 

-    }
+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 @r = ();

   my $table = $self->table_name;
   my $table = $self->table_name;

-  my $column = $self->name;
+  die "$self: this column is not assigned to a table"
+    unless $table;

 
 

-  push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
+  my $name = $self->name;

 
 

-  push @r, &{$_}($table, $column) foreach @after_add;
+  my $driver = $dbh ? _load_driver($dbh) : '';

 
 

-  push @r, "ALTER TABLE $table ADD PRIMARY KEY ( ".
-             $self->table_obj->primary_key. " )"
-    if $self->name eq $self->table_obj->primary_key;
+  my @sql = ();

 
 

-  $self->type($real_type) if $real_type;
-  $self->null($real_null) if defined $real_null;
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
+  my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new );
+
+  # change the name...

 
 

-  $dbh->disconnect if $created_dbh;
+  # change the type...

 
 

-  @r;
+  if ( $hashref->{'sql_alter_null' } ) {
+
+    push @sql, $hashref->{'sql_alter_null'};
+
+  } else {
+
+    # change nullability from NOT NULL to NULL
+    if ( ! $self->null && $new->null ) {
+  
+      push @sql, "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 ) {
+  
+      push @sql, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
+  
+    }
+
+  }
+  
+  # change other stuff...
+
+  @sql;

 
 }
 
 }

+=item sql_drop_column [ DBH ] 
+
+Returns a list of SQL statements to drop this column from an existing table.
+
+The optional database handle or DBI data source/username/password is not yet
+used.
+
+=cut
+
+sub sql_drop_column {
+ my( $self, $dbh ) = ( shift, _dbh(@_) );
+ 
+ my $table = $self->table_name;
+ my $name = $self->name;
+ 
+ ("ALTER TABLE $table DROP COLUMN $name"); # XXX what about indexes???
+}

 
 =back
 
 
 =back
 


@@ -423,13 +481,19 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 
 =head1 COPYRIGHT
 
 
 =head1 COPYRIGHT
 

-Copyright (c) 2000-2005 Ivan Kohler
+Copyright (c) 2000-2006 Ivan Kohler
+Copyright (c) 2007 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.
 
 =head1 BUGS
 
 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
 

+The new() method should warn that 
+"Old-style $class creation without named parameters is deprecated!"
+
+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.
 
 line() and sql_add_column() hav database-specific foo that should be abstracted
 into the DBIx::DBSchema:DBD:: modules.