freeside/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema ColGroup.pm,NONE,1.1 Column.pm,NONE,1.1 DBD.pm,NONE,1.1 Table.pm,NONE,1.1

ivan ivan at pouncequick.420.am
Thu Apr 29 02:23:34 PDT 2004


Update of /home/cvs/cvsroot/freeside/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema
In directory pouncequick:/tmp/cvs-serv10994

Added Files:
	ColGroup.pm Column.pm DBD.pm Table.pm 
Log Message:
adding DBD::Pg and DBIx::DBSchema for 5.005.  argh freebsd and solaris!

--- NEW FILE: Table.pm ---
package DBIx::DBSchema::Table;

use strict;
use vars qw(@ISA %create_params);
#use Carp;
#use Exporter;
use DBIx::DBSchema::Column 0.02;
use DBIx::DBSchema::ColGroup::Unique;
use DBIx::DBSchema::ColGroup::Index;

#@ISA = qw(Exporter);
@ISA = qw();

=head1 NAME

DBIx::DBSchema::Table - Table objects

=head1 SYNOPSIS

  use DBIx::DBSchema::Table;

  #old style (depriciated)
  $table = new DBIx::DBSchema::Table (
    "table_name",
    "primary_key",
    $dbix_dbschema_colgroup_unique_object,
    $dbix_dbschema_colgroup_index_object,
    @dbix_dbschema_column_objects,
  );

  #new style (preferred), pass a hashref of parameters
  $table = new DBIx::DBSchema::Table (
    {
      name        => "table_name",
      primary_key => "primary_key",
      unique      => $dbix_dbschema_colgroup_unique_object,
      'index'     => $dbix_dbschema_colgroup_index_object,
      columns     => \@dbix_dbschema_column_objects,
    }
  );

  $table->addcolumn ( $dbix_dbschema_column_object );

  $table_name = $table->name;
  $table->name("table_name");

  $primary_key = $table->primary_key;
  $table->primary_key("primary_key");

  $dbix_dbschema_colgroup_unique_object = $table->unique;
  $table->unique( $dbix_dbschema__colgroup_unique_object );

  $dbix_dbschema_colgroup_index_object = $table->index;
  $table->index( $dbix_dbschema_colgroup_index_object );

  @column_names = $table->columns;

  $dbix_dbschema_column_object = $table->column("column");

  #preferred
  @sql_statements = $table->sql_create_table( $dbh );
  @sql_statements = $table->sql_create_table( $datasrc, $username, $password );

  #possible problems
  @sql_statements = $table->sql_create_table( $datasrc );
  @sql_statements = $table->sql_create_table;

=head1 DESCRIPTION

DBIx::DBSchema::Table objects represent a single database table.

=head1 METHODS

=over 4

=item new [ TABLE_NAME [ , PRIMARY_KEY [ , UNIQUE [ , INDEX [ , COLUMN... ] ] ] ] ]

=item new HASHREF

Creates a new DBIx::DBSchema::Table object.  The preferred usage is to pass a
hash reference of named parameters.

  {
    name        => TABLE_NAME,
    primary_key => PRIMARY_KEY,
    unique      => UNIQUE,
    'index'     => INDEX,
    columns     => COLUMNS
  }

TABLE_NAME is the name of the table.  PRIMARY_KEY is the primary key (may be
empty).  UNIQUE is a DBIx::DBSchema::ColGroup::Unique object (see
L<DBIx::DBSchema::ColGroup::Unique>).  INDEX is a
DBIx::DBSchema::ColGroup::Index object (see
L<DBIx::DBSchema::ColGroup::Index>).  COLUMNS is a reference to an array of
DBIx::DBSchema::Column objects (see L<DBIx::DBSchema::Column>).

=cut

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  my $self;
  if ( ref($_[0]) ) {

    $self = shift;
    $self->{column_order} = [ map { $_->name } @{$self->{columns}} ];
    $self->{columns} = { map { $_->name, $_ } @{$self->{columns}} };

  } else {

    my($name,$primary_key,$unique,$index, at columns) = @_;

    my %columns = map { $_->name, $_ } @columns;
    my @column_order = map { $_->name } @columns;

    $self = {
      'name'         => $name,
      'primary_key'  => $primary_key,
      'unique'       => $unique,
      'index'        => $index,
      'columns'      => \%columns,
      'column_order' => \@column_order,
    };

  }

  #check $primary_key, $unique and $index to make sure they are $columns ?
  # (and sanity check?)

  bless ($self, $class);

}

