1 package DBIx::DBSchema::Column;
4 use vars qw(@ISA $VERSION);
7 use DBIx::DBSchema::_util qw(_load_driver _dbh);
16 DBIx::DBSchema::Column - Column objects
20 use DBIx::DBSchema::Column;
22 #named params with a hashref (preferred)
23 $column = new DBIx::DBSchema::Column ( {
24 'name' => 'column_name',
33 $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
35 $name = $column->name;
36 $column->name( 'name' );
38 $sql_type = $column->type;
39 $column->type( 'sql_type' );
41 $null = $column->null;
42 $column->null( 'NULL' );
43 $column->null( 'NOT NULL' );
46 $length = $column->length;
47 $column->length( '10' );
48 $column->length( '8,2' );
50 $default = $column->default;
51 $column->default( 'Roo' );
53 $sql_line = $column->line;
54 $sql_line = $column->line($datasrc);
56 $sql_add_column = $column->sql_add_column;
57 $sql_add_column = $column->sql_add_column($datasrc);
61 DBIx::DBSchema::Column objects represent columns in tables (see
62 L<DBIx::DBSchema::Table>).
70 =item new [ name [ , type [ , null [ , length [ , default [ , local ] ] ] ] ] ]
72 Creates a new DBIx::DBSchema::Column object. Takes a hashref of named
73 parameters, or a list. B<name> is the name of the column. B<type> is the SQL
74 data type. B<null> is the nullability of the column (intrepreted using Perl's
75 rules for truth, with one exception: `NOT NULL' is false). B<length> is the
76 SQL length of the column. B<default> is the default value of the column.
77 B<local> is reserved for database-specific information.
79 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
86 my $class = ref($proto) || $proto;
92 $self = { map { $_ => shift } qw(name type null length default local) };
95 #croak "Illegal name: ". $self->{'name'}
96 # if grep $self->{'name'} eq $_, @reserved_words;
98 $self->{'null'} =~ s/^NOT NULL$//i;
99 $self->{'null'} = 'NULL' if $self->{'null'};
101 bless ($self, $class);
107 Returns or sets the column name.
113 if ( defined($value) ) {
114 #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
115 $self->{'name'} = $value;
123 Returns or sets the column type.
129 if ( defined($value) ) {
130 $self->{'type'} = $value;
138 Returns or sets the column null flag (the empty string is equivalent to
145 if ( defined($value) ) {
146 $value =~ s/^NOT NULL$//i;
147 $value = 'NULL' if $value;
148 $self->{'null'} = $value;
154 =item length [ LENGTH ]
156 Returns or sets the column length.
162 if ( defined($value) ) {
163 $self->{'length'} = $value;
169 =item default [ LOCAL ]
171 Returns or sets the default value.
177 if ( defined($value) ) {
178 $self->{'default'} = $value;
185 =item local [ LOCAL ]
187 Returns or sets the database-specific field.
193 if ( defined($value) ) {
194 $self->{'local'} = $value;
200 =item table_obj [ TABLE_OBJ ]
202 Returns or sets the table object (see L<DBIx::DBSchema::Table>). Typically
203 set internally when a column object is added to a table object.
209 if ( defined($value) ) {
210 $self->{'table_obj'} = $value;
212 $self->{'table_obj'};
218 Returns the table name, or the empty string if this column has not yet been
225 $self->{'table_obj'} ? $self->{'table_obj'}->name : '';
228 =item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
230 Returns an SQL column definition.
232 The data source can be specified by passing an open DBI database handle, or by
233 passing the DBI data source name, username and password.
235 Although the username and password are optional, it is best to call this method
236 with a database handle or data source including a valid username and password -
237 a DBI connection will be opened and the quoting and type mapping will be more
240 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
241 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
242 Currently supported databases are MySQL and PostgreSQL. Non-standard syntax
243 for other engines (if applicable) may also be supported in the future.
248 my($self, $dbh) = ( shift, _dbh(@_) );
250 my $driver = $dbh ? _load_driver($dbh) : '';
253 %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
254 my $type = defined( $typemap{uc($self->type)} )
255 ? $typemap{uc($self->type)}
258 my $null = $self->null;
261 if ( defined($self->default) && !ref($self->default) && $self->default ne ''
263 # false laziness: nicked from FS::Record::_quote
264 && ( $self->default !~ /^\-?\d+(\.\d+)?$/
265 || $type =~ /(char|binary|blob|text)$/i
268 $default = $dbh->quote($self->default);
270 $default = ref($self->default) ? ${$self->default} : $self->default;
273 #this should be a callback into the driver
274 if ( $driver eq 'mysql' ) { #yucky mysql hack
275 $null ||= "NOT NULL";
276 $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
277 } elsif ( $driver =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg/SQLite hack
278 $null ||= "NOT NULL";
284 $type. ( ( defined($self->length) && $self->length )
285 ? '('.$self->length.')'
289 ( ( defined($default) && $default ne '' )
290 ? 'DEFAULT '. $default
293 ( ( $driver eq 'mysql' && defined($self->local) )
301 =item sql_add_column [ DBH ]
303 Returns a list of SQL statements to add this column to an existing table. (To
304 create a new table, see L<DBIx::DBSchema::Table/sql_create_table> instead.)
306 The data source can be specified by passing an open DBI database handle, or by
307 passing the DBI data source name, username and password.
309 Although the username and password are optional, it is best to call this method
310 with a database handle or data source including a valid username and password -
311 a DBI connection will be opened and the quoting and type mapping will be more
314 If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
315 use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
316 applicable) may also be supported in the future.
321 my($self, $dbh) = ( shift, _dbh(@_) );
323 die "$self: this column is not assigned to a table"
324 unless $self->table_name;
326 my $driver = $dbh ? _load_driver($dbh) : '';
331 if ( $driver eq 'Pg' && $self->type eq 'serial' ) {
332 $real_type = 'serial';
335 push @after_add, sub {
336 my($table, $column) = @_;
338 #needs more work for old Pg
341 if ( $dbh->{'pg_server_version'} > 70300 ) {
342 $nextval = "nextval('public.${table}_${column}_seq'::text)";
344 $nextval = "nextval('${table}_${column}_seq'::text)";
348 "ALTER TABLE $table ALTER COLUMN $column SET DEFAULT $nextval",
349 "CREATE SEQUENCE ${table}_${column}_seq",
350 "UPDATE $table SET $column = $nextval WHERE $column IS NULL",
351 #"ALTER TABLE $table ALTER $column SET NOT NULL",
358 my $real_null = undef;
359 if ( $driver eq 'Pg' && ! $self->null ) {
360 $real_null = $self->null;
363 #if ( $dbh->{'pg_server_version'} > 70300 ) { #this seemed to work on 7.3
364 if ( $dbh->{'pg_server_version'} > 70400 ) { #after all...
366 push @after_add, sub {
367 my($table, $column) = @_;
368 "ALTER TABLE $table ALTER $column SET NOT NULL";
373 push @after_add, sub {
374 my($table, $column) = @_;
375 "UPDATE pg_attribute SET attnotnull = TRUE ".
376 " WHERE attname = '$column' ".
377 " AND attrelid = ( SELECT oid FROM pg_class WHERE relname = '$table' )";
385 my $table = $self->table_name;
386 my $column = $self->name;
388 push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
390 push @r, &{$_}($table, $column) foreach @after_add;
392 push @r, "ALTER TABLE $table ADD PRIMARY KEY ( ".
393 $self->table_obj->primary_key. " )"
394 if $self->name eq $self->table_obj->primary_key;
396 $self->type($real_type) if $real_type;
397 $self->null($real_null) if defined $real_null;
403 =item sql_alter_column PROTOTYPE_COLUMN [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
405 Returns a list of SQL statements to alter this column so that it is identical
406 to the provided prototype column, also a DBIx::DBSchema::Column object.
408 #Optionally, the data source can be specified by passing an open DBI database
409 #handle, or by passing the DBI data source name, username and password.
411 #If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
412 #use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
413 #applicable) may also be supported in the future.
415 #If not passed a data source (or handle), or if there is no driver for the
416 #specified database, will attempt to use generic SQL syntax.
419 Or should, someday. Right now it knows how to change NOT NULL into NULL and
424 sub sql_alter_column {
425 my( $self, $new, $dbh ) = ( shift, shift, _dbh(@_) );
427 my $table = $self->table_name;
428 die "$self: this column is not assigned to a table"
431 my $name = $self->name;
433 my $driver = $dbh ? _load_driver($dbh) : '';
441 # change nullability from NOT NULL to NULL
442 if ( ! $self->null && $new->null ) {
444 if ( $driver eq 'Pg' && $dbh->{'pg_server_version'} < 70300 ) {
445 push @r, "UPDATE pg_attribute SET attnotnull = FALSE
446 WHERE attname = '$name'
447 AND attrelid = ( SELECT oid FROM pg_class
448 WHERE relname = '$table'
451 push @r, "ALTER TABLE $table ALTER COLUMN $name DROP NOT NULL";
455 # change nullability from NULL to NOT NULL...
456 # this one could be more complicated, need to set a DEFAULT value and update
458 if ( $self->null && ! $new->null ) {
459 push @r, "ALTER TABLE $table ALTER COLUMN $name SET NOT NULL";
462 # change other stuff...
472 Ivan Kohler <ivan-dbix-dbschema@420.am>
476 Copyright (c) 2000-2006 Ivan Kohler
478 This program is free software; you can redistribute it and/or modify it under
479 the same terms as Perl itself.
483 Better documentation is needed for sql_add_column
485 line() and sql_add_column() hav database-specific foo that should be abstracted
486 into the DBIx::DBSchema:DBD:: modules.
490 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>