[Bast-commits] r7071 - in DBIx-Class/0.08/branches/sybase:
lib/DBIx/Class lib/DBIx/Class/Storage
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Sybase t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Sun Jul 19 21:57:11 GMT 2009
Author: caelum
Date: 2009-07-19 21:57:11 +0000 (Sun, 19 Jul 2009)
New Revision: 7071
Modified:
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.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/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/sybase/t/746sybase.t
Log:
mangling _select_args turned out to be unnecessary
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/ResultSet.pm 2009-07-18 10:18:52 UTC (rev 7070)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/ResultSet.pm 2009-07-19 21:57:11 UTC (rev 7071)
@@ -2780,7 +2780,10 @@
: "${alias}.$_"
)
}
- } ( ref($attrs->{columns}) eq 'ARRAY' ) ? @{ delete $attrs->{columns}} : (delete $attrs->{columns} || $source->columns );
+ } ( ref($attrs->{columns}) eq 'ARRAY' ) ?
+ @{ delete $attrs->{columns}} :
+ (delete $attrs->{columns} ||
+ $source->storage->order_columns_for_select($source) );
}
# add the additional columns on
foreach ( 'include_columns', '+columns' ) {
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-07-18 10:18:52 UTC (rev 7070)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-07-19 21:57:11 UTC (rev 7071)
@@ -13,6 +13,16 @@
sub _rebless {
my $self = shift;
$self->disable_sth_caching(1);
+
+# LongReadLen doesn't work with MSSQL through DBD::Sybase, and the default is
+# huge on some versions of SQL server and can cause memory problems, so we
+# fix it up here.
+ my $dbh = $self->_dbh;
+
+ my $text_size = eval { $self->_dbi_connect_info->[-1]->{LongReadLen} } ||
+ 32768; # the DBD::Sybase default
+
+ $dbh->do("set textsize $text_size");
}
1;
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-18 10:18:52 UTC (rev 7070)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-19 21:57:11 UTC (rev 7071)
@@ -140,49 +140,26 @@
$type && $type =~ /(?:text|image|lob|bytea|binary)/i;
}
-# Move TEXT/IMAGE column to the end of select list, and make sure there is only
-# one.
+## This will be useful if we ever implement BLOB filehandle inflation and will
+## need to use the API, but for now it isn't.
#
-# work in progress
+#sub order_columns_for_select {
+# my ($self, $source) = @_;
#
-# * column indexes need to be fixed if @$select is reordered, not sure if that's
-# possible
-# * needs to handle hashrefs
-# * for some reason tests pass without this, even though documentation says
-# blobs should be at the end of the select list
-# * needs to at least croak for multiple blobs
-#
-#sub _select_args {
-# my ($self, $ident, $select) = splice @_, 0, 3;
-#
-# my ($alias2src, $rs_alias) = $self->_resolve_ident_sources($ident);
-# my $name_sep = $self->_sql_maker_opts->{name_sep} || '.';
-#
# my (@non_blobs, @blobs);
#
-# for my $col (@$select) {
-# if (ref $col) {
-## XXX should handle hashrefs too
-# push @non_blobs, $col;
-# next;
-# }
-#
-# $col =~ s/^([^\Q${name_sep}\E]*)\Q${name_sep}\E//;
-# my $alias = $1 || $rs_alias;
-# my $rsrc = $alias2src->{$alias};
-# my $datatype = $rsrc && $rsrc->column_info($col)->{data_type};
-#
-# if ($self->_is_lob_type($datatype)) {
+# for my $col ($source->columns) {
+# if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
# push @blobs, $col;
# } else {
# push @non_blobs, $col;
# }
# }
#
-# croak "cannot select more than a one TEXT/IMAGE column"
+# croak "cannot select more than a one TEXT/IMAGE column at a time"
# if @blobs > 1;
#
-# $self->next::method($ident, [@non_blobs, @blobs], @_);
+# return (@non_blobs, @blobs);
#}
# override to handle TEXT/IMAGE
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm 2009-07-18 10:18:52 UTC (rev 7070)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm 2009-07-19 21:57:11 UTC (rev 7071)
@@ -2277,6 +2277,23 @@
return;
}
+=head2 order_columns_for_select
+
+Returns an ordered list of column names for use with a C<SELECT> when the column
+list is not explicitly specified.
+By default returns the result of L<DBIx::Class::ResultSource/columns>.
+
+This may be overridden in a specific storage when there are requirements such
+as moving C<BLOB> columns to the end of the list.
+
+=cut
+
+sub order_columns_for_select {
+ my ($self, $source) = @_;
+
+ return $source->columns;
+}
+
sub DESTROY {
my $self = shift;
return if !$self->_dbh;
Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-18 10:18:52 UTC (rev 7070)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-19 21:57:11 UTC (rev 7071)
@@ -9,7 +9,7 @@
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
-my $TESTS = 31 + 2;
+my $TESTS = 29 + 2;
if (not ($dsn && $user)) {
plan skip_all =>
@@ -130,7 +130,7 @@
# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
SKIP: {
- skip 'Need at least version 1.09 of DBD::Sybase to test TEXT/IMAGE', 14
+ skip 'Need at least version 1.09 of DBD::Sybase to test TEXT/IMAGE', 12
unless $DBD::Sybase::VERSION >= 1.09;
my $dbh = $schema->storage->dbh;
@@ -216,31 +216,6 @@
};
diag $@ if $@;
ok($got eq $binstr{large}, "verified inserted large blob");
-
- # Test select args ordering on a ->find for a table with one blob
- {
- local $SIG{__WARN__} = sub {};
- eval { $dbh->do('DROP TABLE single_blob_test') };
-
- $dbh->do(qq[
- CREATE TABLE single_blob_test
- (
- id INT IDENTITY PRIMARY KEY,
- blob IMAGE NULL,
- foo VARCHAR(256) NULL
- )
- ],{ RaiseError => 1, PrintError => 0 });
- }
- $rs = $schema->resultset('SingleBlob');
- $created = eval { $rs->create({
- blob => $binstr{large}, foo => 'dummy'
- }) };
- ok(!$@, "inserted single large blob without dying");
- diag $@ if $@;
-
- $got = eval { $rs->find($created->id)->blob };
- diag $@ if $@;
- ok($got eq $binstr{large}, "verified inserted large blob through ->find");
}
}
@@ -249,6 +224,5 @@
if (my $dbh = eval { $schema->storage->_dbh }) {
$dbh->do('DROP TABLE artist');
eval { $dbh->do('DROP TABLE bindtype_test') };
- eval { $dbh->do('DROP TABLE single_blob_test') };
}
}
More information about the Bast-commits
mailing list