| Subject: | INDENTITY updates |
In trying to use Class::DBI::Sybase, I found a defect in the updating
methods. IDENTITY columns are getting assigned as changed. But, you
cannot change the an IDENTITY value unless you've set IDENTITY_INSERT to
ON. I patched the code so that the IDENTITY column is omitted from the
changed columns. I implemented the changes in much the same way as the
TEXT column exclusion code, although I expect there would only be one
IDENTITY column, as is that is the norm.
| Subject: | 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@cpan.orgE<gt>
Michael Wojcikewicz E<lt>theothermike@gmail.com<gt>
Paul Sandulescu E<lt>paul.sandulescu@mail.mcgill.com<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 -> primary_columns;
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 defined $identity_columns[0] && $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 @ident_columns = $self -> columns('IDENTITY');
my @changed = $self -> is_changed();
my @columns;
foreach my $changed (@changed)
{
# omit TEXT columns from the update clause since they are quoted
next if grep { $_ eq $changed } @ident_columns;
push @columns, $changed unless grep { $_ eq $changed } @text_columns;
}
return $self -> _attrs(@columns);
}
sub _update_line
{
my $self = shift;
my @changed = $self -> is_changed;
my @ident_columns = $self -> columns('IDENTITY');
my @columns;
foreach my $changed (@changed)
{
# omit IDENTITY columns from the update clause since they are cannot be
# changed without first setting IDENTITY_INSERT to ON
push @columns, $changed unless grep { $_ eq $changed } @ident_columns;
}
# use our custom _column_placeholder that quotes TEXT columns
return join(', ', map "$_ = " . $self -> _column_placeholder($_, $self -> $_()), @columns);
}
1;
# TODO: LIMIT ?