package SPOPS::DBI::TypeInfo;
# $Id: TypeInfo.pm,v 1.6 2004/02/26 01:03:23 lachoy Exp $
use strict;
use base qw( Class::Accessor );
use DBI qw( :sql_types );
use Log::Log4perl qw( get_logger );
use SPOPS::Exception qw( spops_error );
use SPOPS::Exception::DBI qw( spops_dbi_error );
my @FIELDS = qw( table database );
__PACKAGE__->mk_accessors( @FIELDS );
my ( $log );
my %FAKE_TYPES = (
int => SQL_INTEGER,
num => SQL_NUMERIC,
float => SQL_FLOAT,
char => SQL_VARCHAR,
date => SQL_DATE,
);
########################################
# CONSTRUCTOR
sub new {
my ( $class, $params ) = @_;
my $self = bless( {}, $class );
# First assign the simple fields
foreach my $field ( @FIELDS ) {
next unless ( $params->{ $field } );
$self->$field( $params->{ $field } );
}
# Next assign parallel field/type arrays
if ( ref $params->{fields} eq 'ARRAY' and ref $params->{types} eq 'ARRAY' ) {
my $num_fields = scalar @{ $params->{fields} };
my $num_types = scalar @{ $params->{types} };
if ( $num_fields != $num_types ) {
spops_error "Incorrect parameters: number of fields ($num_fields) ",
"is not equal to the number of types ($num_types)";
}
$self->{_fields} = $params->{fields};
$self->{_types} = $params->{types};
for ( 0 .. $num_fields - 1 ) {
$self->add_type( $params->{fields}[ $_ ], $params->{types}[ $_ ] );
}
}
# Next assign a map of field -> type
if ( ref $params->{map} eq 'HASH' ) {
while ( my ( $field, $type ) = each %{ $params->{map} } ) {
$self->add_type( $field, $type );
}
}
return $self;
}
########################################
# GET/SET METHODS
sub add_type {
my ( $self, $field, $type ) = @_;
$log ||= get_logger();
# If it's already defined, issue a warning but don't change it
if ( my $existing_type = $self->get_type( $field ) ) {
$log->warn( "Field [$field] was already defined with type ",
"[$existing_type]. No action taken." );
return $existing_type;
}
# Check to see if it's a fake type (suppress warnings since this
# use of int() will issue a warning if it's 'char'/'date'/etc.,
# which is what we're checking for.
{
no warnings;
unless ( int( $type ) ) {
my $faked = $FAKE_TYPES{ $type };
unless ( $faked ) {
spops_error "Type [$type] for [$field] is invalid -- it is ",
"not a DBI type and not one of the 'fake' types, ",
"which are: ", join( ', ', sort keys %FAKE_TYPES );
}
$type = $faked;
}
}
# Assign
$self->{_map}{ lc $field } = int( $type );
push @{ $self->{_fields} }, $field;
push @{ $self->{_types} }, $type;
return $type;
}
sub get_type {
my ( $self, $field ) = @_;
return undef unless ( $field );
return $self->{_map}{ lc $field };
}
sub get_fields {
my ( $self ) = @_;
return @{ $self->{_fields} };
}
sub get_types {
my ( $self ) = @_;
return @{ $self->{_types} };
}
sub fetch_types {
my ( $self, $dbh, $sql ) = @_;
# Provide a default SQL implementation
unless ( $sql ) {
unless ( $self->table ) {
spops_error "Cannot retrieve fields and types from database: ",
"no SQL given to use, and the 'table' object ",
"property is not set.";
}
$sql = sprintf( "SELECT * FROM %s WHERE 1 = 0", $self->table );
}
my $sth = eval { $dbh->prepare( $sql ) };
if ( $@ ) {
spops_dbi_error $@, { sql => $sql, action => 'prepare' };
}
my $rv = eval { $sth->execute };
if ( $@ ) {
spops_dbi_error $@, { sql => $sql, action => 'execute' };
}
eval {
my $fields = $sth->{NAME};
my $types = $sth->{TYPE};
for ( my $i = 0; $i < scalar @{ $fields }; $i++ ) {
$self->add_type( $fields->[ $i ], $types->[ $i ] );
}
};
if ( $@ ) {
spops_error "Cannot retrieve name/type info for ",
$self->table, ": $@";
}
$sth->finish;
return $self;
}
sub as_hash {
my ( $self ) = @_;
my %h = ();
my $num_fields = scalar @{ $self->{_fields} };
for ( my $i = 0; $i < $num_fields; $i++ ) {
$h{ $self->{_fields}[ $i ] } = $self->{_types}[ $i ];
}
return %h;
}
1;
__END__
=head1 NAME
SPOPS::DBI::TypeInfo - Represent type information for a single table
=head1 SYNOPSIS
# Do everything at initialization with DBI types
my $type_info = SPOPS::DBI::TypeInfo->new({
database => 'foo',
table => 'cards',
fields => [ 'face', 'value', 'color' ],
types => [ SQL_VARCHAR, SQL_INTEGER, SQL_VARCHAR ] });
# Do everything at initialization with fake types
my $type_info = SPOPS::DBI::TypeInfo->new({
database => 'foo',
table => 'cards',
fields => [ 'face', 'value', 'color' ],
types => [ 'char', 'int', 'char' ] });
...
# Cycle through the fields and find the types
print "Information for ",
join( '.', $type_info->database, $type_info->table ), "\n";
foreach my $field ( $type_info->get_fields ) {
print "Field $field is type ", $type_info->get_type( $field ), "\n";
}
# Get the field/type information from the database
my $type_info = SPOPS::DBI::TypeInfo->new({ database => 'db',
table => 'MyTable' });
my $dbh = my_function_to_get_database_handle( ... );
my $sql = qq/ SELECT * FROM MyTable WHERE 1 = 0 /;
$type_info->fetch_types( $dbh, $sql );
print "Type of 'foo' is ", $type_info->get_type( 'foo' );
# Do the above at one time
my $dbh = my_function_to_get_database_handle( ... );
my $type_info = SPOPS::DBI::TypeInfo->new({ table => 'MyTable' })
->fetch_types( $dbh );
=head1 DESCRIPTION
This is a lightweight object to maintain state about a field names and
DBI types for a particular table in a particular database. It is
generally used by L<SPOPS::SQLInterface|SPOPS::SQLInterface>, but it
is sufficiently decoupled so you might find it useful elsewhere.
It is case-insensitive when finding the type to match a field, but
stores the fields in the case added or, if you use C<fetch_types()>,
the case the database reports.
=head2 Fake Types
This class supports a small number of 'fake' types as well so you do
not have to import the DBI constants. These are:
Fake DBI
====================
int -> SQL_INTEGER
num -> SQL_NUMERIC
float -> SQL_FLOAT
char -> SQL_VARCHAR
date -> SQL_DATE
More can be added as necessary, but these seemed to cover the
spectrum.
These fake types can be used anywhere you set a type for a field: in
the constructor, or in C<add_type()>. So the following do the same
thing:
$type_info->add_type( 'foo', SQL_NUMERIC );
$type_info->add_type( 'foo', 'num' );
=head1 METHODS
B<new( \%params )>
Create a new object. There are two types of parameters: the object
properties, and the fields and types to be used. The properties are
listed in L<PROPERTIES> -- just pass in a value for a property by its
name and it will be set.
You have two options for the field names and values.
=over 4
=item 1.
You can pass in parallel arrayrefs in C<fields> and C<types>.
=item 2.
You can pass a hashref of fields to values in C<map>.
=back
Example of parallel fields and types:
my $type_info = SPOPS::DBI::TypeInfo->new({
table => 'mytable',
fields => [ 'foo', 'bar', 'baz' ],
types => [ SQL_INTEGER, SQL_VARCHAR, SQL_TIMESTAMP ] });
Example of a map:
my $type_info = SPOPS::DBI::TypeInfo->new({
table => 'mytable',
map => { foo => SQL_INTEGER,
bar => SQL_VARCHAR,
baz => SQL_TIMESTAMP } });,
Returns: new object instance.
B<get_type( $field )>
Retrieves the DBI type for C<$field>. The case of C<$field> does not
matter, so the following will return the same value:
my $type = $type_info->get_type( 'first_name' );
my $type = $type_info->get_type( 'FIRST_NAME' );
my $type = $type_info->get_type( 'First_Name' );
Returns: the DBI type for C<$field>. If C<$field> is not registered
with this object, returns undef.
B<add_type( $field, $type )>
Adds the type C<$type> for field C<$field> to the object. As noted in
C<Fake Types>, the value for C<$type> may be a 'fake' type which will
then get mapped to a DBI type.
If a type for C<$field> has already been set, no action is taken but a
warning is issued.
Examples:
$type_info->add_type( 'first_name', SQL_VARCHAR ); # ok
$type_info->add_type( 'last_name', 'char' ); # ok
$type_info->add_type( 'birthdate', SQL_DATE ); # ok
$type_info->add_type( 'BIRTHDATE', SQL_DATE ); # results in warning
$type_info->add_type( 'FIRST_NAME', SQL_INTEGER ); # results in warning
Returns: type set for C<$field>
B<fetch_types( $dbh, [ $sql ] )>
Retrieve fields and types from the database, given the database handle
C<$dbh> and the SQL C<$sql>. If C<$sql> is not provided we try to use
a common one:
SELECT * FROM $self->table WHERE 1 = 0
If the C<table> property is not set and no C<$sql> is passed in the
method throws an exception.
Any failures to prepare/execute the query result in a thrown
L<SPOPS::Exception::DBI|SPOPS::Exception::DBI> object.
The object will store the fields as the database returns them, so a
call to C<get_fields()> may return the fields in an unknown
order/case. (Getting the type via C<get_type()> will still work,
however.)
Returns: the object, which allows method chaining as a shortcut.
B<get_fields()>
Returns a list of fields currently registered with this object. They
are returned in the order they were added.
Example:
print "Fields in type info object: ", join( ", ", $type_info->get_fields );
B<get_types()>
Returns a list of types currently registered with this object. They
are returned in the order they were added.
Example:
print "Types in type info object: ", join( ", ", $type_info->get_types );
B<as_hash()>
Returns the fields and types as a simple hash. The case of the field
should be the same as it was specified or retrieved from the database.
Example:
my %type_map = $type_info->as_hash;
foreach my $field ( keys %type_map ) {
print "Field $field is type $type_map{ $field }\n";
}
=head1 PROPERTIES
All properties are get and set with the same name.
B<database>
Name of the database this object is representing. (Optional, may be
empty.)
Example:
$type_info->database( "production" );
print "Database for metadata: ", $type_info->database(), "\n";
B<table>
Name of the table this object is representing. This is optional unless
you call C<fetch_types()> without a second argument (C<$sql>), since
the object will try to create default SQL to find fieldnames and types
by using the table name.
Example:
$type_info->table( "customers" );
print "Table for metadata: ", $type_info->table(), "\n";
=head1 AUTHORS
Chris Winters E<lt>chris@cwinters.comE<gt>
Thanks to Ray Zimmerman E<lt>rz10@cornell.eduE<gt> for pointing out
the need for this module's functionality.