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