X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;ds=inline;f=DBSchema%2FColumn.pm;h=27c4c22fe3cc59b0fadcfaaeb17367d608febc76;hb=4511b3b2f5c5f55f875fc8ac1b0ef28fdb28897f;hp=617d7207c695dd4a752f5d79acb65903e5fc3a88;hpb=5606f44c8c8134c605d5f5cb05b2e57a4b34e0b3;p=DBIx-DBSchema.git

diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm
index 617d720..27c4c22 100644
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -1,12 +1,11 @@
 package DBIx::DBSchema::Column;
 
 use strict;
-use vars qw(@ISA);
-#use Carp;
-#use Exporter;
+use vars qw($VERSION);
+use Carp;
+use DBIx::DBSchema::_util qw(_load_driver _dbh _parse_opt);
 
-#@ISA = qw(Exporter);
-@ISA = qw();
+$VERSION = '0.14';
 
 =head1 NAME
 
@@ -16,17 +15,24 @@ DBIx::DBSchema::Column - Column objects
 
   use DBIx::DBSchema::Column;
 
-  $column = new DBIx::DBSchema::Column ( $name, $sql_type, '' );
-  $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL' );
-  $column = new DBIx::DBSchema::Column ( $name, $sql_type, '', $length );
-  $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length );
-  $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length, $default, $local );
+  #named params with a hashref (preferred)
+  $column = new DBIx::DBSchema::Column ( {
+    'name'    => 'column_name',
+    'type'    => 'varchar'
+    'null'    => 'NOT NULL',
+    'length'  => 64,
+    'default' => '',
+    'local'   => '',
+  } );
+
+  #list
+  $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
 
   $name = $column->name;
   $column->name( 'name' );
 
   $sql_type = $column->type;
-  $column->sql_type( 'sql_type' );
+  $column->type( 'sql_type' );
 
   $null = $column->null;
   $column->null( 'NULL' );
@@ -43,6 +49,9 @@ DBIx::DBSchema::Column - Column objects
   $sql_line = $column->line;
   $sql_line = $column->line($datasrc);
 
+  $sql_add_column = $column->sql_add_column;
+  $sql_add_column = $column->sql_add_column($datasrc);
+
 =head1 DESCRIPTION
 
 DBIx::DBSchema::Column objects represent columns in tables (see
@@ -52,33 +61,42 @@ L<DBIx::DBSchema::Table>).
 
 =over 4
 
