[CDBI] Class::DBI::Sybase patch to allow TEXT columns for create/update
[prev] [thread] [next] [Date index for 2005/09/01]
From: Mike W
Subject: [CDBI] Class::DBI::Sybase patch to allow TEXT columns for create/update
Date: 20:24 on 01 Sep 2005
Subject: [CDBI] Class::DBI::Sybase patch to allow TEXT columns for create/update
Date: 20:24 on 01 Sep 2005
------=_Part_2500_5393779.1125606273693
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline
Hi Class-DBI,
I've recently had to deal with some tables in Sybase with TEXT type
columns in them. Apparently the Sybase libraries don't allow
parameter binding for those types of columns, so neither does
DBD::Sybase.
Attached is a patche to deal with this limitation. Basically,
CDBI::Sybase now removes any TEXT columns from the insert and update
clauses parameter binding, and instead embeds them with $dbh ->
quote() from DBI.
I tried emailling the maintainer of CDBI::Sybase with a patch, but I
got a bounce. Anyone know who the maintainer is now?
--mike
------=_Part_2500_5393779.1125606273693
Content-Type: application/octet-stream; name=Sybase.pm
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename="Sybase.pm"
package Class::DBI::Sybase;
=head1 NAME
Class::DBI::Sybase - Extensions to Class::DBI for Sybase
=head1 SYNOPSIS
package Music::DBI;
use base 'Class::DBI::Sybase';
Music::DBI->set_db('Main', 'dbi:Sybase:server=$server', 'username', 'password');
package Artist;
use base 'Music::DBI';
__PACKAGE__->set_up_table('Artist');
# ... see the Class::DBI documentation for details on Class::DBI usage
=head1 DESCRIPTION
This is an extension to Class::DBI that currently implements:
* Automatic column name discovery.
* Works with IDENTITY columns to auto-generate primary keys.
* Works with TEXT columns for create() and update()
Instead of setting Class::DBI as your base class, use this.
=head1 BUGS
DBD::Sybase currently has a bug where a statement handle can be marked as
active, even though it's not. We override sth_to_objects to call finish() on the handle.
=head1 AUTHORS
Dan Sully E<lt>daniel@xxxx.xxxx<gt>
Michael Wojcikewicz E<lt>theothermike@xxxxx.xxx<gt>
=head1 SEE ALSO
L<Class::DBI>, L<DBD::Sybase>
=cut
use strict;
use base 'Class::DBI';
use vars qw($VERSION);
$VERSION = '0.4';
sub _die { require Carp; Carp::croak(@_); }
# This is necessary to get the last ID back
__PACKAGE__->set_sql(MakeNewObj => <<'');
SET NOCOUNT ON
INSERT INTO __TABLE__ (%s)
VALUES (%s)
SELECT @@IDENTITY
sub set_up_table {
my($class, $table) = @_;
my $dbh = $class->db_Main();
$class->table($table);
# find the primary key and column names.
my $sth = $dbh->prepare("sp_columns $table");
$sth->execute();
my $col = $sth->fetchall_arrayref;
$sth->finish();
_die('The "'. $class->table() . '" table has no primary key') unless $col->[0][3];
$class->columns(All => map {$_->[3]} @$col);
$class->columns(Primary => $col->[0][3]);
# find any text columns that will get quoted upon INSERT
$class->columns(TEXT => map { $_->[5] eq 'text' ? $_->[3] : () } @$col);
# now find the IDENTITY column
$sth = $dbh->prepare("sp_help $table");
$sth -> execute();
# the first two resultsets contain no info about finding the identity column
$sth -> fetchall_arrayref() for 1 .. 2;
$col = $sth -> fetchall_arrayref();
my ($identity) = grep( $_ -> [9] == 1, @$col ); # the 10th column contains a boolean denoting whether it's an IDENTITY
$class -> columns(IDENTITY => $identity -> [0]) if $identity; # store the IDENTITY column
}
# Fixes a DBD::Sybase problem where the handle is still active.
sub sth_to_objects {
my ($class, $sth, $args) = @_;
$class->_croak("sth_to_objects needs a statement handle") unless $sth;
unless (UNIVERSAL::isa($sth => "DBI::st")) {
my $meth = "sql_$sth";
$sth = $class->$meth();
}
$sth->finish() if $sth->{Active};
return $class->SUPER::sth_to_objects($sth, $args);
}
sub _column_placeholder
{
my $self = shift;
my $column = shift;
my $data = shift;
my @text_columns = $self -> columns('TEXT');
# if its a text column, we need to $dbh -> quote() it, rather than using a placeholder, limitation of Sybase TDS libraries
if ($data && grep { $_ eq $column } @text_columns)
{
return $self -> db_Main -> quote($data);
}
else
{
return $self -> SUPER::_column_placeholder( $column );
}
}
sub _insert_row {
my $self = shift;
my $data = shift;
my @identity_columns = $self -> columns('IDENTITY');
my @text_columns = $self -> columns('TEXT');
eval {
my @columns;
my @values;
# Omit the IDENTITY column to let it be Auto Generated
for my $column (keys %$data) {
next if $column eq $identity_columns[0];
push @columns, $column;
# Omit the text column since it needs to be quoted
push @values, $data -> {$column} unless grep { $_ eq $column } @text_columns;
}
my $sth = $self->sql_MakeNewObj(
join(', ', @columns),
join(', ', map $self->_column_placeholder($_, $data -> {$_}), @columns), # this uses the new placeholder methods that quotes
);
$self->_bind_param($sth, \@columns);
$sth->execute(@values);
my $id = $sth -> fetchrow_arrayref() -> [0];
$data->{ $identity_columns[0] } = $id
if @identity_columns == 1
&& !defined $data->{ $identity_columns[0] };
$sth->finish if $sth -> {Active};
};
if ($@) {
my $class = ref $self;
return $self->_croak(
"Can't insert new $class: $@",
err => $@,
method => 'create'
);
}
return 1;
}
sub _update_vals {
my $self = shift;
my @text_columns = $self -> columns('TEXT');
my @changed = $self -> is_changed();
my @columns;
foreach my $changed (@changed)
{
# omit TEXT columns from the update clause since they are quoted
push @columns, $changed unless grep { $_ eq $changed } @text_columns;
}
return $self -> _attrs(@columns);
}
sub _update_line
{
my $self = shift;
# use our custom _column_placeholder that quotes TEXT columns
return join(', ', map "$_ = " . $self -> _column_placeholder($_, $self -> $_()), $self -> is_changed);
}
1;
# TODO: LIMIT ?
------=_Part_2500_5393779.1125606273693
Content-Type: application/octet-stream;
name=class-dbi-sybase.0.4.unified.patch
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename="class-dbi-sybase.0.4.unified.patch"
--- /ms/dist/perl5/PROJ/Class-DBI-Sybase/0.31/lib/perl5/Class/DBI/Sybase.pm 2004-10-20 12:34:00.000000000 -0400
+++ Sybase.pm 2005-09-01 16:08:24.000000000 -0400
@@ -22,6 +22,7 @@
* Automatic column name discovery.
* Works with IDENTITY columns to auto-generate primary keys.
+ * Works with TEXT columns for create() and update()
Instead of setting Class::DBI as your base class, use this.
@@ -34,7 +35,7 @@
Dan Sully E<lt>daniel@xxxx.xxxx<gt>
-Michael Wojcikewicz E<lt>mike@xxxxxxxxx.xxxx<gt>
+Michael Wojcikewicz E<lt>theothermike@xxxxx.xxx<gt>
=head1 SEE ALSO
@@ -43,11 +44,10 @@
=cut
use strict;
-use base qw(Class::DBI);
+use base 'Class::DBI';
use vars qw($VERSION);
-
-$VERSION = '0.31';
+$VERSION = '0.4';
sub _die { require Carp; Carp::croak(@_); }
@@ -77,19 +77,18 @@
$class->columns(All => map {$_->[3]} @$col);
$class->columns(Primary => $col->[0][3]);
+ # find any text columns that will get quoted upon INSERT
+ $class->columns(TEXT => map { $_->[5] eq 'text' ? $_->[3] : () } @$col);
+
# now find the IDENTITY column
$sth = $dbh->prepare("sp_help $table");
- $sth->execute();
-
+ $sth -> execute();
# the first two resultsets contain no info about finding the identity column
- $sth->fetchall_arrayref() for 1..2;
- $col = $sth->fetchall_arrayref();
+ $sth -> fetchall_arrayref() for 1 .. 2;
+ $col = $sth -> fetchall_arrayref();
- # the 10th column contains a boolean denoting whether it's an IDENTITY
- my ($identity) = grep($_->[9] == 1, @$col);
-
- # store the IDENTITY column
- $class->columns(IDENTITY => $identity->[0]) if $identity;
+ my ($identity) = grep( $_ -> [9] == 1, @$col ); # the 10th column contains a boolean denoting whether it's an IDENTITY
+ $class -> columns(IDENTITY => $identity -> [0]) if $identity; # store the IDENTITY column
}
# Fixes a DBD::Sybase problem where the handle is still active.
@@ -103,59 +102,97 @@
$sth = $class->$meth();
}
- $sth->finish() if $sth->{'Active'};
+ $sth->finish() if $sth->{Active};
return $class->SUPER::sth_to_objects($sth, $args);
}
-sub _insert_row {
+sub _column_placeholder
+{
my $self = shift;
+ my $column = shift;
my $data = shift;
+ my @text_columns = $self -> columns('TEXT');
- my @identity_columns = $self->columns('IDENTITY');
+ # if its a text column, we need to $dbh -> quote() it, rather than using a placeholder, limitation of Sybase TDS libraries
+ if ($data && grep { $_ eq $column } @text_columns)
+ {
+ return $self -> db_Main -> quote($data);
+ }
+ else
+ {
+ return $self -> SUPER::_column_placeholder( $column );
+ }
+}
- eval {
- my @columns = ();
- my @values = ();
+sub _insert_row {
+ my $self = shift;
+ my $data = shift;
+ my @identity_columns = $self -> columns('IDENTITY');
+ my @text_columns = $self -> columns('TEXT');
+
+ eval {
+ my @columns;
+ my @values;
# Omit the IDENTITY column to let it be Auto Generated
for my $column (keys %$data) {
-
- unless ($column eq $identity_columns[0]) {
- push @columns, $column;
- push @values, $data->{$column};
- }
+ next if $column eq $identity_columns[0];
+
+ push @columns, $column;
+ # Omit the text column since it needs to be quoted
+ push @values, $data -> {$column} unless grep { $_ eq $column } @text_columns;
}
+ my $sth = $self->sql_MakeNewObj(
+ join(', ', @columns),
+ join(', ', map $self->_column_placeholder($_, $data -> {$_}), @columns), # this uses the new placeholder methods that quotes
+ );
+ $self->_bind_param($sth, \@columns);
+ $sth->execute(@values);
+
+ my $id = $sth -> fetchrow_arrayref() -> [0];
+
+ $data->{ $identity_columns[0] } = $id
+ if @identity_columns == 1
+ && !defined $data->{ $identity_columns[0] };
+ $sth->finish if $sth -> {Active};
+ };
+ if ($@) {
+ my $class = ref $self;
+ return $self->_croak(
+ "Can't insert new $class: $@",
+ err => $@,
+ method => 'create'
+ );
+ }
+ return 1;
+}
- my $sth = $self->sql_MakeNewObj(
- join(', ', @columns),
- join(', ', map $self->_column_placeholder($_), @columns),
- );
-
- $self->_bind_param($sth, \@columns);
- $sth->execute(@values);
-
- my $id = $sth->fetchrow_arrayref()->[0];
+sub _update_vals {
+ my $self = shift;
+ my @text_columns = $self -> columns('TEXT');
- if (@identity_columns == 1 && !defined $data->{$identity_columns[0]}) {
- $data->{$identity_columns[0]} = $id;
- }
+ my @changed = $self -> is_changed();
+ my @columns;
- $sth->finish() if $sth->{'Active'};
- };
+ foreach my $changed (@changed)
+ {
+ # omit TEXT columns from the update clause since they are quoted
+ push @columns, $changed unless grep { $_ eq $changed } @text_columns;
+ }
- if ($@) {
- my $class = ref($self);
+ return $self -> _attrs(@columns);
+}
- return $self->_croak("Can't insert new $class: $@",
- 'err' => $@,
- 'method' => 'create',
- );
- }
+sub _update_line
+{
+ my $self = shift;
- return 1;
+ # use our custom _column_placeholder that quotes TEXT columns
+ return join(', ', map "$_ = " . $self -> _column_placeholder($_, $self -> $_()), $self -> is_changed);
}
1;
-__END__
+# TODO: LIMIT ?
+
------=_Part_2500_5393779.1125606273693
Content-Type: application/octet-stream; name=class-dbi-sybase.0.4.patch
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename="class-dbi-sybase.0.4.patch"
24a25
> * Works with TEXT columns for create() and update()
37c38
< Michael Wojcikewicz E<lt>mike@xxxxxxxxx.xxxx<gt>
---
> Michael Wojcikewicz E<lt>theothermike@xxxxx.xxx<gt>
46c47
< use base qw(Class::DBI);
---
> use base 'Class::DBI';
49,50c50
<
< $VERSION = '0.31';
---
> $VERSION = '0.4';
79a80,82
> # find any text columns that will get quoted upon INSERT
> $class->columns(TEXT => map { $_->[5] eq 'text' ? $_->[3] : () } @$col);
>
82,83c85
< $sth->execute();
<
---
> $sth -> execute();
85,86c87,88
< $sth->fetchall_arrayref() for 1..2;
< $col = $sth->fetchall_arrayref();
---
> $sth -> fetchall_arrayref() for 1 .. 2;
> $col = $sth -> fetchall_arrayref();
88,92c90,91
< # the 10th column contains a boolean denoting whether it's an IDENTITY
< my ($identity) = grep($_->[9] == 1, @$col);
<
< # store the IDENTITY column
< $class->columns(IDENTITY => $identity->[0]) if $identity;
---
> my ($identity) = grep( $_ -> [9] == 1, @$col ); # the 10th column contains a boolean denoting whether it's an IDENTITY
> $class -> columns(IDENTITY => $identity -> [0]) if $identity; # store the IDENTITY column
106c105
< $sth->finish() if $sth->{'Active'};
---
> $sth->finish() if $sth->{Active};
111c110,111
< sub _insert_row {
---
> sub _column_placeholder
> {
112a113
> my $column = shift;
113a115
> my @text_columns = $self -> columns('TEXT');
115c117,126
< my @identity_columns = $self->columns('IDENTITY');
---
> # if its a text column, we need to $dbh -> quote() it, rather than using a placeholder, limitation of Sybase TDS libraries
> if ($data && grep { $_ eq $column } @text_columns)
> {
> return $self -> db_Main -> quote($data);
> }
> else
> {
> return $self -> SUPER::_column_placeholder( $column );
> }
> }
117,119c128,136
< eval {
< my @columns = ();
< my @values = ();
---
> sub _insert_row {
> my $self = shift;
> my $data = shift;
> my @identity_columns = $self -> columns('IDENTITY');
> my @text_columns = $self -> columns('TEXT');
>
> eval {
> my @columns;
> my @values;
123,127c140,144
<
< unless ($column eq $identity_columns[0]) {
< push @columns, $column;
< push @values, $data->{$column};
< }
---
> next if $column eq $identity_columns[0];
>
> push @columns, $column;
> # Omit the text column since it needs to be quoted
> push @values, $data -> {$column} unless grep { $_ eq $column } @text_columns;
128a146,169
> my $sth = $self->sql_MakeNewObj(
> join(', ', @columns),
> join(', ', map $self->_column_placeholder($_, $data -> {$_}), @columns), # this uses the new placeholder methods that quotes
> );
> $self->_bind_param($sth, \@columns);
> $sth->execute(@values);
>
> my $id = $sth -> fetchrow_arrayref() -> [0];
>
> $data->{ $identity_columns[0] } = $id
> if @identity_columns == 1
> && !defined $data->{ $identity_columns[0] };
> $sth->finish if $sth -> {Active};
> };
> if ($@) {
> my $class = ref $self;
> return $self->_croak(
> "Can't insert new $class: $@",
> err => $@,
> method => 'create'
> );
> }
> return 1;
> }
130,138c171,173
< my $sth = $self->sql_MakeNewObj(
< join(', ', @columns),
< join(', ', map $self->_column_placeholder($_), @columns),
< );
<
< $self->_bind_param($sth, \@columns);
< $sth->execute(@values);
<
< my $id = $sth->fetchrow_arrayref()->[0];
---
> sub _update_vals {
> my $self = shift;
> my @text_columns = $self -> columns('TEXT');
140,142c175,176
< if (@identity_columns == 1 && !defined $data->{$identity_columns[0]}) {
< $data->{$identity_columns[0]} = $id;
< }
---
> my @changed = $self -> is_changed();
> my @columns;
144,145c178,182
< $sth->finish() if $sth->{'Active'};
< };
---
> foreach my $changed (@changed)
> {
> # omit TEXT columns from the update clause since they are quoted
> push @columns, $changed unless grep { $_ eq $changed } @text_columns;
> }
147,148c184,185
< if ($@) {
< my $class = ref($self);
---
> return $self -> _attrs(@columns);
> }
150,154c187,189
< return $self->_croak("Can't insert new $class: $@",
< 'err' => $@,
< 'method' => 'create',
< );
< }
---
> sub _update_line
> {
> my $self = shift;
156c191,192
< return 1;
---
> # use our custom _column_placeholder that quotes TEXT columns
> return join(', ', map "$_ = " . $self -> _column_placeholder($_, $self -> $_()), $self -> is_changed);
161c197,198
< __END__
---
> # TODO: LIMIT ?
>
------=_Part_2500_5393779.1125606273693
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
_______________________________________________
ClassDBI mailing list
ClassDBI@xxxxx.xxxxxxxxxxxxxxxx.xxx
http://lists.digitalcraftsmen.net/mailman/listinfo/classdbi
------=_Part_2500_5393779.1125606273693--
 |
[CDBI] Class::DBI::Sybase patch to allow TEXT columns for create/update
|