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.03';
  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) && $self->default ne ''
 265        && ref($dbh)
 266        # false laziness: nicked from FS::Record::_quote
 267        && ( $self->default !~ /^\-?\d+(\.\d+)?$/
 268             || $type =~ /(char|binary|blob|text)$/i
 269           )
 270   ) {
 271     $default = $dbh->quote($self->default);
 272   } else {
 273     $default = $self->default;
 274   }
 275
 276   #this should be a callback into the driver
 277   if ( $driver eq 'mysql' ) { #yucky mysql hack
 278     $null ||= "NOT NULL";
 279     $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
 280   } elsif ( $driver =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg/SQLite hack
 281     $null ||= "NOT NULL";
 282     $null =~ s/^NULL$//;
 283   }
 284
 285   my $r = join(' ',
 286     $self->name,
 287     $type. ( ( defined($self->length) && $self->length )
 288              ? '('.$self->length.')'
 289              : ''
 290            ),
 291     $null,
 292     ( ( defined($default) && $default ne '' )
 293       ? 'DEFAULT '. $default
 294       : ''
 295     ),
 296     ( ( $driver eq 'mysql' && defined($self->local) )
 297       ? $self->local
 298       : ''
 299     ),
 300   );
 301   $dbh->disconnect if $created_dbh;
 302   $r;
 303
 304 }
 305
 306 =item sql_add_column
 307
 308 Returns a list of SQL statements to add this column.
 309
 310 The data source can be specified by passing an open DBI database handle, or by
 311 passing the DBI data source name, username and password.
 312
 313 Although the username and password are optional, it is best to call this method
 314 with a database handle or data source including a valid username and password -
 315 a DBI connection will be opened and the quoting and type mapping will be more
 316 reliable.
 317
 318 If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
 319 PostgreSQL-specific syntax.  Non-standard syntax for other engines (if
 320 applicable) may also be supported in the future.
 321
 322 =cut
 323
 324 sub sql_add_column {
 325   my($self, $dbh) = (shift, shift);
 326
 327   die "$self: this column is not assigned to a table"
 328     unless $self->table_name;
 329
 330   #false laziness w/Table::sql_create_driver
 331   my $created_dbh = 0;
 332   unless ( ref($dbh) || ! @_ ) {
 333     $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
 334     my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
 335     $created_dbh = 1;
 336   }
 337
 338   my $driver = $dbh ? _load_driver($dbh) : '';
 339
 340   #eofalse
 341
 342   my @after_add = ();
 343
 344   my $real_type = '';
 345   if (  $driver eq 'Pg' && $self->type eq 'serial' ) {
 346     $real_type = 'serial';
 347     $self->type('int');
 348
 349     push @after_add, sub {
 350       my($table, $column) = @_;
 351
 352       #needs more work for old Pg
 353
 354       my $nextval;
 355       if ( $dbh->{'pg_server_version'} > 70300 ) {
 356         $nextval = "nextval('public.${table}_${column}_seq'::text)";
 357       } else {
 358         $nextval = "nextval('${table}_${column}_seq'::text)";
 359       }
 360
 361       (
 362         "ALTER TABLE $table ALTER COLUMN $column SET DEFAULT $nextval",
 363         "CREATE SEQUENCE ${table}_${column}_seq",
 364         "UPDATE $table SET $column = $nextval WHERE $column IS NULL",
 365         #"ALTER TABLE $table ALTER $column SET NOT NULL",
 366       );
 367
 368     };
 369
 370   }
 371
 372   my $real_null = undef;
 373   if ( $driver eq 'Pg' && ! $self->null ) {
 374     $real_null = $self->null;
 375     $self->null('NULL');
 376
 377     if ( $dbh->{'pg_server_version'} > 70300 ) {
 378
 379       push @after_add, sub {
 380         my($table, $column) = @_;
 381         "ALTER TABLE $table ALTER $column SET NOT NULL";
 382       };
 383
 384     } else {
 385
 386       push @after_add, sub {
 387         my($table, $column) = @_;
 388         "UPDATE pg_attribute SET attnotnull = TRUE ".
 389         " WHERE attname = '$column' ".
 390         " AND attrelid = ( SELECT oid FROM pg_class WHERE relname = '$table' )";
 391       };
 392
 393     }
 394
 395   }
 396
 397   my @r = ();
 398   my $table = $self->table_name;
 399   my $column = $self->name;
 400
 401   push @r, "ALTER TABLE $table ADD COLUMN ". $self->line($dbh);
 402
 403   push @r, &{$_}($table, $column) foreach @after_add;
 404
 405   push @r, "ALTER TABLE $table ADD PRIMARY KEY ( ".
 406              $self->table_obj->primary_key. " )"
 407     if $self->name eq $self->table_obj->primary_key;
 408
 409   $self->type($real_type) if $real_type;
 410   $self->null($real_null) if defined $real_null;
 411
 412   $dbh->disconnect if $created_dbh;
 413
 414   @r;
 415
 416 }
 417
 418 =back
 419
 420 =head1 AUTHOR
 421
 422 Ivan Kohler <ivan-dbix-dbschema@420.am>
 423
 424 =head1 COPYRIGHT
 425
 426 Copyright (c) 2000-2005 Ivan Kohler
 427 All rights reserved.
 428 This program is free software; you can redistribute it and/or modify it under
 429 the same terms as Perl itself.
 430
 431 =head1 BUGS
 432
 433 line() and sql_add_column() hav database-specific foo that should be abstracted
 434 into the DBIx::DBSchema:DBD:: modules.
 435
 436 =head1 SEE ALSO
 437
 438 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 439
 440 =cut
 441
 442 1;
 443