From 455adacf257c5d443dd9b1917c329983990c1e78 Mon Sep 17 00:00:00 2001 From: ivan Date: Thu, 25 Oct 2007 08:30:46 +0000 Subject: [PATCH] move all mysql- and Pg-specific code to DBD driver callbacks --- Changes | 3 + DBSchema.pm | 2 +- DBSchema/Column.pm | 211 +++++++++++++++++++------------------------------- DBSchema/DBD.pm | 59 +++++++++++++- DBSchema/DBD/Pg.pm | 114 ++++++++++++++++++++++++++- DBSchema/DBD/mysql.pm | 24 +++++- 6 files changed, 274 insertions(+), 139 deletions(-) diff --git a/Changes b/Changes index 4a18bd9..39a69ec 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,9 @@ Revision history for Perl extension DBIx::DBSchema. 0.35 unreleased - Fix minor breakage (pretty_print) resulting from Jesse's changes. + - Update mysql driver to handle BIGSERIAL columns + - Update Column.pm, move all mysql and Pg-specific code to DBD driver + callbacks 0.34 Sun Aug 19 10:08:51 PDT 2007 - More work on update schema from Slaven Rezic , diff --git a/DBSchema.pm b/DBSchema.pm index 9e13188..e36091d 100644 --- a/DBSchema.pm +++ b/DBSchema.pm @@ -10,7 +10,7 @@ use DBIx::DBSchema::Column; use DBIx::DBSchema::ColGroup::Unique; use DBIx::DBSchema::ColGroup::Index; -$VERSION = "0.35_01"; +$VERSION = "0.35_02"; $VERSION = eval $VERSION; # modperlstyle: convert the string into a number $DEBUG = 0; diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm index d43d0b7..46f526b 100644 --- a/DBSchema/Column.pm +++ b/DBSchema/Column.pm @@ -5,7 +5,7 @@ use vars qw($VERSION); use Carp; use DBIx::DBSchema::_util qw(_load_driver _dbh); -$VERSION = '0.09'; +$VERSION = '0.10'; =head1 NAME @@ -249,15 +249,22 @@ sub line { 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 $null = $self->null; + ## + # set default for the callback... + ## my $default; + my $orig_default = $self->default; if ( defined($self->default) && !ref($self->default) && $self->default ne '' && ref($dbh) # false laziness: nicked from FS::Record::_quote @@ -269,15 +276,38 @@ sub line { } else { $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'}; + + ## + # return column line + ## join(' ', $self->name, @@ -290,10 +320,7 @@ sub line { ? 'DEFAULT '. $default : '' ), - ( ( $driver eq 'mysql' && defined($self->local) ) - ? $self->local - : '' - ), + ( defined($local) ? $local : ''), ); } @@ -325,90 +352,36 @@ sub sql_add_column { my $driver = $dbh ? _load_driver($dbh) : ''; - my @after_add = (); + 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 ( $driver eq 'Pg' && $self->type eq 'serial' ) { - $real_type = 'serial'; - $self->type('int'); - - push @after_add, sub { - my($table, $column) = @_; - - #needs more work for old Pg? - - my $pg_server_version = $dbh->{'pg_server_version'}; - unless ( $pg_server_version =~ /\d/ ) { - warn "WARNING: no pg_server_version! Assuming >= 7.3\n"; - $pg_server_version = 70300; - } - - my $nextval; - if ( $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", - "CREATE SEQUENCE ${table}_${column}_seq", - "UPDATE $table SET $column = $nextval WHERE $column IS NULL", - #"ALTER TABLE $table ALTER $column SET NOT NULL", - ); - - }; - + if ( $hashref->{'effective_type'} ) { + $real_type = $self->type; + $self->type($hashref->{'effective_type'}); } my $real_null = undef; - if ( $driver eq 'Pg' && ! $self->null ) { + if ( exists($hashref->{'effective_null'}) ) { $real_null = $self->null; - $self->null('NULL'); - - my $pg_server_version = $dbh->{'pg_server_version'}; - unless ( $pg_server_version =~ /\d/ ) { - warn "WARNING: no pg_server_version! Assuming >= 7.3\n"; - $pg_server_version = 70300; - } - - if ( $pg_server_version >= 70300 ) { #this did work on 7.3 - #if ( $pg_server_version > 70400 ) { - - 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' )"; - }; - - } - + $self->type($hashref->{'effective_type'}); } - my @r = (); - my $table = $self->table_name; - my $column = $self->name; - - push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh); + push @sql, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh); - push @r, &{$_}($table, $column) foreach @after_add; + push @sql, @{ $hashref->{'sql_after'} } if $hashref->{'sql_after'}; - push @r, "ALTER TABLE $table ADD PRIMARY KEY ( ". + 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; - @r; + @sql; } @@ -444,71 +417,42 @@ sub sql_alter_column { my $driver = $dbh ? _load_driver($dbh) : ''; - my @r = (); + my @sql = (); + + my $dbd = "DBIx::DBSchema::DBD::$driver"; + my $hashref = $dbd->alter_column_callback( $dbh, $table, $self, $new ); # change the name... # change the type... - # change nullability from NOT NULL to NULL - if ( ! $self->null && $new->null ) { - - my $alter = "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL"; - - if ( $driver eq 'Pg' ) { + if ( $hashref->{'sql_alter_null' } ) { - my $pg_server_version = $dbh->{'pg_server_version'}; - unless ( $pg_server_version =~ /\d/ ) { - warn "WARNING: no pg_server_version! Assuming >= 7.3\n"; - $pg_server_version = 70300; - } + push @sql, $hashref->{'sql_alter_null'}; - if ( $pg_server_version < 70300 ) { - $alter = "UPDATE pg_attribute SET attnotnull = FALSE - WHERE attname = '$name' - AND attrelid = ( SELECT oid FROM pg_class - WHERE relname = '$table' - )"; - } + } else { + # change nullability from NOT NULL to NULL + if ( ! $self->null && $new->null ) { + + push @sql, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL"; + } - - push @r, $alter; - - } - - # 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 ) { - - my $alter = "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL"; - - if ( $driver eq 'Pg' ) { - - my $pg_server_version = $dbh->{'pg_server_version'}; - unless ( $pg_server_version =~ /\d/ ) { - warn "WARNING: no pg_server_version! Assuming >= 7.3\n"; - $pg_server_version = 70300; - } - - if ( $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' - )"; - } - + + # 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"; + } - push @r, $alter; - } - + # change other stuff... - @r; + @sql; } =item sql_drop_column [ DBH ] @@ -538,6 +482,7 @@ Ivan Kohler =head1 COPYRIGHT 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. diff --git a/DBSchema/DBD.pm b/DBSchema/DBD.pm index 47f884e..be08320 100644 --- a/DBSchema/DBD.pm +++ b/DBSchema/DBD.pm @@ -3,7 +3,7 @@ package DBIx::DBSchema::DBD; use strict; use vars qw($VERSION); -$VERSION = '0.04'; +$VERSION = '0.05'; =head1 NAME @@ -143,7 +143,7 @@ Inheriting from DBIx::DBSchema::DBD will provide the default empty string. sub default_db_catalog { ''; } -=item default_db_catalog +=item default_db_schema Returns the default database schema for the DBI table_info command. Inheriting from DBIx::DBSchema::DBD will provide the default empty string. @@ -152,6 +152,60 @@ Inheriting from DBIx::DBSchema::DBD will provide the default empty string. sub default_db_schema { ''; } +=item column_callback DBH TABLE_NAME COLUMN_OBJ + +Optional callback for driver-specific overrides to SQL column definitions. + +Should return a hash reference, empty for no action, or with one or more of +the following keys defined: + +effective_type - Optional type override used during column creation. + +explicit_null - Set true to have the column definition declare NULL columns explicitly + +effective_default - Optional default override used during column creation. + +effective_local - Optional local override used during column creation. + + +=cut + +sub column_callback { {}; } + +=item add_column_callback DBH TABLE_NAME COLUMN_OBJ + +Optional callback for additional SQL statments to be called when adding columns +to an existing table. + +Should return a hash reference, empty for no action, or with one or more of +the following keys defined: + +effective_type - Optional type override used during column creation. + +effective_null - Optional nullability override used during column creation. + +sql_after - Array reference of SQL statements to be executed after the column is added. + +=cut + +sub add_column_callback { {}; } + +=item alter_column_callback DBH TABLE_NAME OLD_COLUMN_OBJ NEW_COLUMN_OBJ + +Optional callback for overriding the SQL statments to be called when altering +columns to an existing table. + +Should return a hash reference, empty for no action, or with one or more of +the following keys defined: + +sql_alter_null - Alter SQL statment for changing nullability to be used instead of the default + +=cut + +sub alter_column_callback { {}; } + +=cut + =back =head1 TYPE MAPPING @@ -179,6 +233,7 @@ Ivan Kohler =head1 COPYRIGHT Copyright (c) 2000-2005 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. diff --git a/DBSchema/DBD/Pg.pm b/DBSchema/DBD/Pg.pm index f593f88..02fe8d9 100644 --- a/DBSchema/DBD/Pg.pm +++ b/DBSchema/DBD/Pg.pm @@ -5,7 +5,7 @@ use vars qw($VERSION @ISA %typemap); use DBD::Pg 1.32; use DBIx::DBSchema::DBD; -$VERSION = '0.11'; +$VERSION = '0.12'; @ISA = qw(DBIx::DBSchema::DBD); die "DBD::Pg version 1.32 or 1.41 (or later) required--". @@ -13,8 +13,9 @@ die "DBD::Pg version 1.32 or 1.41 (or later) required--". if $DBD::Pg::VERSION != 1.32 && $DBD::Pg::VERSION < 1.41; %typemap = ( - 'BLOB' => 'BYTEA', + 'BLOB' => 'BYTEA', 'LONG VARBINARY' => 'BYTEA', + 'TIMESTAMP' => 'TIMESTAMP WITH TIME ZONE', ); =head1 NAME @@ -154,6 +155,114 @@ END $row->{'indisunique'}; } +sub add_column_callback { + my( $proto, $dbh, $table, $column_obj ) = @_; + my $name = $column_obj->name; + + my $pg_server_version = $dbh->{'pg_server_version'}; + my $warning = ''; + unless ( $pg_server_version =~ /\d/ ) { + $warning = "WARNING: no pg_server_version! Assuming >= 7.3\n"; + $pg_server_version = 70300; + } + + my $hashref = { 'sql_after' => [], }; + + if ( $column_obj->type =~ /^(\w*)SERIAL$/i ) { + + $hashref->{'effective_type'} = uc($1).'INT'; + + #needs more work for old Pg? + + my $nextval; + warn $warning if $warning; + if ( $pg_server_version >= 70300 ) { + $nextval = "nextval('public.${table}_${name}_seq'::text)"; + } else { + $nextval = "nextval('${table}_${name}_seq'::text)"; + } + + push @{ $hashref->{'sql_after'} }, + "ALTER TABLE $table ALTER COLUMN $name SET DEFAULT $nextval", + "CREATE SEQUENCE ${table}_${name}_seq", + "UPDATE $table SET $name = $nextval WHERE $name IS NULL", + ; + + } + + if ( ! $column_obj->null ) { + $hashref->{'effective_null'} = 'NULL'; + + warn $warning if $warning; + if ( $pg_server_version >= 70300 ) { + + push @{ $hashref->{'sql_after'} }, + "ALTER TABLE $table ALTER $name SET NOT NULL"; + + } else { + + push @{ $hashref->{'sql_after'} }, + "UPDATE pg_attribute SET attnotnull = TRUE ". + " WHERE attname = '$name' ". + " AND attrelid = ( SELECT oid FROM pg_class WHERE relname = '$table' )"; + + } + + } + + $hashref; + +} + +sub alter_column_callback { + my( $proto, $dbh, $table, $old_column, $new_column ) = @_; + my $name = $old_column->name; + + my $pg_server_version = $dbh->{'pg_server_version'}; + my $warning = ''; + unless ( $pg_server_version =~ /\d/ ) { + $warning = "WARNING: no pg_server_version! Assuming >= 7.3\n"; + $pg_server_version = 70300; + } + + my $hashref = {}; + + # change nullability from NOT NULL to NULL + if ( ! $old_column->null && $new_column->null ) { + + warn $warning if $warning; + if ( $pg_server_version < 70300 ) { + $hashref->{'sql_alter_null'} = + "UPDATE pg_attribute SET attnotnull = FALSE + WHERE attname = '$name' + AND attrelid = ( SELECT oid FROM pg_class + WHERE relname = '$table' + )"; + } + + } + + # 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 ( $old_column->null && ! $new_column->null ) { + + warn $warning if $warning; + if ( $pg_server_version < 70300 ) { + $hashref->{'sql_alter_null'} = + "UPDATE pg_attribute SET attnotnull = TRUE + WHERE attname = '$name' + AND attrelid = ( SELECT oid FROM pg_class + WHERE relname = '$table' + )"; + } + + } + + $hashref; + +} + =head1 AUTHOR Ivan Kohler @@ -162,6 +271,7 @@ Ivan Kohler Copyright (c) 2000 Ivan Kohler Copyright (c) 2000 Mail Abuse Prevention System LLC +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. diff --git a/DBSchema/DBD/mysql.pm b/DBSchema/DBD/mysql.pm index 924c309..a99dcf4 100644 --- a/DBSchema/DBD/mysql.pm +++ b/DBSchema/DBD/mysql.pm @@ -4,12 +4,13 @@ use strict; use vars qw($VERSION @ISA %typemap); use DBIx::DBSchema::DBD; -$VERSION = '0.05'; +$VERSION = '0.06'; @ISA = qw(DBIx::DBSchema::DBD); %typemap = ( 'TIMESTAMP' => 'DATETIME', 'SERIAL' => 'INTEGER', + 'BIGSERIAL' => 'BIGINT', 'BOOL' => 'TINYINT', 'LONG VARBINARY' => 'LONGBLOB', ); @@ -109,6 +110,26 @@ sub _show_index { ( $pkey, \%unique, \%index ); } +sub column_callback { + my( $proto, $dbh, $table, $column_obj ) = @_; + + my $hashref = { 'explicit_null' => 1, }; + + $hashref->{'effective_local'} = 'AUTO_INCREMENT' + if $column_obj->type =~ /^(\w*)SERIAL$/i; + + if ( $column_obj->default =~ /^(NOW)\(\)$/i + && $column_obj->type =~ /^(TIMESTAMP|DATETIME)$/i ) { + + $hashref->{'effective_default'} = 'CURRENT_TIMESTAMP'; + $hashref->{'effective_type'} = 'TIMESTAMP'; + + } + + $hashref; + +} + =head1 AUTHOR Ivan Kohler @@ -117,6 +138,7 @@ Ivan Kohler Copyright (c) 2000 Ivan Kohler Copyright (c) 2000 Mail Abuse Prevention System LLC +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. -- 2.11.0