From b8e231ddc17b573b8bce6e884b269997234cb43c Mon Sep 17 00:00:00 2001 From: ivan Date: Tue, 16 Aug 2005 06:32:44 +0000 Subject: [PATCH] new Column::sql_add_column method --- Changes | 5 +- DBSchema.pm | 18 +------ DBSchema/Column.pm | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++--- DBSchema/Table.pm | 32 ++++++------ DBSchema/_util.pm | 30 ++++++++++++ TODO | 1 + 6 files changed, 182 insertions(+), 43 deletions(-) create mode 100644 DBSchema/_util.pm diff --git a/Changes b/Changes index ac741d0..872d995 100644 --- a/Changes +++ b/Changes @@ -1,7 +1,8 @@ Revision history for Perl extension DBIx::DBSchema. -0.27 unreleased - - MySQL patch for enum types from Andy Orr +0.27 Mon Aug 15 23:31:54 PDT 2005 + - MySQL patch for enum types from Andy Orr + - new Column::sql_add_column method! 0.26 Thu Apr 7 01:09:53 PDT 2005 - ask for "public" db schema only from Pg diff --git a/DBSchema.pm b/DBSchema.pm index f15c2fa..748444c 100644 --- a/DBSchema.pm +++ b/DBSchema.pm @@ -3,9 +3,9 @@ package DBIx::DBSchema; use strict; use vars qw(@ISA $VERSION); #use Exporter; -use Carp qw(confess); use DBI; use Storable; +use DBIx::DBSchema::_util qw(_load_driver); use DBIx::DBSchema::Table; use DBIx::DBSchema::Column; use DBIx::DBSchema::ColGroup::Unique; @@ -306,22 +306,6 @@ sub pretty_read { # private subroutines -sub _load_driver { - my($dbh) = @_; - my $driver; - if ( ref($dbh) ) { - $driver = $dbh->{Driver}->{Name}; - } else { - $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect - or '' =~ /()/; # ensure $1 etc are empty if match fails - $driver = $1 or confess "can't parse data source: $dbh"; - } - - #require "DBIx/DBSchema/DBD/$driver.pm"; - #$driver; - eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@; -} - sub _tables_from_dbh { my($dbh) = @_; my $driver = _load_driver($dbh); diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm index 4e26646..a5b054a 100644 --- a/DBSchema/Column.pm +++ b/DBSchema/Column.pm @@ -4,11 +4,12 @@ use strict; use vars qw(@ISA $VERSION); #use Carp; #use Exporter; +use DBIx::DBSchema::_util qw(_load_driver); #@ISA = qw(Exporter); @ISA = qw(); -$VERSION = '0.02'; +$VERSION = '0.03'; =head1 NAME @@ -52,6 +53,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 @@ -190,6 +194,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. @@ -218,8 +250,8 @@ sub line { my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error $created_dbh = 1; } - - my $driver = DBIx::DBSchema::_load_driver($dbh); + my $driver = $dbh ? _load_driver($dbh) : ''; + my %typemap; %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver; my $type = defined( $typemap{uc($self->type)} ) @@ -271,6 +303,100 @@ sub line { } +=item sql_add_column + +Returns a list of SQL statements to add this column. + +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', 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); + + 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 = ''; + 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 $nextval = "nextval('public.${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", + ); + + }; + + } + + my $real_null = undef; + if ( $driver eq 'Pg' && ! $self->null ) { + $real_null = $self->null; + $self->null('NULL'); + + push @after_add, sub { + my($table, $column) = @_; + "ALTER TABLE $table ALTER $column SET NOT NULL"; + }; + + } + + my @r = (); + my $table = $self->table_name; + my $column = $self->name; + + push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh); + + push @r, &{$_}($table, $column) foreach @after_add; + + push @r, "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; + + $dbh->disconnect if $created_dbh; + + @r; + +} + =back =head1 AUTHOR @@ -279,16 +405,15 @@ Ivan Kohler =head1 COPYRIGHT -Copyright (c) 2000 Ivan Kohler -Copyright (c) 2000 Mail Abuse Prevention System LLC +Copyright (c) 2000-2005 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 -line() has database-specific foo that probably ought to 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. =head1 SEE ALSO diff --git a/DBSchema/Table.pm b/DBSchema/Table.pm index 2d6272e..0066115 100644 --- a/DBSchema/Table.pm +++ b/DBSchema/Table.pm @@ -1,16 +1,19 @@ package DBIx::DBSchema::Table; use strict; -use vars qw(@ISA %create_params); +use vars qw(@ISA $VERSION %create_params); #use Carp; #use Exporter; -use DBIx::DBSchema::Column 0.02; +use DBIx::DBSchema::_util qw(_load_driver); +use DBIx::DBSchema::Column 0.03; use DBIx::DBSchema::ColGroup::Unique; use DBIx::DBSchema::ColGroup::Index; #@ISA = qw(Exporter); @ISA = qw(); +$VERSION = '0.02'; + =head1 NAME DBIx::DBSchema::Table - Table objects @@ -131,6 +134,9 @@ sub new { bless ($self, $class); + $_->table_obj($self) foreach values %{ $self->{columns} }; + + $self; } =item new_odbc DATABASE_HANDLE TABLE_NAME @@ -159,7 +165,7 @@ have to have ODBC installed or connect to the database via ODBC. sub new_odbc { my( $proto, $dbh, $name) = @_; - my $driver = DBIx::DBSchema::_load_driver($dbh); + my $driver = _load_driver($dbh); my $sth = _null_sth($dbh, $name); my $sthpos = 0; $proto->new ( @@ -205,7 +211,7 @@ engine (currently, MySQL and PostgreSQL). sub new_native { my( $proto, $dbh, $name) = @_; - my $driver = DBIx::DBSchema::_load_driver($dbh); + my $driver = _load_driver($dbh); $proto->new ( $name, scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"), @@ -228,8 +234,9 @@ Adds this DBIx::DBSchema::Column object. =cut sub addcolumn { - my($self,$column)=@_; - ${$self->{'columns'}}{$column->name}=$column; #sanity check? + my($self, $column) = @_; + $column->table_obj($self); + ${$self->{'columns'}}{$column->name} = $column; #sanity check? push @{$self->{'column_order'}}, $column->name; } @@ -243,6 +250,7 @@ remove, true otherwise. sub delcolumn { my($self,$column) = @_; return 0 unless exists $self->{'columns'}{$column}; + $self->{'columns'}{$column}->table_obj(''); delete $self->{'columns'}{$column}; @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}}; 1; } @@ -365,17 +373,7 @@ sub sql_create_table { my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error $created_dbh = 1; } - #false laziness: nicked from DBSchema::_load_driver - my $driver; - if ( ref($dbh) ) { - $driver = $dbh->{Driver}->{Name}; - } else { - my $discard = $dbh; - $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect - or '' =~ /()/; # ensure $1 etc are empty if match fails - $driver = $1 or die "can't parse data source: $dbh"; - } - #eofalse + my $driver = _load_driver($dbh); #should be in the DBD somehwere :/ # my $saved_pkey = ''; diff --git a/DBSchema/_util.pm b/DBSchema/_util.pm new file mode 100644 index 0000000..4e7c3aa --- /dev/null +++ b/DBSchema/_util.pm @@ -0,0 +1,30 @@ +# internal utility subroutines used by multiple classes + +package DBIx::DBSchema::_util; + +use strict; +use vars qw(@ISA @EXPORT_OK); +use Exporter; +use Carp qw(confess); + +@ISA = qw(Exporter); +@EXPORT_OK = qw( _load_driver ); + +sub _load_driver { + my($dbh) = @_; + my $driver; + if ( ref($dbh) ) { + $driver = $dbh->{Driver}->{Name}; + } else { + $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect + or '' =~ /()/; # ensure $1 etc are empty if match fails + $driver = $1 or confess "can't parse data source: $dbh"; + } + + #require "DBIx/DBSchema/DBD/$driver.pm"; + #$driver; + eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver or die $@; +} + +1; + diff --git a/TODO b/TODO index e75850b..50369ef 100644 --- a/TODO +++ b/TODO @@ -4,3 +4,4 @@ sql CREATE TABLE output should convert integers (i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash to fudge things +index representation needs an overhaul. named indices. -- 2.11.0