1 package DBIx::DBSchema::Column;
4 use vars qw(@ISA $VERSION);
7 use DBIx::DBSchema::_util qw(_load_driver);
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, shift);
251 unless ( ref($dbh) || ! @_ ) {
252 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
253 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
256 my $driver = $dbh ? _load_driver($dbh) : '';
259 %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
260 my $type = defined( $typemap{uc($self->type)} )
261 ? $typemap{uc($self->type)}
264 my $null = $self->null;
267 if ( defined($self->default) && !ref($self->default) && $self->default ne ''
269 # false laziness: nicked from FS::Record::_quote
270 && ( $self->default !~ /^\-?\d+(\.\d+)?$/
271 || $type =~ /(char|binary|blob|text)$/i
274 $default = $dbh->quote($self->default);
276 $default = ref($self->default) ? ${$self->default} : $self->default;
279 #this should be a callback into the driver
280 if ( $driver eq 'mysql' ) { #yucky mysql hack
281 $null ||= "NOT NULL";
282 $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
283 } elsif ( $driver =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg/SQLite hack
284 $null ||= "NOT NULL";
290 $type. ( ( defined($self->length) && $self->length )
291 ? '('.$self->length.')'
295 ( ( defined($default) && $default ne '' )
296 ? 'DEFAULT '. $default
299 ( ( $driver eq 'mysql' && defined($self->local) )
304 $dbh->disconnect if $created_dbh;
311 Returns a list of SQL statements to add this column.
313 The data source can be specified by passing an open DBI database handle, or by
314 passing the DBI data source name, username and password.
316 Although the username and password are optional, it is best to call this method
317 with a database handle or data source including a valid username and password -
318 a DBI connection will be opened and the quoting and type mapping will be more
321 If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
322 use PostgreSQL-specific syntax. Non-standard syntax for other engines (if
323 applicable) may also be supported in the future.
328 my($self, $dbh) = (shift, shift);
330 die "$self: this column is not assigned to a table"
331 unless $self->table_name;
333 #false laziness w/Table::sql_create_driver
335 unless ( ref($dbh) || ! @_ ) {
336 $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
337 my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
341 my $driver = $dbh ? _load_driver($dbh) : '';
348 if ( $driver eq 'Pg' && $self->type eq 'serial' ) {
349 $real_type = 'serial';
352 push @after_add, sub {
353 my($table, $column) = @_;
355 #needs more work for old Pg
358 if ( $dbh->{'pg_server_version'} > 70300 ) {
359 $nextval = "nextval('public.${table}_${column}_seq'::text)";
361 $nextval = "nextval('${table}_${column}_seq'::text)";
365 "ALTER TABLE $table ALTER COLUMN $column SET DEFAULT $nextval",
366 "CREATE SEQUENCE ${table}_${column}_seq",
367 "UPDATE $table SET $column = $nextval WHERE $column IS NULL",
368 #"ALTER TABLE $table ALTER $column SET NOT NULL",
375 my $real_null = undef;
376 if ( $driver eq 'Pg' && ! $self->null ) {
377 $real_null = $self->null;
380 if ( $dbh->{'pg_server_version'} > 70300 ) {
382 push @after_add, sub {
383 my($table, $column) = @_;
384 "ALTER TABLE $table ALTER $column SET NOT NULL";
389 push @after_add, sub {
390 my($table, $column) = @_;
391 "UPDATE pg_attribute SET attnotnull = TRUE ".
392 " WHERE attname = '$column' ".
393 " AND attrelid = ( SELECT oid FROM pg_class WHERE relname = '$table' )";
401 my $table = $self->table_name;
402 my $column = $self->name;
404 push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
406 push @r, &{$_}($table, $column) foreach @after_add;
408 push @r, "ALTER TABLE $table ADD PRIMARY KEY ( ".
409 $self->table_obj->primary_key. " )"
410 if $self->name eq $self->table_obj->primary_key;
412 $self->type($real_type) if $real_type;
413 $self->null($real_null) if defined $real_null;
415 $dbh->disconnect if $created_dbh;
425 Ivan Kohler <ivan-dbix-dbschema@420.am>
429 Copyright (c) 2000-2005 Ivan Kohler
431 This program is free software; you can redistribute it and/or modify it under
432 the same terms as Perl itself.
436 Better documentation is needed for sql_add_column
438 line() and sql_add_column() hav database-specific foo that should be abstracted
439 into the DBIx::DBSchema:DBD:: modules.
443 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>