FW: [PATCH] Class::DBI with case sensitive columns

Cross posted from cDBI mailing list:

-----Original Message-----
From: Ivor Williams 
Sent: 03 March 2005 13:59
To: [email protected]
Subject: Re: [PATCH] using Class::DBI with Sybase

> On Mon, 21 Feb 2005 19:01:50 +0000, Tony Bowden wrote:

>> I'm not likely to apply either as they currently stand.
>> 
>> Mainly this is because they don't seem like the right thing, but this
>> may be in part because there's no test case that shows what's going on.
>> 
>> Even a little more explanation would be helpful.

> I agree that posting a patch was a tad premature.

> The purpose of the post(s) is to let people know that I am working on getting 
> Class::DBI to work with Sybase. 

> When I have everything working completely, I will include a test case.

Here comes: 

test case for Sybase or MSSQL (which both have case sensitive column names)

test.sql==============================================
create table TEST
(
  Nurgle  integer,
  fooBar  varchar(20),
  Foobar  varchar(20)
)

create unique index dongle on TEST (Nurgle)

insert into TEST (Nurgle,fooBar,Foobar)
values (1, 'Dingbat', 'Blurch')

test.pl===============================================
#!/usr/local/bin/perl

use warnings;

package Test::DBI;
use strict;
use base 'Class::DBI::Sybase';

$Class::DBI::Column::FetchHashKeyName = "NAME";

__PACKAGE__->connection('dbi:Sybase:server=SYBSRV;database=TST2','tst2','tst2', {
        RaiseError => 1,
        FetchHashKeyName => 'NAME',
        } );

__PACKAGE__->set_up_table('TEST');

package main;
use strict;


my $foo = Test::DBI->search( Nurgle => 1);
my $fobj = $foo->next;


for (qw/nurgle fooBar Foobar/) {
        print $fobj->$_,"\n";
}

======================================================

Try running this and you get the following result:

ct_result(ct_dynamic(CS_PREPARE)) returned -205 at /home/williami/lib/sun4-solaris/DBD/Sybase.pm line 133.
DBD::Sybase::db prepare_cached failed: Server message number=207 severity=16 state=4 line=1 server=SYBSRV procedure=DBD1 text=Invalid column name 'nurgle'.
Server message number=207 severity=16 state=4 line=1 server=SYBSRV procedure=DBD1 text=Invalid column name 'nurgle'.
 [for Statement "SELECT nurgle
FROM   TEST
WHERE  nurgle = ?
"] at /home/williami/lib/Ima/DBI.pm line 391.

Note that you also get a warning about $Class::DBI::Column::FetchHashKeyName
being only used once. But this is new functionality in my patch :).

Apply the patch and get the following output:

1
Dingbat
Blurch

I am looking to provide this as tests using Test::More and DBD::Mock
(so as to demonstrate the problem without needing a case sensitive DBD).

Patches follow:

--- Class-DBI-0.96/lib/Class/DBI.pm 
+++ lib/Class/DBI.pm 
@@ -1122,9 +1122,14 @@
        my (%data, @rows);
        eval {
                $sth->execute(@$args) unless $sth->{Active};
-               $sth->bind_columns(\(@data{ @{ $sth->{NAME_lc} } }));
+               $sth->bind_columns(\(@data{ @{ $sth->{$sth->{FetchHashKeyName}} } }));
                push @rows, {%data} while $sth->fetch;
        };
+       eval {
+               $sth->execute(@$args);
+               $sth->bind_columns(\(@data{ @{ $sth->{$sth->{FetchHashKeyName}} } }));
+               push @rows, {%data} while $sth->fetch;
+       } if $@;
        return $class->_croak("$class can't $sth->{Statement}: $@", err => $@)
                if $@;
        return $class->_ids_to_objects(\@rows);


--- Class-DBI-0.96/lib/Class/DBI/Column.pm 
+++ lib/Class/DBI/Column.pm 
@@ -56,7 +56,20 @@
        );
 }
 
-sub name_lc { lc shift->name }
+our $FetchHashKeyName = 'NAME_lc';
+ 
+sub name_lc { 
+       my $name = shift->name;
+       if ($FetchHashKeyName eq 'NAME_lc') {
+               lc $name;
+       }
+       elsif ($FetchHashKeyName eq 'NAME_uc') {
+               uc $name;
+       }
+       else {
+               $name;
+       }
+ }
 
 sub add_group {
        my ($self, $group) = @_;


--- Class-DBI-0.96/lib/Class/DBI/ColumnGrouper.pm 
+++ lib/Class/DBI/ColumnGrouper.pm 
@@ -77,16 +77,25 @@
 
 =cut
 
+sub _normalise {
+       my $name = shift;
+
+       my $fhkn = $Class::DBI::Column::FetchHashKeyName;
+
+       ($fhkn eq 'NAME') ? $name :
+       ($fhkn eq 'NAME_uc') ? uc($name) : lc($name);
+};
+
 sub add_column {
        my ($self, $name) = @_;
        return $name if ref $name;
-       $self->{_allcol}->{ lc $name } ||= Class::DBI::Column->new($name);
+       $self->{_allcol}->{ _normalise $name } ||= Class::DBI::Column->new($name);
 }
 
 sub find_column {
        my ($self, $name) = @_;
        return $name if ref $name;
-       return unless $self->{_allcol}->{ lc $name };
+       return unless $self->{_allcol}->{ _normalise $name };
 }
 
 =head2 add_group