view release on metacpan or  search on metacpan

lib/DBIO/Sybase/Storage/ASE.pm  view on Meta::CPAN

package DBIO::Sybase::Storage::ASE;
# ABSTRACT: Sybase ASE SQL Server support for DBIO

use strict;
use warnings;

# The ASE::* trait classes below are standalone (no parent) and override
# methods that also exist in the deep DBIO::Storage::DBI hierarchy reached
# via DBIO::Sybase::Storage (e.g. last_insert_id, _execute, _insert_bulk,
# _exec_txn_begin). They MUST be listed before DBIO::Sybase::Storage so the
# C3 linearisation places them ahead of DBIO::Storage::DBI; otherwise their
# overrides are shadowed by core and never run (the trait methods chain into
# core via next::method).
use base qw/
  DBIO::Sybase::Storage::ASE::LOBWriter
  DBIO::Sybase::Storage::ASE::BulkInsert
  DBIO::Sybase::Storage::ASE::IdentityRetrieval
  DBIO::Sybase::Storage::ASE::TxnManager
  DBIO::Sybase::Storage
  DBIO::Storage::DBI::AutoCast
  DBIO::Storage::DBI::IdentityInsert
/;
use mro 'c3';
use DBIO::Carp;
use Scalar::Util qw/blessed weaken/;
use List::Util 'first';
use Sub::Name();
use Try::Tiny;
use Context::Preserve 'preserve_context';
use DBIO::Util 'sigwarn_silencer';
use version ();
use namespace::clean;


__PACKAGE__->sql_maker_class('DBIO::Sybase::SQLMaker');
__PACKAGE__->sql_quote_char ([qw/[ ]/]);
__PACKAGE__->datetime_parser_type(
  'DBIO::Sybase::Storage::ASE::DateTime::Format'
);

__PACKAGE__->mk_group_accessors('simple' =>
    qw/_identity _identity_method _blob_log_on_update _parent_storage
       _writer_storage _is_writer_storage
       _bulk_storage _is_bulk_storage _began_bulk_work
    /
);


my @also_proxy_to_extra_storages = qw/
  connect_call_set_auto_cast auto_cast connect_call_blob_setup
  connect_call_datetime_setup

  disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
  auto_savepoint unsafe cursor_class debug debugobj schema
/;


sub _rebless {
  my $self = shift;

  my $no_bind_vars = __PACKAGE__ . '::NoBindVars';

  if ($self->_using_freetds) {
    carp_once <<'EOF' unless $ENV{DBIO_SYBASE_FREETDS_NOWARN};

You are using FreeTDS with Sybase.

We will do our best to support this configuration, but please consider this
support experimental.

TEXT/IMAGE columns will definitely not work.

You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
instead.

See perldoc DBIO::Sybase::Storage::ASE for more details.

To turn off this warning set the DBIO_SYBASE_FREETDS_NOWARN environment
variable.
EOF

    if (not $self->_use_typeless_placeholders) {
      if ($self->_use_placeholders) {
        $self->auto_cast(1);
      }
      else {
        $self->ensure_class_loaded($no_bind_vars);
        bless $self, $no_bind_vars;
        $self->_rebless;
      }
    }
  }

  elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
    # not necessarily FreeTDS, but no placeholders nevertheless
    $self->ensure_class_loaded($no_bind_vars);
    bless $self, $no_bind_vars;
    $self->_rebless;
  }
  # this is highly unlikely, but we check just in case
  elsif (not $self->_use_typeless_placeholders) {
    $self->auto_cast(1);
  }
}

sub _init {
  my $self = shift;

  $self->next::method(@_);

  if (my $ver = $self->_using_freetds && $self->_using_freetds_version) {
    # Only the historic FreeTDS 0.8x line has the known statement-caching bug;
    # parse as a dotted version so 1.x is not coerced to a number (and no
    # "isn't numeric" warning is emitted).
    if (version->parse("v$ver") <= version->parse('v0.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,
# unless this is that storage
  return if $self->_parent_storage;

  my $writer_storage = (ref $self)->new;

  $writer_storage->_is_writer_storage(1); # just info
  $writer_storage->connect_info($self->connect_info);
  $writer_storage->auto_cast($self->auto_cast);

  weaken ($writer_storage->{_parent_storage} = $self);
  $self->_writer_storage($writer_storage);

# create a bulk storage unless connect_info is a coderef
  return if ref($self->_dbi_connect_info->[0]) eq 'CODE';

# FreeTDS' blk-library cannot do BCP ("Type '7' not implemented", and BULK
# INSERT is rejected inside the multi-statement txn DBD::Sybase keeps open).
# Without a bulk storage the _insert_bulk eligibility check falls back to
# regular array inserts, which is the only thing that works under FreeTDS.
  return if $self->_using_freetds;

  my $bulk_storage = (ref $self)->new;

  $bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics
  $bulk_storage->connect_info($self->connect_info);

# this is why
  $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1';

  weaken ($bulk_storage->{_parent_storage} = $self);
  $self->_bulk_storage($bulk_storage);
}

for my $method (@also_proxy_to_extra_storages) {
  no strict 'refs';
  no warnings 'redefine';

  my $replaced = __PACKAGE__->can($method);

  *{$method} = Sub::Name::subname $method => sub {
    my $self = shift;
    $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
    $self->_bulk_storage->$replaced(@_)   if $self->_bulk_storage;
    return $self->$replaced(@_);
  };
}

sub disconnect {
  my $self = shift;

# 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.
# Currently a noop because 'prepare' is used instead of 'prepare_cached'.
  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->next::method;
}

# This is only invoked for FreeTDS drivers by ::Storage::DBI::Sybase::FreeTDS
sub _set_autocommit_stmt {
  my ($self, $on) = @_;

  return 'SET CHAINED ' . ($on ? 'OFF' : 'ON');
}

# Set up session settings for Sybase databases for the connection.
#
# Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
# DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
# we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
# only want when AutoCommit is off.
sub _run_connection_actions {
  my $self = shift;

  if ($self->_is_bulk_storage) {
    # this should be cleared on every reconnect
    $self->_began_bulk_work(0);
    return;
  }

  $self->_dbh->{syb_chained_txn} = 1
    unless $self->_using_freetds;

  $self->next::method(@_);
}