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   $column = new DBIx::DBSchema::Column ( $name, $sql_type, '' );
  20   $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL' );
  21   $column = new DBIx::DBSchema::Column ( $name, $sql_type, '', $length );
  22   $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length );
  23
  24   #named params with a hashref (preferred)
  25   $column = new DBIx::DBSchema::Column ( {
  26     'name'    => 'column_name',
  27     'type'    => 'varchar'
  28     'null'    => 'NOT NULL',
  29     'length'  => 64,
  30     'default' => '
  31     'local'   => '',
  32   } );
  33
  34   #list
  35   $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );
  36
  37
  38   $name = $column->name;
  39   $column->name( 'name' );
  40
  41   $sql_type = $column->type;
  42   $column->sql_type( 'sql_type' );
  43
  44   $null = $column->null;
  45   $column->null( 'NULL' );
  46   $column->null( 'NOT NULL' );
  47   $column->null( '' );
  48
  49   $length = $column->length;
  50   $column->length( '10' );
  51   $column->length( '8,2' );
  52
  53   $default = $column->default;
  54   $column->default( 'Roo' );
  55
  56   $sql_line = $column->line;
  57   $sql_line = $column->line($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 line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]
 198
 199 Returns an SQL column definition.
 200
 201 The data source can be specified by passing an open DBI database handle, or by
 202 passing the DBI data source name, username and password.
 203
 204 Although the username and password are optional, it is best to call this method
 205 with a database handle or data source including a valid username and password -
 206 a DBI connection will be opened and the quoting and type mapping will be more
 207 reliable.
 208
 209 If passed a DBI data source (or handle) such as `DBI:mysql:database' or
 210 `DBI:Pg:dbname=database', will use syntax specific to that database engine.
 211 Currently supported databases are MySQL and PostgreSQL.  Non-standard syntax
 212 for other engines (if applicable) may also be supported in the future.
 213
 214 =cut
 215
 216 sub line {
 217   my($self,$dbh)=@_;
 218
 219   my $driver = DBIx::DBSchema::_load_driver($dbh);
 220   my %typemap;
 221   %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
 222   my $type = defined( $typemap{uc($self->type)} )
 223     ? $typemap{uc($self->type)}
 224     : $self->type;
 225
 226   my $null = $self->null;
 227
 228   my $default = $self->default;
 229   if ( defined($default) && default ne ''
 230        && ref($dbh)
 231        # false laziness: nicked from FS::Record::_quote
 232        && ( $default !~ /^\-?\d+(\.\d+)?$/
 233             || $type =~ /(char|binary|blob|text)$/i
 234           )
 235   ) {
 236     $default = $dbh->quote($self->default);
 237   } else {
 238     $default = $self->default;
 239   }
 240
 241   #this should be a callback into the driver
 242   if ( $driver eq 'mysql' ) { #yucky mysql hack
 243     $null ||= "NOT NULL"
 244   } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
 245     $null ||= "NOT NULL";
 246     $null =~ s/^NULL$//;
 247   }
 248
 249   join(' ',
 250     $self->name,
 251     $type. ( $self->length ? '('.$self->length.')' : '' ),
 252     $null,
 253     ( ( defined($default) && $default ne '' )
 254       ? 'DEFAULT '. $default
 255       : ''
 256     ),
 257     ( ( $driver eq 'mysql' )
 258       ? $self->local
 259       : ''
 260     ),
 261   );
 262
 263 }
 264
 265 =back
 266
 267 =head1 AUTHOR
 268
 269 Ivan Kohler <ivan-dbix-dbschema@420.am>
 270
 271 =head1 COPYRIGHT
 272
 273 Copyright (c) 2000 Ivan Kohler
 274 Copyright (c) 2000 Mail Abuse Prevention System LLC
 275 All rights reserved.
 276 This program is free software; you can redistribute it and/or modify it under
 277 the same terms as Perl itself.
 278
 279 =head1 BUGS
 280
 281 line() has database-specific foo that probably ought to be abstracted into
 282 the DBIx::DBSchema:DBD:: modules.
 283
 284 =head1 SEE ALSO
 285
 286 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 287
 288 =cut
 289
 290 1;
 291