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