X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=DBSchema%2FColumn.pm;h=b13d5c0033ffc3b779cd28bc615d1d377a08d8bc;hb=b8a52445f2a1bdae86e16d4a3e9aa9d2b709c333;hp=8ae062d0a460b71bcce2476ed767a7ae1197518f;hpb=60b32316649e05847bfdd18d286a532cca8acba4;p=DBIx-DBSchema.git diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm index 8ae062d..b13d5c0 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); -#@ISA = qw(Exporter); -@ISA = qw(); +$VERSION = '0.12'; =head1 NAME @@ -22,7 +21,7 @@ DBIx::DBSchema::Column - Column objects 'type' => 'varchar' 'null' => 'NOT NULL', 'length' => 64, - 'default' => ' + 'default' => '', 'local' => '', } ); @@ -33,7 +32,7 @@ DBIx::DBSchema::Column - Column objects $column->name( 'name' ); $sql_type = $column->type; - $column->sql_type( 'sql_type' ); + $column->type( 'sql_type' ); $null = $column->null; $column->null( 'NULL' ); @@ -50,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 @@ -70,6 +72,9 @@ rules for truth, with one exception: `NOT NULL' is false). B is the SQL length of the column. B is the default value of the column. B is reserved for database-specific information. +Note: If you pass a scalar reference as the B 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 { @@ -80,6 +85,10 @@ sub new { 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) }; } @@ -188,6 +197,34 @@ sub local { } } +=item table_obj [ TABLE_OBJ ] + +Returns or sets the table object (see L). 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. @@ -208,26 +245,34 @@ 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 $driver = $dbh ? _load_driver($dbh) : ''; + my $driver_class = "DBIx::DBSchema::DBD::${driver}"; + + ## + # type mapping + ## - 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 = DBIx::DBSchema::_load_driver($dbh); my %typemap; - %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver; + %typemap = eval "\%${driver_class}::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; - if ( defined($self->default) && $self->default ne '' + my $orig_default = $self->default; + if ( $driver_class->can("_column_value_needs_quoting") ) { + if ($driver_class->_column_value_needs_quoting($self)) { + $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+)?$/ @@ -236,36 +281,205 @@ sub line { ) { $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 eq 'Pg' ) { #yucky Pg 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); - my @r = join(' ', + $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'}; + + ## + # return column line + ## + + join(' ', $self->name, - $type. ( $self->length ? '('.$self->length.')' : '' ), + $type. ( ( defined($self->length) && $self->length ) + ? '('.$self->length.')' + : '' + ), $null, ( ( defined($default) && $default ne '' ) ? 'DEFAULT '. $default : '' ), - ( ( $driver eq 'mysql' ) - ? $self->local - : '' - ), + ( defined($local) ? $local : ''), ); - $dbh->disconnect if $created_dbh; - @r; } +=item sql_add_column [ DBH ] + +Returns a list of SQL statements to add this column to an existing table. (To +create a new table, see L 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. + +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 @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 @sql, "ALTER TABLE $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; + + @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. + + #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 @sql = (); + + my $dbd = "DBIx::DBSchema::DBD::$driver"; + my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new ); + + # change the name... + + # change the type... + + 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 =head1 AUTHOR @@ -274,16 +488,21 @@ Ivan Kohler =head1 COPYRIGHT -Copyright (c) 2000 Ivan Kohler -Copyright (c) 2000 Mail Abuse Prevention System LLC +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 -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 + +line() and sql_add_column() hav database-specific foo that should be abstracted +into the DBIx::DBSchema:DBD:: modules. =head1 SEE ALSO