DBSchema/Column.pm

   1 package DBIx::DBSchema::Column;
   2
   3 use strict;
   4 use vars qw(@ISA $VERSION);
   5 #use Carp;
   6 #use Exporter;
   7 use DBIx::DBSchema::_util qw(_load_driver);
   8
   9 #@ISA = qw(Exporter);
  10 @ISA = qw();
  11
  12 $VERSION = '0.05';
  13
  14 =head1 NAME
  15
  16 DBIx::DBSchema::Column - Column objects
  17
  18 =head1 SYNOPSIS
  19
  20   use DBIx::DBSchema::Column;
  21
  22   #named params with a hashref (preferred)
  23   $column = new DBIx::DBSchema::Column ( {
  24     'name'    => 'column_name',
  25     'type'    => 'varchar'
  26     'null'    => 'NOT NULL',
  27     'length'  => 64,
  28     'default' => '',
  29     'local'   => '',
  30   } );
  31
  32   #list
  33   $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
  34
  35   $name = $column->name;
  36   $column->name( 'name' );
  37
  38   $sql_type = $column->type;
  39   $column->type( 'sql_type' );
  40
  41   $null = $column->null;
  42   $column->null( 'NULL' );
  43   $column->null( 'NOT NULL' );
  44   $column->null( '' );
  45
  46   $length = $column->length;
  47   $column->length( '10' );
  48   $column->length( '8,2' );
  49
  50   $default = $column->default;
  51   $column->default( 'Roo' );
  52
  53   $sql_line = $column->line;
  54   $sql_line = $column->line($datasrc);
  55
  56   $sql_add_column = $column->sql_add_column;
  57   $sql_add_column = $column->sql_add_column($datasrc);
  58
  59 =head1 DESCRIPTION
  60
  61 DBIx::DBSchema::Column objects represent columns in tables (see
  62 L<DBIx::DBSchema::Table>).
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item new HASHREF
  69
  70 =item new [ name [ , type [ , null [ , length  [ , default [ , local ] ] ] ] ] ]
  71
  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.
  78
  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
  80 defaults.
  81
  82 =cut
  83
  84 sub new {
  85   my $proto = shift;
  86   my $class = ref($proto) || $proto;
  87
  88   my $self;
  89   if ( ref($_[0]) ) {
  90     $self = shift;
  91   } else {
  92     $self = { map { $_ => shift } qw(name type null length default local) };
  93   }
  94
  95   #croak "Illegal name: ". $self->{'name'}
  96   #  if grep $self->{'name'} eq $_, @reserved_words;
  97
  98   $self->{'null'} =~ s/^NOT NULL$//i;
  99   $self->{'null'} = 'NULL' if $self->{'null'};
 100
 101   bless ($self, $class);
 102
 103 }
 104
 105 =item name [ NAME ]
 106
 107 Returns or sets the column name.
 108
 109 =cut
 110
 111 sub name {
 112   my($self,$value)=@_;
 113   if ( defined($value) ) {
 114   #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
 115     $self->{'name'} = $value;
 116   } else {
 117     $self->{'name'};
 118   }
 119 }
 120
 121 =item type [ TYPE ]
 122
 123 Returns or sets the column type.
 124
 125 =cut
 126
 127 sub type {
 128   my($self,$value)=@_;
 129   if ( defined($value) ) {
 130     $self->{'type'} = $value;
 131   } else {
 132     $self->{'type'};
 133   }
 134 }
 135
 136 =item null [ NULL ]
 137
 138 Returns or sets the column null flag (the empty string is equivalent to
 139 `NOT NULL')
 140
 141 =cut
 142
 143 sub null {
 144   my($self,$value)=@_;
 145   if ( defined($value) ) {
 146     $value =~ s/^NOT NULL$//i;
 147     $value = 'NULL' if $value;
 148     $self->{'null'} = $value;
 149   } else {
 150     $self->{'null'};
 151   }
 152 }
 153
 154 =item length [ LENGTH ]
 155
 156 Returns or sets the column length.
 157
 158 =cut
 159
 160 sub length {
 161   my($self,$value)=@_;
 162   if ( defined($value) ) {
 163     $self->{'length'} = $value;
 164   } else {
 165     $self->{'length'};
 166   }
 167 }
 168
 169 =item default [ LOCAL ]
 170
 171 Returns or sets the default value.
 172
 173 =cut
 174
 175 sub default {
 176   my($self,$value)=@_;
 177   if ( defined($value) ) {
 178     $self->{'default'} = $value;
 179   } else {
 180     $self->{'default'};
 181   }
 182 }
 183
 184
 185 =item local [ LOCAL ]
 186
 187 Returns or sets the database-specific field.
 188
 189 =cut
 190
 191 sub local {
 192   my($self,$value)=@_;
 193   if ( defined($value) ) {
 194     $self->{'local'} = $value;
 195   } else {
 196     $self->{'local'};
 197   }
 198 }
 199
 200 =item table_obj [ TABLE_OBJ ]
 201
 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.
 204
 205 =cut
 206
 207 sub table_obj {
 208   my($self,$value)=@_;
 209   if ( defined($value) ) {
 210     $self->{'table_obj'} = $value;
 211   } else {
 212     $self->{'table_obj'};
 213   }
 214 }
 215
 216 =item table_name
 217
 218 Returns the table name, or the empty string if this column has not yet been
 219 assigned to a table.
 220
 221 =cut
 222
 223 sub table_name {
 224   my $self = shift;
 225   $self->{'table_obj'} ? $self->{'table_obj'}->name : '';
 226 }
 227
 228 =item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 229
 230 Returns an SQL column definition.
 231
 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.
 234
 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
 238 reliable.
 239
 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.
 244
 245 =cut
 246
 247 sub line {
 248   my($self,$dbh) = (shift, shift);
 249
 250   my $created_dbh = 0;
 251   unless ( ref($dbh) || ! @_ ) {
 252     $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
 253     my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
 254     $created_dbh = 1;
 255   }
 256   my $driver = $dbh ? _load_driver($dbh) : '';
 257
 258   my %typemap;
 259   %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
 260   my $type = defined( $typemap{uc($self->type)} )
 261     ? $typemap{uc($self->type)}
 262     : $self->type;
 263
 264   my $null = $self->null;
 265
 266   my $default;
 267   if ( defined($self->default) && !ref($self->default) && $self->default ne ''
 268        && ref($dbh)
 269        # false laziness: nicked from FS::Record::_quote
 270        && ( $self->default !~ /^\-?\d+(\.\d+)?$/
 271             || $type =~ /(char|binary|blob|text)$/i
 272           )
 273   ) {
 274     $default = $dbh->quote($self->default);
 275   } else {
 276     warn "*** ref pointing to data: ". ${$self->default}
 277       if $ref($self->default);
 278     $default = ref($self->default) ? ${$self->default} : $self->default;
 279   }
 280
 281   #this should be a callback into the driver
 282   if ( $driver eq 'mysql' ) { #yucky mysql hack
 283     $null ||= "NOT NULL";
 284     $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
 285   } elsif ( $driver =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg/SQLite hack
 286     $null ||= "NOT NULL";
 287     $null =~ s/^NULL$//;
 288   }
 289
 290   my $r = join(' ',
 291     $self->name,
 292     $type. ( ( defined($self->length) && $self->length )
 293              ? '('.$self->length.')'
 294              : ''
 295            ),
 296     $null,
 297     ( ( defined($default) && $default ne '' )
 298       ? 'DEFAULT '. $default
 299       : ''
 300     ),
 301     ( ( $driver eq 'mysql' && defined($self->local) )
 302       ? $self->local
 303       : ''
 304     ),
 305   );
 306   $dbh->disconnect if $created_dbh;
 307   $r;
 308
 309 }
 310
 311 =item sql_add_column
 312
 313 Returns a list of SQL statements to add this column.
 314
 315 The data source can be specified by passing an open DBI database handle, or by
 316 passing the DBI data source name, username and password.
 317
 318 Although the username and password are optional, it is best to call this method
 319 with a database handle or data source including a valid username and password -
 320 a DBI connection will be opened and the quoting and type mapping will be more
 321 reliable.
 322
 323 If passed a DBI data source (or handle) such as `DBI:Pg:dbname=database', will
 324 use PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 325 applicable) may also be supported in the future.
 326
 327 =cut
 328
 329 sub sql_add_column {
 330   my($self, $dbh) = (shift, shift);
 331
 332   die "$self: this column is not assigned to a table"
 333     unless $self->table_name;
 334
 335   #false laziness w/Table::sql_create_driver
 336   my $created_dbh = 0;
 337   unless ( ref($dbh) || ! @_ ) {
 338     $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
 339     my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
 340     $created_dbh = 1;
 341   }
 342
 343   my $driver = $dbh ? _load_driver($dbh) : '';
 344
 345   #eofalse
 346
 347   my @after_add = ();
 348
 349   my $real_type = '';
 350   if (  $driver eq 'Pg' && $self->type eq 'serial' ) {
 351     $real_type = 'serial';
 352     $self->type('int');
 353
 354     push @after_add, sub {
 355       my($table, $column) = @_;
 356
 357       #needs more work for old Pg
 358
 359       my $nextval;
 360       if ( $dbh->{'pg_server_version'} > 70300 ) {
 361         $nextval = "nextval('public.${table}_${column}_seq'::text)";
 362       } else {
 363         $nextval = "nextval('${table}_${column}_seq'::text)";
 364       }
 365
 366       (
 367         "ALTER TABLE $table ALTER COLUMN $column SET DEFAULT $nextval",
 368         "CREATE SEQUENCE ${table}_${column}_seq",
 369         "UPDATE $table SET $column = $nextval WHERE $column IS NULL",
 370         #"ALTER TABLE $table ALTER $column SET NOT NULL",
 371       );
 372
 373     };
 374
 375   }
 376
 377   my $real_null = undef;
 378   if ( $driver eq 'Pg' && ! $self->null ) {
 379     $real_null = $self->null;
 380     $self->null('NULL');
 381
 382     if ( $dbh->{'pg_server_version'} > 70300 ) {
 383
 384       push @after_add, sub {
 385         my($table, $column) = @_;
 386         "ALTER TABLE $table ALTER $column SET NOT NULL";
 387       };
 388
 389     } else {
 390
 391       push @after_add, sub {
 392         my($table, $column) = @_;
 393         "UPDATE pg_attribute SET attnotnull = TRUE ".
 394         " WHERE attname = '$column' ".
 395         " AND attrelid = ( SELECT oid FROM pg_class WHERE relname = '$table' )";
 396       };
 397
 398     }
 399
 400   }
 401
 402   my @r = ();
 403   my $table = $self->table_name;
 404   my $column = $self->name;
 405
 406   push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
 407
 408   push @r, &{$_}($table, $column) foreach @after_add;
 409
 410   push @r, "ALTER TABLE $table ADD PRIMARY KEY ( ".
 411              $self->table_obj->primary_key. " )"
 412     if $self->name eq $self->table_obj->primary_key;
 413
 414   $self->type($real_type) if $real_type;
 415   $self->null($real_null) if defined $real_null;
 416
 417   $dbh->disconnect if $created_dbh;
 418
 419   @r;
 420
 421 }
 422
 423 =back
 424
 425 =head1 AUTHOR
 426
 427 Ivan Kohler <ivan-dbix-dbschema@420.am>
 428
 429 =head1 COPYRIGHT
 430
 431 Copyright (c) 2000-2005 Ivan Kohler
 432 All rights reserved.
 433 This program is free software; you can redistribute it and/or modify it under
 434 the same terms as Perl itself.
 435
 436 =head1 BUGS
 437
 438 Better documentation is needed for sql_add_column
 439
 440 line() and sql_add_column() hav database-specific foo that should be abstracted
 441 into the DBIx::DBSchema:DBD:: modules.
 442
 443 =head1 SEE ALSO
 444
 445 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 446
 447 =cut
 448
 449 1;
 450