use mro 'c3';
use DBIx::Class::Carp;
use Scalar::Util qw/blessed weaken/;
-use List::Util 'first';
-use Sub::Name();
-use Data::Dumper::Concise 'Dumper';
use Try::Tiny;
use Context::Preserve 'preserve_context';
+use DBIx::Class::_Util qw( sigwarn_silencer dbic_internal_try dump_value scope_guard set_subname );
use namespace::clean;
-__PACKAGE__->sql_limit_dialect ('RowCountOrGenericSubQ');
+__PACKAGE__->sql_limit_dialect ('GenericSubQ');
__PACKAGE__->sql_quote_char ([qw/[ ]/]);
__PACKAGE__->datetime_parser_type(
'DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format'
my $no_bind_vars = __PACKAGE__ . '::NoBindVars';
- if ($self->using_freetds) {
+ if ($self->_using_freetds) {
carp_once <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
You are using FreeTDS with Sybase.
sub _init {
my $self = shift;
+
+ $self->next::method(@_);
+
+ if ($self->_using_freetds && (my $ver = $self->_using_freetds_version||999) > 0.82) {
+ carp_once(
+ "Buggy FreeTDS version $ver detected, statement caching will not work and "
+ . 'will be disabled.'
+ );
+ $self->disable_sth_caching(1);
+ }
+
$self->_set_max_connect(256);
# create storage for insert/(update blob) transactions,
my $replaced = __PACKAGE__->can($method);
- *{$method} = Sub::Name::subname $method => sub {
+ *{$method} = set_subname $method => sub {
my $self = shift;
$self->_writer_storage->$replaced(@_) if $self->_writer_storage;
$self->_bulk_storage->$replaced(@_) if $self->_bulk_storage;
# Even though we call $sth->finish for uses off the bulk API, there's still an
# "active statement" warning on disconnect, which we throw away here.
-# This is due to the bug described in insert_bulk.
+# This is due to the bug described in _insert_bulk.
# Currently a noop because 'prepare' is used instead of 'prepare_cached'.
- local $SIG{__WARN__} = sub {
- warn $_[0] unless $_[0] =~ /active statement/i;
- } if $self->_is_bulk_storage;
+ local $SIG{__WARN__} = sigwarn_silencer(qr/active statement/i)
+ if $self->_is_bulk_storage;
# so that next transaction gets a dbh
$self->_began_bulk_work(0) if $self->_is_bulk_storage;
}
$self->_dbh->{syb_chained_txn} = 1
- unless $self->using_freetds;
+ unless $self->_using_freetds;
$self->next::method(@_);
}
C<1>, but C<0> is better if your database is configured for it.
See
-L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
+L<DBD::Sybase/Handling IMAGE/TEXT data with syb_ct_get_data()/syb_ct_send_data()>.
=cut
sub _is_lob_column {
my ($self, $source, $column) = @_;
- return $self->_is_lob_type($source->column_info($column)->{data_type});
+ return $self->_is_lob_type(
+ $source->columns_info([$column])->{$column}{data_type}
+ );
}
sub _prep_for_execute {
- my $self = shift;
- my ($op, $ident) = @_;
+ my ($self, $op, $ident, $args) = @_;
- #
-### This is commented out because all tests pass. However I am leaving it
-### here as it may prove necessary (can't think through all combinations)
-### BTW it doesn't currently work exactly - need better sensitivity to
- # currently set value
- #
- # inherit these from the parent for the duration of _prep_for_execute
- # Don't know how to make a localizing loop with if's, otherwise I would
- #local $self->{_autoinc_supplied_for_op}
- # = $self->_parent_storage->_autoinc_supplied_for_op
- #if ($op eq 'insert' or $op eq 'update') and $self->_parent_storage;
- #local $self->{_perform_autoinc_retrieval}
- # = $self->_parent_storage->_perform_autoinc_retrieval
- #if ($op eq 'insert' or $op eq 'update') and $self->_parent_storage;
+ my $limit; # extract and use shortcut on limit without offset
+ if ($op eq 'select' and ! $args->[4] and $limit = $args->[3]) {
+ $args = [ @$args ];
+ $args->[3] = undef;
+ }
- my ($sql, $bind) = $self->next::method (@_);
+ my ($sql, $bind) = $self->next::method($op, $ident, $args);
+
+ # $limit is already sanitized by now
+ $sql = join( "\n",
+ "SET ROWCOUNT $limit",
+ $sql,
+ "SET ROWCOUNT 0",
+ ) if $limit;
if (my $identity_col = $self->_perform_autoinc_retrieval) {
$sql .= "\n" . $self->_fetch_identity_sql($ident, $identity_col)
sub _execute {
my $self = shift;
- my ($op) = @_;
-
my ($rv, $sth, @bind) = $self->next::method(@_);
- $self->_identity( ($sth->fetchall_arrayref)[0][0] )
+ $self->_identity( ($sth->fetchall_arrayref)->[0][0] )
if $self->_perform_autoinc_retrieval;
return wantarray ? ($rv, $sth, @bind) : $rv;
my $columns_info = $source->columns_info;
- my $identity_col =
- (first { $columns_info->{$_}{is_auto_increment} }
- keys %$columns_info )
- || '';
+ my ($identity_col) = grep
+ { $columns_info->{$_}{is_auto_increment} }
+ keys %$columns_info
+ ;
+
+ $identity_col = '' if ! defined $identity_col;
# FIXME - this is duplication from DBI.pm. When refactored towards
# the LobWriter this can be folded back where it belongs.
? 1
: 0
;
- local $self->{_perform_autoinc_retrieval} =
- ($identity_col and ! exists $to_insert->{$identity_col})
- ? $identity_col
- : undef
+
+ local $self->{_perform_autoinc_retrieval} = $self->{_autoinc_supplied_for_op}
+ ? undef
+ : $identity_col
;
# check for empty insert
# try to insert explicit 'DEFAULT's instead (except for identity, timestamp
# and computed columns)
if (not %$to_insert) {
+
+ my $ci;
+ # same order as add_columns
for my $col ($source->columns) {
next if $col eq $identity_col;
- my $info = $source->column_info($col);
-
- next if ref $info->{default_value} eq 'SCALAR'
- || (exists $info->{data_type} && (not defined $info->{data_type}));
-
- next if $info->{data_type} && $info->{data_type} =~ /^timestamp\z/i;
+ my $info = ( $ci ||= $source->columns_info )->{$col};
+
+ next if (
+ ref $info->{default_value} eq 'SCALAR'
+ or
+ (
+ exists $info->{data_type}
+ and
+ ! defined $info->{data_type}
+ )
+ or
+ (
+ ( $info->{data_type} || '' )
+ =~ /^timestamp\z/i
+ )
+ );
$to_insert->{$col} = \'DEFAULT';
}
my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
- # do we need the horrific SELECT MAX(COL) hack?
- my $need_dumb_last_insert_id = (
- $self->_perform_autoinc_retrieval
- &&
- ($self->_identity_method||'') ne '@@IDENTITY'
- );
-
- my $next = $self->next::can;
-
- # we are already in a transaction, or there are no blobs
- # and we don't need the PK - just (try to) do it
- if ($self->{transaction_depth}
- || (!$blob_cols && !$need_dumb_last_insert_id)
+ # if a new txn is needed - it must happen on the _writer/new connection (for now)
+ my $guard;
+ if (
+ ! $self->transaction_depth
+ and
+ (
+ $blob_cols
+ or
+ # do we need the horrific SELECT MAX(COL) hack?
+ (
+ $self->_perform_autoinc_retrieval
+ and
+ ( ($self->_identity_method||'') ne '@@IDENTITY' )
+ )
+ )
) {
- return $self->_insert (
- $next, $source, $to_insert, $blob_cols, $identity_col
- );
+ $self = $self->_writer_storage;
+ $guard = $self->txn_scope_guard;
}
- # otherwise use the _writer_storage to do the insert+transaction on another
- # connection
- my $guard = $self->_writer_storage->txn_scope_guard;
+ my $updated_cols = $self->next::method ($source, $to_insert);
- my $updated_cols = $self->_writer_storage->_insert (
- $next, $source, $to_insert, $blob_cols, $identity_col
- );
-
- $self->_identity($self->_writer_storage->_identity);
-
- $guard->commit;
-
- return $updated_cols;
-}
-
-sub _insert {
- my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
-
- my $updated_cols = $self->$next ($source, $to_insert);
-
- my $final_row = {
- ($identity_col ?
- ($identity_col => $self->last_insert_id($source, $identity_col)) : ()),
- %$to_insert,
- %$updated_cols,
- };
+ $self->_insert_blobs (
+ $source,
+ $blob_cols,
+ {
+ ( $identity_col
+ ? ( $identity_col => $self->last_insert_id($source, $identity_col) )
+ : ()
+ ),
+ %$to_insert,
+ %$updated_cols,
+ },
+ ) if $blob_cols;
- $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;
+ $guard->commit if $guard;
return $updated_cols;
}
if (keys %$fields) {
# Now set the identity update flags for the actual update
- local $self->{_autoinc_supplied_for_op} = (first
+ local $self->{_autoinc_supplied_for_op} = grep
{ $_->{is_auto_increment} }
values %{ $source->columns_info([ keys %$fields ]) }
- ) ? 1 : 0;
+ ;
my $next = $self->next::can;
my $args = \@_;
}
else {
# Set the identity update flags for the actual update
- local $self->{_autoinc_supplied_for_op} = (first
+ local $self->{_autoinc_supplied_for_op} = grep
{ $_->{is_auto_increment} }
values %{ $source->columns_info([ keys %$fields ]) }
- ) ? 1 : 0;
+ ;
return $self->next::method(@_);
}
}
-sub insert_bulk {
+sub _insert_bulk {
my $self = shift;
my ($source, $cols, $data) = @_;
my $columns_info = $source->columns_info;
- my $identity_col =
- first { $columns_info->{$_}{is_auto_increment} }
+ my ($identity_col) =
+ grep { $columns_info->{$_}{is_auto_increment} }
keys %$columns_info;
# FIXME - this is duplication from DBI.pm. When refactored towards
# the LobWriter this can be folded back where it belongs.
- local $self->{_autoinc_supplied_for_op} =
- (first { $_ eq $identity_col } @$cols)
- ? 1
- : 0
- ;
+ local $self->{_autoinc_supplied_for_op}
+ = grep { $_ eq $identity_col } @$cols;
my $use_bulk_api =
$self->_bulk_storage &&
# next::method uses a txn anyway, but it ends too early in case we need to
# select max(col) to get the identity for inserting blobs.
- ($self, my $guard) = $self->{transaction_depth} == 0 ?
- ($self->_writer_storage, $self->_writer_storage->txn_scope_guard)
- :
- ($self, undef);
+ ($self, my $guard) = $self->transaction_depth
+ ? ($self, undef)
+ : ($self->_writer_storage, $self->_writer_storage->txn_scope_guard)
+ ;
$self->next::method(@_);
my @source_columns = $source->columns;
# bcp identity index is 1-based
- my $identity_idx = first { $source_columns[$_] eq $identity_col } (0..$#source_columns);
+ my ($identity_idx) = grep { $source_columns[$_] eq $identity_col } (0..$#source_columns);
$identity_idx = defined $identity_idx ? $identity_idx + 1 : 0;
my @new_data;
# This ignores any data conversion errors detected by the client side libs, as
# they are usually harmless.
my $orig_cslib_cb = DBD::Sybase::set_cslib_cb(
- Sub::Name::subname insert_bulk => sub {
+ set_subname _insert_bulk_cslib_errhandler => sub {
my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_;
return 1 if $errno == 36;
});
my $exception = '';
- try {
+ dbic_internal_try {
my $bulk = $self->_bulk_storage;
my $guard = $bulk->txn_scope_guard;
if ($exception =~ /-Y option/) {
my $w = 'Sybase bulk API operation failed due to character set incompatibility, '
- . 'reverting to regular array inserts. Try unsetting the LANG environment variable'
+ . 'reverting to regular array inserts. Try unsetting the LC_ALL environment variable'
;
$w .= "\n$exception" if $self->debug;
carp $w;
$self->_bulk_storage(undef);
unshift @_, $self;
- goto \&insert_bulk;
+ goto \&_insert_bulk;
}
elsif ($exception) {
# rollback makes the bulkLogin connection unusable
}
else {
$fields->{$col} = \"''";
- $blob_cols{$col} = $blob_val unless $blob_val eq '';
+ $blob_cols{$col} = $blob_val
+ if length $blob_val;
}
}
}
return %blob_cols ? \%blob_cols : undef;
}
-# same for insert_bulk
+# same for _insert_bulk
sub _remove_blob_cols_array {
my ($self, $source, $cols, $data) = @_;
else {
$data->[$j][$i] = \"''";
$blob_cols[$j][$i] = $blob_val
- unless $blob_val eq '';
+ if length $blob_val;
}
}
}
sub _update_blobs {
my ($self, $source, $blob_cols, $where) = @_;
- my @primary_cols = try
- { $source->_pri_cols }
+ my @primary_cols = dbic_internal_try
+ { $source->_pri_cols_or_die }
catch {
$self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
};
if (
ref $where eq 'HASH'
and
- @primary_cols == grep { defined $where->{$_} } @primary_cols
+ ! grep { ! defined $where->{$_} } @primary_cols
) {
my %row_to_update;
@row_to_update{@primary_cols} = @{$where}{@primary_cols};
}
sub _insert_blobs {
- my ($self, $source, $blob_cols, $row) = @_;
- my $dbh = $self->_get_dbh;
+ my ($self, $source, $blob_cols, $row_data) = @_;
my $table = $source->name;
- my %row = %$row;
- my @primary_cols = try
- { $source->_pri_cols }
+ my @primary_cols = dbic_internal_try
+ { $source->_pri_cols_or_die }
catch {
$self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
};
$self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
- if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
+ if grep { ! defined $row_data->{$_} } @primary_cols;
+
+ # if we are 2-phase inserting a blob - there is nothing to retrieve anymore,
+ # regardless of the previous state of the flag
+ local $self->{_perform_autoinc_retrieval}
+ if $self->_perform_autoinc_retrieval;
+
+ my %where = map {( $_ => $row_data->{$_} )} @primary_cols;
for my $col (keys %$blob_cols) {
my $blob = $blob_cols->{$col};
- my %where = map { ($_, $row{$_}) } @primary_cols;
-
my $cursor = $self->select ($source, [$col], \%where, {});
$cursor->next;
my $sth = $cursor->sth;
if (not $sth) {
$self->throw_exception(
"Could not find row in table '$table' for blob update:\n"
- . (Dumper \%where)
+ . dump_value \%where
);
}
- try {
+ # FIXME - it is not clear if this is needed at all. But it's been
+ # there since 2009 ( d867eedaa ), might as well let sleeping dogs
+ # lie... sigh.
+ weaken( my $wsth = $sth );
+ my $g = scope_guard { $wsth->finish if $wsth };
+
+ dbic_internal_try {
do {
$sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
} while $sth->fetch;
$sth->func('ct_finish_send') or die $sth->errstr;
}
catch {
- if ($self->using_freetds) {
+ if ($self->_using_freetds) {
$self->throw_exception (
"TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_"
);
else {
$self->throw_exception($_);
}
- }
- finally {
- $sth->finish if $sth;
};
}
}
Sybase ASE for Linux (which comes with the Open Client libraries) may be
downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
-To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or run:
+To see if you're using FreeTDS run:
perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
$schema->txn_do(sub {
my $rs = $schema->resultset('Book');
- while (my $row = $rs->next) {
+ while (my $result = $rs->next) {
$schema->resultset('MetaData')->create({
- book_id => $row->id,
+ book_id => $result->id,
...
});
}
See L</connect_call_datetime_setup> to setup date formats
for L<DBIx::Class::InflateColumn::DateTime>.
+=head1 LIMITED QUERIES
+
+Because ASE does not have a good way to limit results in SQL that works for
+all types of queries, the limit dialect is set to
+L<GenericSubQ|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ>.
+
+Fortunately, ASE and L<DBD::Sybase> support cursors properly, so when
+L<GenericSubQ|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ> is too slow
+you can use the L<software_limit|DBIx::Class::ResultSet/software_limit>
+L<DBIx::Class::ResultSet> attribute to simulate limited queries by skipping
+over records.
+
=head1 TEXT/IMAGE COLUMNS
L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
calls in your C<Result> classes B<must> list columns in database order for this
-to work. Also, you may have to unset the C<LANG> environment variable before
+to work. Also, you may have to unset the C<LC_ALL> environment variable before
loading your app, as C<BCP -Y> is not yet supported in DBD::Sybase .
When inserting IMAGE columns using this method, you'll need to use
=back
-=head1 AUTHOR
-
-See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
+=head1 FURTHER QUESTIONS?
-=head1 LICENSE
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-You may distribute this code under the same terms as Perl itself.
+=head1 COPYRIGHT AND LICENSE
-=cut
-# vim:sts=2 sw=2:
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
projects / dbsrgits/DBIx-Class.git / blobdiff