DBSchema/Column.pm

   1 package DBIx::DBSchema::Column;
   2
   3 use strict;
   4 use vars qw(@ISA);
   5 #use Carp;
   6 #use Exporter;
   7
   8 #@ISA = qw(Exporter);
   9 @ISA = qw();
  10
  11 =head1 NAME
  12
  13 DBIx::DBSchema::Column - Column objects
  14
  15 =head1 SYNOPSIS
  16
  17   use DBIx::DBSchema::Column;
  18
  19   #named params with a hashref (preferred)
  20   $column = new DBIx::DBSchema::Column ( {
  21     'name'    => 'column_name',
  22     'type'    => 'varchar'
  23     'null'    => 'NOT NULL',
  24     'length'  => 64,
  25     'default' => '
  26     'local'   => '',
  27   } );
  28
  29   #list
  30   $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
  31
  32   $name = $column->name;
  33   $column->name( 'name' );
  34
  35   $sql_type = $column->type;
  36   $column->type( 'sql_type' );
  37
  38   $null = $column->null;
  39   $column->null( 'NULL' );
  40   $column->null( 'NOT NULL' );
  41   $column->null( '' );
  42
  43   $length = $column->length;
  44   $column->length( '10' );
  45   $column->length( '8,2' );
  46
  47   $default = $column->default;
  48   $column->default( 'Roo' );
  49
  50   $sql_line = $column->line;
  51   $sql_line = $column->line($datasrc);
  52
  53 =head1 DESCRIPTION
  54
  55 DBIx::DBSchema::Column objects represent columns in tables (see
  56 L<DBIx::DBSchema::Table>).
  57
  58 =head1 METHODS
  59
  60 =over 4
  61
  62 =item new HASHREF
  63
  64 =item new [ name [ , type [ , null [ , length  [ , default [ , local ] ] ] ] ] ]
  65
  66 Creates a new DBIx::DBSchema::Column object.  Takes a hashref of named
  67 parameters, or a list.  B<name> is the name of the column.  B<type> is the SQL
  68 data type.  B<null> is the nullability of the column (intrepreted using Perl's
  69 rules for truth, with one exception: `NOT NULL' is false).  B<length> is the
  70 SQL length of the column.  B<default> is the default value of the column.
  71 B<local> is reserved for database-specific information.
  72
  73 =cut
  74
  75 sub new {
  76   my $proto = shift;
  77   my $class = ref($proto) || $proto;
  78
  79   my $self;
  80   if ( ref($_[0]) ) {
  81     $self = shift;
  82   } else {
  83     $self = { map { $_ => shift } qw(name type null length default local) };
  84   }
  85
  86   #croak "Illegal name: ". $self->{'name'}
  87   #  if grep $self->{'name'} eq $_, @reserved_words;
  88
  89   $self->{'null'} =~ s/^NOT NULL$//i;
  90   $self->{'null'} = 'NULL' if $self->{'null'};
  91
  92   bless ($self, $class);
  93
  94 }
  95
  96 =item name [ NAME ]
  97
  98 Returns or sets the column name.
  99
 100 =cut
 101
 102 sub name {
 103   my($self,$value)=@_;
 104   if ( defined($value) ) {
 105   #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
 106     $self->{'name'} = $value;
 107   } else {
 108     $self->{'name'};
 109   }
 110 }
 111
 112 =item type [ TYPE ]
 113
 114 Returns or sets the column type.
 115
 116 =cut
 117
 118 sub type {
 119   my($self,$value)=@_;
 120   if ( defined($value) ) {
 121     $self->{'type'} = $value;
 122   } else {
 123     $self->{'type'};
 124   }
 125 }
 126
 127 =item null [ NULL ]
 128
 129 Returns or sets the column null flag (the empty string is equivalent to
 130 `NOT NULL')
 131
 132 =cut
 133
 134 sub null {
 135   my($self,$value)=@_;
 136   if ( defined($value) ) {
 137     $value =~ s/^NOT NULL$//i;
 138     $value = 'NULL' if $value;
 139     $self->{'null'} = $value;
 140   } else {
 141     $self->{'null'};
 142   }
 143 }
 144
 145 =item length [ LENGTH ]
 146
 147 Returns or sets the column length.
 148
 149 =cut
 150
 151 sub length {
 152   my($self,$value)=@_;
 153   if ( defined($value) ) {
 154     $self->{'length'} = $value;
 155   } else {
 156     $self->{'length'};
 157   }
 158 }
 159
 160 =item default [ LOCAL ]
 161
 162 Returns or sets the default value.
 163
 164 =cut
 165
 166 sub default {
 167   my($self,$value)=@_;
 168   if ( defined($value) ) {
 169     $self->{'default'} = $value;
 170   } else {
 171     $self->{'default'};
 172   }
 173 }
 174
 175
 176 =item local [ LOCAL ]
 177
 178 Returns or sets the database-specific field.
 179
 180 =cut
 181
 182 sub local {
 183   my($self,$value)=@_;
 184   if ( defined($value) ) {
 185     $self->{'local'} = $value;
 186   } else {
 187     $self->{'local'};
 188   }
 189 }
 190
 191 =item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 192
 193 Returns an SQL column definition.
 194
 195 The data source can be specified by passing an open DBI database handle, or by
 196 passing the DBI data source name, username and password.
 197
 198 Although the username and password are optional, it is best to call this method
 199 with a database handle or data source including a valid username and password -
 200 a DBI connection will be opened and the quoting and type mapping will be more
 201 reliable.
 202
 203 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
 204 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
 205 Currently supported databases are MySQL and PostgreSQL.  Non-standard syntax
 206 for other engines (if applicable) may also be supported in the future.
 207
 208 =cut
 209
 210 sub line {
 211   my($self,$dbh) = (shift, shift);
 212
 213   my $created_dbh = 0;
 214   unless ( ref($dbh) || ! @_ ) {
 215     $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
 216     my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
 217     $created_dbh = 1;
 218   }
 219
 220   my $driver = DBIx::DBSchema::_load_driver($dbh);
 221   my %typemap;
 222   %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
 223   my $type = defined( $typemap{uc($self->type)} )
 224     ? $typemap{uc($self->type)}
 225     : $self->type;
 226
 227   my $null = $self->null;
 228
 229   my $default;
 230   if ( defined($self->default) && $self->default ne ''
 231        && ref($dbh)
 232        # false laziness: nicked from FS::Record::_quote
 233        && ( $self->default !~ /^\-?\d+(\.\d+)?$/
 234             || $type =~ /(char|binary|blob|text)$/i
 235           )
 236   ) {
 237     $default = $dbh->quote($self->default);
 238   } else {
 239     $default = $self->default;
 240   }
 241
 242   #this should be a callback into the driver
 243   if ( $driver eq 'mysql' ) { #yucky mysql hack
 244     $null ||= "NOT NULL";
 245     $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
 246   } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
 247     $null ||= "NOT NULL";
 248     $null =~ s/^NULL$//;
 249   }
 250
 251   my @r = join(' ',
 252     $self->name,
 253     $type.
 254       ( defined($self->length) && $self->length ? '('.$self->length.')' : '' ),
 255     $null,
 256     ( ( defined($default) && $default ne '' )
 257       ? 'DEFAULT '. $default
 258       : ''
 259     ),
 260     ( ( $driver eq 'mysql' )
 261       ? $self->local
 262       : ''
 263     ),
 264   );
 265   $dbh->disconnect if $created_dbh;
 266   @r;
 267
 268 }
 269
 270 =back
 271
 272 =head1 AUTHOR
 273
 274 Ivan Kohler <ivan-dbix-dbschema@420.am>
 275
 276 =head1 COPYRIGHT
 277
 278 Copyright (c) 2000 Ivan Kohler
 279 Copyright (c) 2000 Mail Abuse Prevention System LLC
 280 All rights reserved.
 281 This program is free software; you can redistribute it and/or modify it under
 282 the same terms as Perl itself.
 283
 284 =head1 BUGS
 285
 286 line() has database-specific foo that probably ought to be abstracted into
 287 the DBIx::DBSchema:DBD:: modules.
 288
 289 =head1 SEE ALSO
 290
 291 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 292
 293 =cut
 294
 295 1;
 296