-=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH  [ , DEFAULT [ , LOCAL ] ] ] ] ] ]
+=item new HASHREF
+
+=item new [ name [ , type [ , null [ , length  [ , default [ , local ] ] ] ] ] ]
+
+Creates a new DBIx::DBSchema::Column object.  Takes a hashref of named
+parameters, or a list.  B<name> is the name of the column.  B<type> is the SQL
+data type.  B<null> is the nullability of the column (intrepreted using Perl's
+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.
 
-Creates a new DBIx::DBSchema::Column object.  NAME is the name of the column.
-SQL_TYPE is the SQL data type.  NULL is the nullability of the column (the
-empty string is equivalent to `NOT NULL').  LENGTH is the SQL length of the
-column.  DEFAULT is the default value of the column.  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 {
-  my($proto,$name,$type,$null,$length,$default,$local)=@_;
+  my $proto = shift;
+  my $class = ref($proto) || $proto;
 
-  #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
+  my $self;
+  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) };
+  }
 
-  $null =~ s/^NOT NULL$//i;
-  $null = 'NULL' if $null;
+  #croak "Illegal name: ". $self->{'name'}
+  #  if grep $self->{'name'} eq $_, @reserved_words;
 
-  my $class = ref($proto) || $proto;
-  my $self = {
-    'name'    => $name,
-    'type'    => $type,
-    'null'    => $null,
-    'length'  => $length,
-    'default' => $default,
-    'local'   => $local,
-  };
+  $self->{'null'} =~ s/^NOT NULL$//i;
+  $self->{'null'} = 'NULL' if $self->{'null'};
 
   bless ($self, $class);
 
@@ -179,11 +197,47 @@ sub local {
   }
 }
 
-=item line [ $datasrc ]
+=item table_obj [ TABLE_OBJ ]
+
+Returns or sets the table object (see L<DBIx::DBSchema::Table>).  Typically
+set internally when a column object is added to a table object.
+
+=cut
+
+sub table_obj {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{'table_obj'} = $value;
+  } else {
+    $self->{'table_obj'};
+  }
+}
+
+=item table_name
+
+Returns the table name, or the empty string if this column has not yet been
+assigned to a table.
+
+=cut
+
+sub table_name {
+  my $self = shift;
+  $self->{'table_obj'} ? $self->{'table_obj'}->name : '';
+}
+
+=item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 
 Returns an SQL column definition.
 
-If passed a DBI data source such as `DBI:mysql:database' or
+The data source can be specified by passing an open DBI database handle, or by
+passing the DBI data source name, username and password.  
+
+Although the username and password are optional, it is best to call this method
+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' or
 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
 Currently supported databases are MySQL and PostgreSQL.  Non-standard syntax
 for other engines (if applicable) may also be supported in the future.
@@ -191,40 +245,287 @@ for other engines (if applicable) may also be supported in the future.
 =cut
 
 sub line {
-  my($self,$datasrc)=@_;
-  
-  my $driver = DBIx::DBSchema::_load_driver($datasrc);
-  my %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap";
+  my($self, $dbh) = ( shift, _dbh(@_) );
+
+  my $driver = $dbh ? _load_driver($dbh) : '';
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
+
+  ##
+  # type mapping
+  ## 
+
+  my %typemap;
+  %typemap = eval "\%${dbd}::typemap" if $driver;
   my $type = defined( $typemap{uc($self->type)} )
     ? $typemap{uc($self->type)}
     : $self->type;
 
-  my($null)=$self->null;
+  ##
+  # callback into the database-specific driver
+  ##
 
-  if ( $datasrc =~ /^dbi:mysql:/i ) { #yucky mysql hack
-    $null ||= "NOT NULL"
-  }
-  if ( $datasrc =~ /^dbi:pg/i ) { #yucky Pg hack
-    $null ||= "NOT NULL";
-    $null =~ s/^NULL$//;
-  }
+  my $hashref = $dbd->column_callback( $dbh, $self->table_name, $self );
+
+  $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'};
+
+  my $default = $hashref->{'effective_default'} || $self->quoted_default($dbh);
+  $default = "DEFAULT $default" if $default ne '';
+
+  my $local = $self->local;
+  $local = $hashref->{'effective_local'}
+    if $hashref->{'effective_local'};
+
+  ##
+  # return column line
+  ## 
 
   join(' ',
     $self->name,
-    $type. ( $self->length ? '('.$self->length.')' : '' ),
+    $type. ( ( defined($self->length) && $self->length )
+             ? '('.$self->length.')'
+             : ''
+           ),
     $null,
-    ( ( defined($self->default) && $self->default ne '' )
-      ? 'DEFAULT '. $self->default
-      : ''
-    ),
-    ( ( $datasrc =~ /^dbi:mysql:/i )
-      ? $self->local
-      : ''
-    ),
+    $default,
+    ( defined($local) ? $local : ''),
   );
 
 }
 
+=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) : '';
+
+  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.  
+
+Although the username and password are optional, it is best to call this method
+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: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, _dbh(@_) );
+
+  die "$self: this column is not assigned to a table"
+    unless $self->table_name;
+
+  my $driver = $dbh ? _load_driver($dbh) : '';
+
+  my @alter_table = ();
+  my @sql = ();
+  my $table = $self->table_name;
+
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
+  my $hashref = $dbd->add_column_callback( $dbh, $table, $self );
+
+  my $real_type = '';
+  if ( $hashref->{'effective_type'} ) {
+    $real_type = $self->type;
+    $self->type($hashref->{'effective_type'});
+  }
+
+  my $real_null = undef;
+  if ( exists($hashref->{'effective_null'}) ) {
+    $real_null = $self->null;
+    $self->null($hashref->{'effective_null'});
+  }
+
+  push @alter_table, "ADD COLUMN ". $self->line($dbh);
+
+  push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'};
+
+  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;
+
+  (\@alter_table, \@sql);
+
+}
+
+=item sql_alter_column PROTOTYPE_COLUMN  [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
+
+Returns SQL to alter this column so that it is identical to the provided
+prototype column, also a DBIx::DBSchema::Column object.
+
+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.
+
+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, $opt, $new, $dbh) = ( shift, _parse_opt(\@_), 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 @alter_table = ();
+  my @sql = ();
+
+  my $dbd = "DBIx::DBSchema::DBD::$driver";
+  my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new );
+
+  if ( $hashref->{'sql_alter'} ) {
+
+    push @sql, $hashref->{'sql_alter'};
+
+  } else {
+
+    # change the name...
+    # not yet implemented.  how do we tell which old column it was?
+
+    # change the type...
+    if ( $hashref->{'sql_alter_type'} ) {
+      push @alter_table, $hashref->{'sql_alter_type'};
+    }
+
+    # change nullability...
+
+    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 @alter_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 @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()' )
+       )
+    {
+
+      #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?)
+
+  }
+
+  (\@alter_table, \@sql);
+
+}
+
+=item sql_drop_column [ DBH ] 
+
+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.
+
+=cut
+
+sub sql_drop_column {
+ my( $self, $dbh ) = ( shift, _dbh(@_) );
+ 
+ my $table = $self->table_name;
+ my $name = $self->name;
+ 
+ ("DROP COLUMN $name"); # XXX what about indexes???
+}
+
 =back
 
 =head1 AUTHOR
@@ -233,16 +534,23 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 
 =head1 COPYRIGHT
 
-Copyright (c) 2000 Ivan Kohler
-Copyright (c) 2000 Mail Abuse Prevention System LLC
+Copyright (c) 2000-2006 Ivan Kohler
+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.
 
 =head1 BUGS
 
-line() has database-specific foo that probably ought to be abstracted into
-the DBIx::DBSchema:DBD:: modules.
+The new() method should warn that 
+"Old-style $class creation without named parameters is deprecated!"
+
+Better documentation is needed for sql_add_column
+
+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