[Bast-commits] r7123 - in DBIx-Class/0.08/branches/sybase:
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Sybase t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Sat Jul 25 20:52:18 GMT 2009
Author: caelum
Date: 2009-07-25 20:52:17 +0000 (Sat, 25 Jul 2009)
New Revision: 7123
Modified:
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
DBIx-Class/0.08/branches/sybase/t/746mssql.t
DBIx-Class/0.08/branches/sybase/t/746sybase.t
Log:
add money type support
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-07-25 19:23:49 UTC (rev 7122)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-07-25 20:52:17 UTC (rev 7123)
@@ -59,8 +59,11 @@
foreach my $data (@$bound) {
$data = ''.$data if ref $data;
+ $data = $self->transform_unbound_value($datatype, $data)
+ if $datatype;
+
$data = $self->_dbh->quote($data)
- if $self->should_quote_value($datatype, $data);
+ if (!$datatype || $self->should_quote_value($datatype, $data));
$new_sql .= shift(@sql_part) . $data;
}
@@ -71,7 +74,7 @@
}
=head2 should_quote_value
-
+
This method is called by L</_prep_for_execute> for every column in
order to determine if its value should be quoted or not. The arguments
are the current column data type and the actual bind value. The return
@@ -79,16 +82,25 @@
override this in you Storage::DBI::<database> subclass, if your RDBMS
does not like quotes around certain datatypes (e.g. Sybase and integer
columns). The default method always returns true (do quote).
-
+
WARNING!!!
-
+
Always validate that the bind-value is valid for the current datatype.
Otherwise you may very well open the door to SQL injection attacks.
-
+
=cut
-
+
sub should_quote_value { 1 }
+=head2 transform_unbound_value
+
+Given a datatype and the value to be inserted directly into a SQL query, returns
+the necessary SQL fragment to represent that value.
+
+=cut
+
+sub transform_unbound_value { $_[2] }
+
=head1 AUTHORS
Brandon Black <blblack at gmail.com>
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2009-07-25 19:23:49 UTC (rev 7122)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2009-07-25 20:52:17 UTC (rev 7123)
@@ -51,6 +51,17 @@
return $self->next::method(@_);
}
+sub transform_unbound_value {
+ my ($self, $type, $value) = @_;
+
+ if ($type =~ /money/i && defined $value) {
+ $value =~ s/^\$//;
+ $value = '$' . $value;
+ }
+
+ return $value;
+}
+
1;
=head1 NAME
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-25 19:23:49 UTC (rev 7122)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-25 20:52:17 UTC (rev 7123)
@@ -245,9 +245,9 @@
my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
-# Sybase has nested transactions fortunately, because we have to do the insert
-# in a transaction to avoid race conditions with the SELECT MAX(COL) identity
-# method used when placeholders are enabled.
+# Sybase has savepoints fortunately, because we have to do the insert in a
+# transaction to avoid race conditions with the SELECT MAX(COL) identity method
+# used when placeholders are enabled.
my $updated_cols = do {
local $self->{auto_savepoint} = 1;
my $args = \@_;
Modified: DBIx-Class/0.08/branches/sybase/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746mssql.t 2009-07-25 19:23:49 UTC (rev 7122)
+++ DBIx-Class/0.08/branches/sybase/t/746mssql.t 2009-07-25 20:52:17 UTC (rev 7123)
@@ -33,7 +33,6 @@
my ($storage, $dbh) = @_;
eval { $dbh->do("DROP TABLE artist") };
$dbh->do(<<'SQL');
-
CREATE TABLE artist (
artistid INT IDENTITY NOT NULL,
name VARCHAR(100),
@@ -41,7 +40,6 @@
charfield CHAR(10) NULL,
primary key(artistid)
)
-
SQL
});
@@ -80,14 +78,11 @@
my ($storage, $dbh) = @_;
eval { $dbh->do("DROP TABLE money_test") };
$dbh->do(<<'SQL');
-
CREATE TABLE money_test (
id INT IDENTITY PRIMARY KEY,
amount MONEY NULL
)
-
SQL
-
});
my $rs = $schema->resultset('Money');
@@ -116,8 +111,6 @@
eval { $dbh->do("DROP TABLE Owners") };
eval { $dbh->do("DROP TABLE Books") };
$dbh->do(<<'SQL');
-
-
CREATE TABLE Books (
id INT IDENTITY (1, 1) NOT NULL,
source VARCHAR(100),
@@ -130,7 +123,6 @@
id INT IDENTITY (1, 1) NOT NULL,
name VARCHAR(100),
)
-
SQL
});
@@ -268,11 +260,9 @@
# clean up our mess
END {
- if (my $dbh = eval { $schema->storage->_dbh }) {
- $dbh->do('DROP TABLE artist');
- $dbh->do('DROP TABLE money_test');
- $dbh->do('DROP TABLE Books');
- $dbh->do('DROP TABLE Owners');
- }
+ if (my $dbh = eval { $schema->storage->_dbh }) {
+ eval { $dbh->do("DROP TABLE $_") }
+ for qw/artist money_test Books Owners/;
+ }
}
# vim:sw=2 sts=2
Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-25 19:23:49 UTC (rev 7122)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-25 20:52:17 UTC (rev 7123)
@@ -9,7 +9,7 @@
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
-my $TESTS = 29 + 2;
+my $TESTS = 35 + 2;
if (not ($dsn && $user)) {
plan skip_all =>
@@ -76,7 +76,7 @@
# so we start unconnected
$schema->storage->disconnect;
-# inserts happen in a txn, so we test txn nesting
+# inserts happen in a txn, so we make sure they can nest
$schema->txn_begin;
# test primary key handling
@@ -222,12 +222,51 @@
diag $@ if $@;
ok($got eq $new_str, "verified updated blob");
}
+
+# test MONEY column support
+ $schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE money_test") };
+ $dbh->do(<<'SQL');
+CREATE TABLE money_test (
+ id INT IDENTITY PRIMARY KEY,
+ amount MONEY NULL
+)
+SQL
+ });
+
+ my $rs = $schema->resultset('Money');
+
+ my $row;
+ lives_ok {
+ $row = $rs->create({ amount => 100 });
+ } 'inserted a money value';
+
+ is eval { $rs->find($row->id)->amount }, 100, 'money value round-trip';
+
+ lives_ok {
+ $row->update({ amount => 200 });
+ } 'updated a money value';
+
+ is eval { $rs->find($row->id)->amount },
+ 200, 'updated money value round-trip';
+
+ lives_ok {
+ $row->update({ amount => undef });
+ } 'updated a money value to NULL';
+
+ my $null_amount = eval { $rs->find($row->id)->amount };
+ ok(
+ (($null_amount == undef) && (not $@)),
+ 'updated money value to NULL round-trip'
+ );
+ diag $@ if $@;
}
# clean up our mess
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
- $dbh->do('DROP TABLE artist');
- eval { $dbh->do('DROP TABLE bindtype_test') };
+ eval { $dbh->do("DROP TABLE $_") }
+ for qw/artist bindtype_test money_test/;
}
}
More information about the Bast-commits
mailing list