=item new_odbc DATABASE_HANDLE TABLE_NAME

Creates a new DBIx::DBSchema::Table object from the supplied DBI database
handle for the specified table.  This uses the experimental DBI type_info
method to create a table with standard (ODBC) SQL column types that most
closely correspond to any non-portable column types.   Use this to import a
schema that you wish to use with many different database engines.  Although
primary key and (unique) index information will only be imported from databases
with DBIx::DBSchema::DBD drivers (currently MySQL and PostgreSQL), import of
column names and attributes *should* work for any database.

Note: the _odbc refers to the column types used and nothing else - you do not
have to have ODBC installed or connect to the database via ODBC.

=cut

%create_params = (
#  undef             => sub { '' },
  ''                => sub { '' },
  'max length'      => sub { $_[0]->{PRECISION}->[$_[1]]; },
  'precision,scale' =>
    sub { $_[0]->{PRECISION}->[$_[1]]. ','. $_[0]->{SCALE}->[$_[1]]; }
);

sub new_odbc {
  my( $proto, $dbh, $name) = @_;
  my $driver = DBIx::DBSchema::_load_driver($dbh);
  my $sth = _null_sth($dbh, $name);
  my $sthpos = 0;
  $proto->new (
    $name,
    scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
    DBIx::DBSchema::ColGroup::Unique->new(
      $driver
       ? [values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"}]
       : []
    ),
    DBIx::DBSchema::ColGroup::Index->new(
      $driver
      ? [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
      : []
    ),
    map { 
      my $type_info = scalar($dbh->type_info($sth->{TYPE}->[$sthpos]))
        or die "DBI::type_info ". $dbh->{Driver}->{Name}. " driver ".
               "returned no results for type ".  $sth->{TYPE}->[$sthpos];
      new DBIx::DBSchema::Column
          $_,
          $type_info->{'TYPE_NAME'},
          #"SQL_". uc($type_info->{'TYPE_NAME'}),
          $sth->{NULLABLE}->[$sthpos],
          &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ),          $driver && #default
            ${ [
              eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
            ] }[4]
          # DB-local
    } @{$sth->{NAME}}
  );
}

=item new_native DATABASE_HANDLE TABLE_NAME

Creates a new DBIx::DBSchema::Table object from the supplied DBI database
handle for the specified table.  This uses database-native methods to read the
schema, and will preserve any non-portable column types.  The method is only
available if there is a DBIx::DBSchema::DBD for the corresponding database
engine (currently, MySQL and PostgreSQL).

=cut

sub new_native {
  my( $proto, $dbh, $name) = @_;
  my $driver = DBIx::DBSchema::_load_driver($dbh);
  $proto->new (
    $name,
    scalar(eval "DBIx::DBSchema::DBD::$driver->primary_key(\$dbh, \$name)"),
    DBIx::DBSchema::ColGroup::Unique->new(
      [ values %{eval "DBIx::DBSchema::DBD::$driver->unique(\$dbh, \$name)"} ]
    ),
    DBIx::DBSchema::ColGroup::Index->new(
      [ values %{eval "DBIx::DBSchema::DBD::$driver->index(\$dbh, \$name)"} ]
    ),
    map {
      DBIx::DBSchema::Column->new( @{$_} )
    } eval "DBIx::DBSchema::DBD::$driver->columns(\$dbh, \$name)"
  );
}

=item addcolumn COLUMN

Adds this DBIx::DBSchema::Column object. 

=cut

sub addcolumn {
  my($self,$column)=@_;
  ${$self->{'columns'}}{$column->name}=$column; #sanity check?
  push @{$self->{'column_order'}}, $column->name;
}

=item delcolumn COLUMN_NAME

Deletes this column.  Returns false if no column of this name was found to
remove, true otherwise.

=cut

sub delcolumn {
  my($self,$column) = @_;
  return 0 unless exists $self->{'columns'}{$column};
  delete $self->{'columns'}{$column};
  @{$self->{'column_order'}}= grep { $_ ne $column } @{$self->{'column_order'}};  1;
}

=item name [ TABLE_NAME ]

Returns or sets the table name.

=cut

sub name {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{name} = $value;
  } else {
    $self->{name};
  }
}

=item primary_key [ PRIMARY_KEY ]

Returns or sets the primary key.

=cut

