lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm

   1 package DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/
   7   DBIx::Class::Storage::DBI::Sybase
   8   DBIx::Class::Storage::DBI::MSSQL
   9 /;
  10 use mro 'c3';
  11 use Carp::Clan qw/^DBIx::Class/;
  12
  13 sub _rebless {
  14   my $self = shift;
  15   my $dbh  = $self->_get_dbh;
  16
  17   return if ref $self ne __PACKAGE__;
  18   if (not $self->_use_typeless_placeholders) {
  19     require
  20       DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars;
  21     bless $self,
  22       'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
  23     $self->_rebless;
  24   }
  25 }
  26
  27 sub _run_connection_actions {
  28   my $self = shift;
  29
  30   # LongReadLen doesn't work with MSSQL through DBD::Sybase, and the default is
  31   # huge on some versions of SQL server and can cause memory problems, so we
  32   # fix it up here (see ::DBI::Sybase.pm)
  33   $self->set_textsize;
  34
  35   $self->next::method(@_);
  36 }
  37
  38 sub _dbh_begin_work {
  39   my $self = shift;
  40
  41   $self->_get_dbh->do('BEGIN TRAN');
  42 }
  43
  44 sub _dbh_commit {
  45   my $self = shift;
  46   my $dbh  = $self->_dbh
  47     or $self->throw_exception('cannot COMMIT on a disconnected handle');
  48   $dbh->do('COMMIT');
  49 }
  50
  51 sub _dbh_rollback {
  52   my $self = shift;
  53   my $dbh  = $self->_dbh
  54     or $self->throw_exception('cannot ROLLBACK on a disconnected handle');
  55   $dbh->do('ROLLBACK');
  56 }
  57
  58 sub _get_server_version {
  59   my $self = shift;
  60
  61   my $product_version = $self->_get_dbh->selectrow_hashref('master.dbo.xp_msver ProductVersion');
  62
  63   if ((my $version = $product_version->{Character_Value}) =~ /^(\d+)\./) {
  64     return $version;
  65   }
  66   else {
  67     $self->throw_exception(
  68       "MSSQL Version Retrieval Failed, Your ProductVersion's Character_Value is missing or malformed!"
  69     );
  70   }
  71 }
  72
  73 =head2 connect_call_datetime_setup
  74
  75 Used as:
  76
  77   on_connect_call => 'datetime_setup'
  78
  79 In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set:
  80
  81   $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
  82
  83 On connection for use with L<DBIx::Class::InflateColumn::DateTime>
  84
  85 This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
  86 C<SMALLDATETIME> columns only have minute precision.
  87
  88 =cut
  89
  90 {
  91   my $old_dbd_warned = 0;
  92
  93   sub connect_call_datetime_setup {
  94     my $self = shift;
  95     my $dbh = $self->_get_dbh;
  96
  97     if ($dbh->can('syb_date_fmt')) {
  98       # amazingly, this works with FreeTDS
  99       $dbh->syb_date_fmt('ISO_strict');
 100     } elsif (not $old_dbd_warned) {
 101       carp "Your DBD::Sybase is too old to support ".
 102       "DBIx::Class::InflateColumn::DateTime, please upgrade!";
 103       $old_dbd_warned = 1;
 104     }
 105   }
 106 }
 107
 108 sub datetime_parser_type {
 109   'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::DateTime::Format'
 110 }
 111
 112 package # hide from PAUSE
 113   DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::DateTime::Format;
 114
 115 my $datetime_parse_format  = '%Y-%m-%dT%H:%M:%S.%3NZ';
 116 my $datetime_format_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
 117
 118 my ($datetime_parser, $datetime_formatter);
 119
 120 sub parse_datetime {
 121   shift;
 122   require DateTime::Format::Strptime;
 123   $datetime_parser ||= DateTime::Format::Strptime->new(
 124     pattern  => $datetime_parse_format,
 125     on_error => 'croak',
 126   );
 127   return $datetime_parser->parse_datetime(shift);
 128 }
 129
 130 sub format_datetime {
 131   shift;
 132   require DateTime::Format::Strptime;
 133   $datetime_formatter ||= DateTime::Format::Strptime->new(
 134     pattern  => $datetime_format_format,
 135     on_error => 'croak',
 136   );
 137   return $datetime_formatter->format_datetime(shift);
 138 }
 139
 140 1;
 141
 142 =head1 NAME
 143
 144 DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Support for Microsoft
 145 SQL Server via DBD::Sybase
 146
 147 =head1 SYNOPSIS
 148
 149 This subclass supports MSSQL server connections via L<DBD::Sybase>.
 150
 151 =head1 DESCRIPTION
 152
 153 This driver tries to determine whether your version of L<DBD::Sybase> and
 154 supporting libraries (usually FreeTDS) support using placeholders, if not the
 155 storage will be reblessed to
 156 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars>.
 157
 158 The MSSQL specific functionality is provided by
 159 L<DBIx::Class::Storage::DBI::MSSQL>.
 160
 161 =head1 AUTHOR
 162
 163 See L<DBIx::Class/CONTRIBUTORS>.
 164
 165 =head1 LICENSE
 166
 167 You may distribute this code under the same terms as Perl itself.
 168
 169 =cut