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
$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
}
}
+=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.
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)} )
}
+=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
=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
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
bless ($self, $class);
+ $_->table_obj($self) foreach values %{ $self->{columns} };
+
+ $self;
}
=item new_odbc DATABASE_HANDLE TABLE_NAME
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 (
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)"),
=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;
}
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;
}
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 = '';
projects / DBIx-DBSchema.git / commitdiff