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->sql_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)=@_;
 212
 213   my $driver = DBIx::DBSchema::_load_driver($dbh);
 214   my %typemap;
 215   %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
 216   my $type = defined( $typemap{uc($self->type)} )
 217     ? $typemap{uc($self->type)}
 218     : $self->type;
 219
 220   my $null = $self->null;
 221
 222   my $default = $self->default;
 223   if ( defined($default) && default ne ''
 224        && ref($dbh)
 225        # false laziness: nicked from FS::Record::_quote
 226        && ( $default !~ /^\-?\d+(\.\d+)?$/
 227             || $type =~ /(char|binary|blob|text)$/i
 228           )
 229   ) {
 230     $default = $dbh->quote($self->default);
 231   } else {
 232     $default = $self->default;
 233   }
 234
 235   #this should be a callback into the driver
 236   if ( $driver eq 'mysql' ) { #yucky mysql hack
 237     $null ||= "NOT NULL"
 238   } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
 239     $null ||= "NOT NULL";
 240     $null =~ s/^NULL$//;
 241   }
 242
 243   join(' ',
 244     $self->name,
 245     $type. ( $self->length ? '('.$self->length.')' : '' ),
 246     $null,
 247     ( ( defined($default) && $default ne '' )
 248       ? 'DEFAULT '. $default
 249       : ''
 250     ),
 251     ( ( $driver eq 'mysql' )
 252       ? $self->local
 253       : ''
 254     ),
 255   );
 256
 257 }
 258
 259 =back
 260
 261 =head1 AUTHOR
 262
 263 Ivan Kohler <ivan-dbix-dbschema@420.am>
 264
 265 =head1 COPYRIGHT
 266
 267 Copyright (c) 2000 Ivan Kohler
 268 Copyright (c) 2000 Mail Abuse Prevention System LLC
 269 All rights reserved.
 270 This program is free software; you can redistribute it and/or modify it under
 271 the same terms as Perl itself.
 272
 273 =head1 BUGS
 274
 275 line() has database-specific foo that probably ought to be abstracted into
 276 the DBIx::DBSchema:DBD:: modules.
 277
 278 =head1 SEE ALSO
 279
 280 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>
 281
 282 =cut
 283
 284 1;
 285