freeside/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema ColGroup.pm,NONE,1.1.2.1 Column.pm,NONE,1.1.2.1 DBD.pm,NONE,1.1.2.1 Table.pm,NONE,1.1.2.1
ivan
ivan at pouncequick.420.am
Thu Apr 29 02:46:46 PDT 2004
Update of /home/cvs/cvsroot/freeside/install/5.005/DBIx-DBSchema-0.23-5.005kludge/DBSchema
In directory pouncequick:/tmp/cvs-serv12000/DBSchema
Added Files:
Tag: FREESIDE_1_4_BRANCH
ColGroup.pm Column.pm DBD.pm Table.pm
Log Message:
yet more...
--- 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