sub primary_key {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{primary_key} = $value;
  } else {
    #$self->{primary_key};
    #hmm.  maybe should untaint the entire structure when it comes off disk 
    # cause if you don't trust that, ?
    $self->{primary_key} =~ /^(\w*)$/ 
      #aah!
      or die "Illegal primary key: ", $self->{primary_key};
    $1;
  }
}

=item unique [ UNIQUE ]

Returns or sets the DBIx::DBSchema::ColGroup::Unique object.

=cut

sub unique { 
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{unique} = $value;
  } else {
    $self->{unique};
  }
}

=item index [ INDEX ]

Returns or sets the DBIx::DBSchema::ColGroup::Index object.

=cut

sub index { 
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'index'} = $value;
  } else {
    $self->{'index'};
  }
}

=item columns

Returns a list consisting of the names of all columns.

=cut

sub columns {
  my($self)=@_;
  #keys %{$self->{'columns'}};
  #must preserve order
  @{ $self->{'column_order'} };
}

=item column COLUMN_NAME

Returns the column object (see L<DBIx::DBSchema::Column>) for the specified
COLUMN_NAME.

=cut

sub column {
  my($self,$column)=@_;
  $self->{'columns'}->{$column};
}

=item sql_create_table [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]

Returns a list of SQL statments to create this table.

The data source can be specified by passing an open DBI database handle, or by
passing the DBI data source name, username and password.  

Although the username and password are optional, it is best to call this method
with a database handle or data source including a valid username and password -
a DBI connection will be opened and the quoting and type mapping will be more
reliable.

