view release on metacpan or  search on metacpan

SQLEngine/Driver.pm  view on Meta::CPAN

  my $Signal = \"Unique";
  
  sub new {
    my ( $package, $sth, $method, @args ) = @_;
    my $coderef = sub {
      unless ( $_[0] eq $Signal ) {
	$sth->$method( @args, @_ )
      } elsif ( $_[1] eq 'DESTROY' ) {
	$sth->finish() if $sth;
	warn "Fetchsub finish for $sth\n";
	$sth = undef;
      } elsif ( $_[1] eq 'handle' ) {
	return $sth;
      } else {
	Carp::croak( "Unsupported signal to fetchsub: '$_[1]'" );
      }
    };
    bless $coderef, $package;
  }
  
  sub handle {
    my $coderef = shift;
    &$coderef( $Signal => 'handle' )
  }
  
  sub DESTROY {
    my $coderef = shift;
    &$coderef( $Signal => 'DESTROY' )
  }
}

########################################################################

=head2 Retrieving Columns from a Statement

B<Internal Methods:>

=over 4

=item retrieve_columns()

  $sqldb->retrieve_columns ($sth) : $columnset

Obtains information about the columns used in the result set.

=item column_type_codes()

  $sqldb->column_type_codes - Standard::Global:hash

Maps the ODBC numeric constants used by DBI to the names we want to use for simplified internal representation.

=back

To Do: this should probably be using DBI's type_info methods.

=cut

# %@$columns = $self->retrieve_columns($sth)
  #!# 'pri_key' => $sth->is_pri_key->[$i], 
  # is_pri_key causes the driver to fail with the following fatal error:
  #    relocation error: symbol not found: mysql_columnSeek
  # or at least that happens in the version we last tested it with. -S.
  
sub retrieve_columns {
  my ($self, $sth) = @_;
  
  my $type_defs = $self->column_type_codes();
  my $names = $sth->{'NAME_lc'};

  my $types = eval { $sth->{'TYPE'} || [] };
  # warn "Types: " . join(', ', map "'$_'", @$types);
  my $type_codes = [ map { 
	my $typeinfo = scalar $self->type_info($_);
	# warn "Type $typeinfo";
	ref($typeinfo) ? scalar $typeinfo->{'DATA_TYPE'} : $typeinfo;
  } @$types ];
  my $sizes = eval { $sth->{PRECISION} || [] };
  my $nullable = eval { $sth->{'NULLABLE'} || [] };
  [
    map {
      my $type = $type_defs->{ $type_codes->[$_] || 0 } || $type_codes->[$_];
      $type ||= 'text';
      # warn "New col: $names->[$_] ($type / $types->[$_] / $type_codes->[$_])";
      
      {
	'name' => $names->[$_],
	'type' => $type,
	'required' => ! $nullable->[$_],
	( $type eq 'text' ? ( 'length' => $sizes->[$_] ) : () ),
	
      }
    } (0 .. $#$names)
  ];
}

use Class::MakeMethods ( 'Standard::Global:hash' => 'column_type_codes' );
use DBI ':sql_types';

# $code_to_name_hash = $self->determine_column_type_codes();
__PACKAGE__->column_type_codes(
  DBI::SQL_CHAR() => 'text',		# char
  DBI::SQL_VARCHAR() => 'text',		# varchar
  DBI::SQL_LONGVARCHAR() => 'text',	# 
  253			  => 'text', 	# MySQL varchar
  252			  => 'text', 	# MySQL blob
  
  DBI::SQL_NUMERIC() => 'float',	# numeric (?)
  DBI::SQL_DECIMAL() => 'float',	# decimal
  DBI::SQL_FLOAT() => 'float',		# float
  DBI::SQL_REAL() => 'float',		# real
  DBI::SQL_DOUBLE() => 'float',		# double
  
  DBI::SQL_INTEGER() => 'int',		# integer
  DBI::SQL_SMALLINT() => 'int',		# smallint
  -6		=> 'int',		# MySQL tinyint
  
  DBI::SQL_DATE() => 'time',		# date
  DBI::SQL_TIME() => 'time',		# time
  DBI::SQL_TIMESTAMP() => 'time',	# datetime
);