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