If passed a DBI data source (or handle) such as `DBI:mysql:database', will use
MySQL- or PostgreSQL-specific syntax.  Non-standard syntax for other engines
(if applicable) may also be supported in the future.

=cut

sub sql_create_table { 
  my($self, $dbh) = (shift, shift);

  my $created_dbh = 0;
  unless ( ref($dbh) || ! @_ ) {
    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
    $created_dbh = 1;
  }
  #false laziness: nicked from DBSchema::_load_driver
  my $driver;
  if ( ref($dbh) ) {
    $driver = $dbh->{Driver}->{Name};
  } else {
    my $discard = $dbh;
    $discard =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
                        or '' =~ /()/; # ensure $1 etc are empty if match fails
    $driver = $1 or die "can't parse data source: $dbh";
  }
  #eofalse

#should be in the DBD somehwere :/
#  my $saved_pkey = '';
#  if ( $driver eq 'Pg' && $self->primary_key ) {
#    my $pcolumn = $self->column( (
#      grep { $self->column($_)->name eq $self->primary_key } $self->columns
#    )[0] );
##AUTO-INCREMENT#    $pcolumn->type('serial') if lc($pcolumn->type) eq 'integer';
#    $pcolumn->local( $pcolumn->local. ' PRIMARY KEY' );
#    #my $saved_pkey = $self->primary_key;
#    #$self->primary_key('');
#    #change it back afterwords :/
#  }

  my @columns = map { $self->column($_)->line($dbh) } $self->columns;

  push @columns, "PRIMARY KEY (". $self->primary_key. ")"
    #if $self->primary_key && $driver ne 'Pg';
    if $self->primary_key;

  my $indexnum = 1;

  my @r = (
    "CREATE TABLE ". $self->name. " (\n  ". join(",\n  ", @columns). "\n)\n"
  );

  push @r, map {
                 #my($index) = $self->name. "__". $_ . "_idx";
                 #$index =~ s/,\s*/_/g;
                 my $index = $self->name. $indexnum++;
                 "CREATE UNIQUE INDEX $index ON ". $self->name. " ($_)\n"
               } $self->unique->sql_list
    if $self->unique;

  push @r, map {
                 #my($index) = $self->name. "__". $_ . "_idx";
                 #$index =~ s/,\s*/_/g;
                 my $index = $self->name. $indexnum++;
                 "CREATE INDEX $index ON ". $self->name. " ($_)\n"
               } $self->index->sql_list
    if $self->index;

  #$self->primary_key($saved_pkey) if $saved_pkey;
  $dbh->disconnect if $created_dbh;
  @r;
}

#

sub _null_sth {
  my($dbh, $table) = @_;
  my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0")
    or die $dbh->errstr;
  $sth->execute or die $sth->errstr;
  $sth;
}

=back

=head1 AUTHOR

Ivan Kohler <ivan-dbix-dbschema at 420.am>

Thanks to Mark Ethan Trostler <mark at zzo.com> for a patch to allow tables
with no indices.

=head1 COPYRIGHT

Copyright (c) 2000 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 BUGS

sql_create_table() has database-specific foo that probably ought to be
abstracted into the DBIx::DBSchema::DBD:: modules.

sql_create_table may change or destroy the object's data.  If you need to use
the object after sql_create_table, make a copy beforehand.

Some of the logic in new_odbc might be better abstracted into Column.pm etc.

=head1 SEE ALSO

L<DBIx::DBSchema>, L<DBIx::DBSchema::ColGroup::Unique>,
L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema::Column>, L<DBI>

=cut

1;


--- NEW FILE: ColGroup.pm ---
package DBIx::DBSchema::ColGroup;

use strict;
use vars qw(@ISA);
#use Exporter;

#@ISA = qw(Exporter);
@ISA = qw();

=head1 NAME

DBIx::DBSchema::ColGroup - Column group objects

=head1 SYNOPSIS

  use DBIx::DBSchema::ColGroup;

  $colgroup = new DBIx::DBSchema::ColGroup ( $lol_ref );
  $colgroup = new DBIx::DBSchema::ColGroup ( \@lol );
  $colgroup = new DBIx::DBSchema::ColGroup (
    [
      [ 'single_column' ],
      [ 'multiple_columns', 'another_column', ],
    ]
  );

  $lol_ref = $colgroup->lol_ref;

  @sql_lists = $colgroup->sql_list;

  @singles = $colgroup->singles;

=head1 DESCRIPTION

DBIx::DBSchema::ColGroup objects represent sets of sets of columns.  (IOW a
"list of lists" - see L<perllol>.)

=head1 METHODS

=over 4

=item new [ LOL_REF ]

Creates a new DBIx::DBSchema::ColGroup object.  Pass a reference to a list of
lists of column names.

=cut

sub new {
  my($proto, $lol) = @_;

  my $class = ref($proto) || $proto;
  my $self = {
    'lol' => $lol,
  };

  bless ($self, $class);

}

=item lol_ref

Returns a reference to a list of lists of column names.

=cut

sub lol_ref {
  my($self) = @_;
  $self->{'lol'};
}

=item sql_list

Returns a flat list of comma-separated values, for SQL statements.

For example:

  @lol = (
           [ 'single_column' ],
           [ 'multiple_columns', 'another_column', ],
         );

  $colgroup = new DBIx::DBSchema::ColGroup ( \@lol );

  print join("\n", $colgroup->sql_list), "\n";

Will print:

  single_column
  multiple_columns, another_column

=cut

sub sql_list { #returns a flat list of comman-separates lists (for sql)
  my($self)=@_;
   grep $_ ne '', map join(', ', @{$_}), @{$self->{'lol'}};
}

=item singles

Returns a flat list of all single item lists.

=cut

sub singles { #returns single-field groups as a flat list
  my($self)=@_;
  #map ${$_}[0], grep scalar(@{$_}) == 1, @{$self->{'lol'}};
  map { 
    ${$_}[0] =~ /^(\w+)$/
      #aah!
      or die "Illegal column ", ${$_}[0], " in colgroup!";
    $1;
  } grep scalar(@{$_}) == 1, @{$self->{'lol'}};
}

=back

=head1 AUTHOR

Ivan Kohler <ivan-dbix-dbschema at 420.am>

=head1 COPYRIGHT

Copyright (c) 2000 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 BUGS

=head1 SEE ALSO

L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup::Unique>,
L<DBIx::DBSchema::ColGroup::Index>, L<DBIx::DBSchema>, L<perllol>, L<perldsc>,
L<DBI>

=cut

1;


--- NEW FILE: DBD.pm ---
package DBIx::DBSchema::DBD;

use strict;
use vars qw($VERSION);

$VERSION = '0.02';

=head1 NAME

DBIx::DBSchema::DBD - DBIx::DBSchema Driver Writer's Guide and Base Class

=head1 SYNOPSIS

  perldoc DBIx::DBSchema::DBD

  package DBIx::DBSchema::DBD::FooBase
  use DBIx::DBSchmea::DBD;
  @ISA = qw(DBIx::DBSchema::DBD);

=head1 DESCRIPTION

Drivers should be named DBIx::DBSchema::DBD::DatabaseName, where DatabaseName
is the same as the DBD:: driver for this database.  Drivers should implement the
following class methods:

=over 4

=item columns CLASS DBI_DBH TABLE

Given an active DBI database handle, return a listref of listrefs (see
L<perllol>), each containing six elements: column name, column type,
nullability, column length, column default, and a field reserved for
driver-specific use.

=item column CLASS DBI_DBH TABLE COLUMN

Same as B<columns> above, except return the listref for a single column.  You
can inherit from DBIx::DBSchema::DBD to provide this function.

=cut

sub column {
  my($proto, $dbh, $table, $column) = @_;
  #@a = grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) };
  #$a[0];
  @{ [
    grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) }
  ] }[0]; #force list context on grep, return scalar of first element
}

=item primary_key CLASS DBI_DBH TABLE

Given an active DBI database handle, return the primary key for the specified
table.

=item unique CLASS DBI_DBH TABLE

Given an active DBI database handle, return a hashref of unique indices.  The
keys of the hashref are index names, and the values are arrayrefs which point
a list of column names for each.  See L<perldsc/"HASHES OF LISTS"> and
L<DBIx::DBSchema::ColGroup>.

=item index CLASS DBI_DBH TABLE

Given an active DBI database handle, return a hashref of (non-unique) indices.
The keys of the hashref are index names, and the values are arrayrefs which
point a list of column names for each.  See L<perldsc/"HASHES OF LISTS"> and
L<DBIx::DBSchema::ColGroup>.

=back

=head1 TYPE MAPPING

You can define a %typemap array for your driver to map "standard" data    
types to database-specific types.  For example, the MySQL TIMESTAMP field
has non-standard auto-updating semantics; the MySQL DATETIME type is 
what other databases and the ODBC standard call TIMESTAMP, so one of the   
entries in the MySQL %typemap is:

  'TIMESTAMP' => 'DATETIME',

Another example is the Pg %typemap which maps the standard types BLOB and
LONG VARBINARY to the Pg-specific BYTEA:

  'BLOB' => 'BYTEA',
  'LONG VARBINARY' => 'BYTEA',

Make sure you use all uppercase-keys.

=head1 AUTHOR

Ivan Kohler <ivan-dbix-dbschema at 420.am>

=head1 COPYRIGHT

Copyright (c) 2000 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 BUGS

=head1 SEE ALSO

L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>,
L<DBIx::DBSchema::ColGroup>, L<DBI>, L<DBI::DBD>, L<perllol>,
L<perldsc/"HASHES OF LISTS">

=cut 

1;


--- NEW FILE: Column.pm ---
package DBIx::DBSchema::Column;

use strict;
use vars qw(@ISA $VERSION);
#use Carp;
#use Exporter;

#@ISA = qw(Exporter);
@ISA = qw();

$VERSION = '0.02';

=head1 NAME

DBIx::DBSchema::Column - Column objects

=head1 SYNOPSIS

  use DBIx::DBSchema::Column;

  #named params with a hashref (preferred)
  $column = new DBIx::DBSchema::Column ( {
    'name'    => 'column_name',
    'type'    => 'varchar'
    'null'    => 'NOT NULL',
    'length'  => 64,
    'default' => '
    'local'   => '',
  } );

  #list
  $column = new DBIx::DBSchema::Column ( $name, $sql_type, $nullability, $length, $default, $local );

  $name = $column->name;
  $column->name( 'name' );

  $sql_type = $column->type;
  $column->type( 'sql_type' );

  $null = $column->null;
  $column->null( 'NULL' );
  $column->null( 'NOT NULL' );
  $column->null( '' );

  $length = $column->length;
  $column->length( '10' );
  $column->length( '8,2' );

  $default = $column->default;
  $column->default( 'Roo' );

  $sql_line = $column->line;
  $sql_line = $column->line($datasrc);

=head1 DESCRIPTION

DBIx::DBSchema::Column objects represent columns in tables (see
L<DBIx::DBSchema::Table>).

=head1 METHODS

=over 4

=item new HASHREF

=item new [ name [ , type [ , null [ , length  [ , default [ , local ] ] ] ] ] ]

Creates a new DBIx::DBSchema::Column object.  Takes a hashref of named
parameters, or a list.  B<name> is the name of the column.  B<type> is the SQL
data type.  B<null> is the nullability of the column (intrepreted using Perl's
rules for truth, with one exception: `NOT NULL' is false).  B<length> is the
SQL length of the column.  B<default> is the default value of the column.
B<local> is reserved for database-specific information.

=cut

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  my $self;
  if ( ref($_[0]) ) {
    $self = shift;
  } else {
    $self = { map { $_ => shift } qw(name type null length default local) };
  }

  #croak "Illegal name: ". $self->{'name'}
  #  if grep $self->{'name'} eq $_, @reserved_words;

  $self->{'null'} =~ s/^NOT NULL$//i;
  $self->{'null'} = 'NULL' if $self->{'null'};

  bless ($self, $class);

}

=item name [ NAME ]

Returns or sets the column name.

=cut

sub name {
  my($self,$value)=@_;
  if ( defined($value) ) {
  #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
    $self->{'name'} = $value;
  } else {
    $self->{'name'};
  }
}

=item type [ TYPE ]

Returns or sets the column type.

=cut

sub type {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'type'} = $value;
  } else {
    $self->{'type'};
  }
}

=item null [ NULL ]

Returns or sets the column null flag (the empty string is equivalent to
`NOT NULL')

=cut

sub null {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $value =~ s/^NOT NULL$//i;
    $value = 'NULL' if $value;
    $self->{'null'} = $value;
  } else {
    $self->{'null'};
  }
}

=item length [ LENGTH ]

Returns or sets the column length.

=cut

sub length {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'length'} = $value;
  } else {
    $self->{'length'};
  }
}

=item default [ LOCAL ]

Returns or sets the default value.

=cut

sub default {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'default'} = $value;
  } else {
    $self->{'default'};
  }
}


=item local [ LOCAL ]

Returns or sets the database-specific field.

=cut

sub local {
  my($self,$value)=@_;
  if ( defined($value) ) {
    $self->{'local'} = $value;
  } else {
    $self->{'local'};
  }
}

=item line [ DATABASE_HANDLE | DATA_SOURCE [ USERNAME PASSWORD [ ATTR ] ] ]

Returns an SQL column definition.

The data source can be specified by passing an open DBI database handle, or by
passing the DBI data source name, username and password.  

Although the username and password are optional, it is best to call this method
with a database handle or data source including a valid username and password -
a DBI connection will be opened and the quoting and type mapping will be more
reliable.

If passed a DBI data source (or handle) such as `DBI:mysql:database' or
`DBI:Pg:dbname=database', will use syntax specific to that database engine.
Currently supported databases are MySQL and PostgreSQL.  Non-standard syntax
for other engines (if applicable) may also be supported in the future.

=cut

sub line {
  my($self,$dbh) = (shift, shift);

  my $created_dbh = 0;
  unless ( ref($dbh) || ! @_ ) {
    $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
    $created_dbh = 1;
  }
  
  my $driver = DBIx::DBSchema::_load_driver($dbh);
  my %typemap;
  %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap" if $driver;
  my $type = defined( $typemap{uc($self->type)} )
    ? $typemap{uc($self->type)}
    : $self->type;

  my $null = $self->null;

  my $default;
  if ( defined($self->default) && $self->default ne ''
       && ref($dbh)
       # false laziness: nicked from FS::Record::_quote
       && ( $self->default !~ /^\-?\d+(\.\d+)?$/
            || $type =~ /(char|binary|blob|text)$/i
          )
  ) {
    $default = $dbh->quote($self->default);
  } else {
    $default = $self->default;
  }

  #this should be a callback into the driver
  if ( $driver eq 'mysql' ) { #yucky mysql hack
    $null ||= "NOT NULL";
    $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
  } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
    $null ||= "NOT NULL";
    $null =~ s/^NULL$//;
  }

  my $r = join(' ',
    $self->name,
    $type. ( ( defined($self->length) && $self->length )
             ? '('.$self->length.')'
             : ''
           ),
    $null,
    ( ( defined($default) && $default ne '' )
      ? 'DEFAULT '. $default
      : ''
    ),
    ( ( $driver eq 'mysql' && defined($self->local) )
      ? $self->local
      : ''
    ),
  );
  $dbh->disconnect if $created_dbh;
  $r;

}

=back

=head1 AUTHOR

Ivan Kohler <ivan-dbix-dbschema at 420.am>

=head1 COPYRIGHT

Copyright (c) 2000 Ivan Kohler
Copyright (c) 2000 Mail Abuse Prevention System LLC
All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 BUGS

line() has database-specific foo that probably ought to be abstracted into
the DBIx::DBSchema:DBD:: modules.

=head1 SEE ALSO

L<DBIx::DBSchema::Table>, L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>

=cut

1;





More information about the freeside-commits mailing list