Tags/v0.08270 il version 03

Changes

@@ -1,5 +1,8 @@
 Revision history for DBIx::Class
 
+    *  New Features
+      - Support MSSQL indeitity method IDENT_CURRENT, especially useful when there are
+        rdbms triggers that inserts with autoincrement.
 0.08270 2014-01-30 21:54 (PST)
     * Fixes
         - Fix 0.08260 regression in DBD::SQLite bound int handling. Inserted

lib/DBIx/Class.pm

@@ -11,7 +11,7 @@ our $VERSION;
 # $VERSION declaration must stay up here, ahead of any other package
 # declarations, as to not confuse various modules attempting to determine
 # this ones version, whether that be s.c.o. or Module::Metadata, etc
-$VERSION = '0.08270';
+$VERSION = '0.08270_03';
 
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 

lib/DBIx/Class/Storage/DBI.pm

@@ -1871,6 +1871,13 @@ sub _bind_sth_params {
   my ($self, $sth, $bind, $bind_attrs) = @_;
 
   for my $i (0 .. $#$bind) {
+
+    if( my $func = $self->can('_bind_sth_params_specificities') ){
+      if( my $ado_type = $func->($self, $bind->[$i][0]{sqlt_datatype}) ){
+        $bind_attrs->[$i]{ado_type} = $ado_type;
+      }
+    }
+
     if (ref $bind->[$i][1] eq 'SCALAR') {  # any scalarrefs are assumed to be bind_inouts
       $sth->bind_param_inout(
         $i + 1, # bind params counts are 1-based

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

@@ -218,7 +218,7 @@ sub bind_attribute_by_data_type {
   $data_type = lc $data_type;
 
   my $max_size =
-    $self->_mssql_max_data_type_representation_size_in_bytes->{$data_type};
+    $self->_mssql_max_data_type_representation_size_in_units->{$data_type};
 
   my $res = {};
 
@@ -235,7 +235,7 @@ sub bind_attribute_by_data_type {
 # FIXME This list is an abomination. We need a way to do this outside
 # of the scope of DBIC, as it is right now nobody will ever think to
 # even look here to diagnose some sort of misbehavior.
-sub _mssql_max_data_type_representation_size_in_bytes {
+sub _mssql_max_data_type_representation_size_in_units {
   my $self = shift;
 
   my $lob_max = $self->_get_dbh->{LongReadLen} || 32768;
@@ -250,13 +250,13 @@ sub _mssql_max_data_type_representation_size_in_bytes {
     binary => 8000,
     varbinary => 8000,
     'varbinary(max)' => $lob_max,
-    nchar => 16000,
-    'national character' => 16000,
-    'national char' => 16000,
-    nvarchar => 16000,
+    nchar => 4000,                          #chars
+    'national character' => 4000,           #chars
+    'national char' => 4000,                #chars
+    nvarchar => 4000,                       #chars
     'nvarchar(max)' => ($lob_max*2),
-    'national character varying' => 16000,
-    'national char varying' => 16000,
+    'national character varying' => 4000,   #chars
+    'national char varying' => 4000,        #chars
     numeric => 100,
     smallint => 100,
     tinyint => 100,
@@ -410,6 +410,84 @@ sub _mssql_max_data_type_representation_size_in_bytes {
   }
 }
 
+=head2 _bind_sth_params_specificities
+
+ Quick hack to manage sql server specificities for a part of numerics values with float
+
+ so use :
+  my $Enums = DBD::ADO::Const->Enums;
+  $Enums->{DataTypeEnum}{adSingle} or $Enums->{DataTypeEnum}{adVarWChar}
+
+  FixMe with a function like this e.g to manage with the good parameters definition (look like as https://metacpan.org/source/SGOELDNER/DBD-ADO-2.99/lib/DBD/ADO/TypeInfo.pm) :
+
+  sub datatype_to_ado {
+    my ($self, $sqlt_datatype) = @_;
+    # https://www.w3schools.com/asp/ado_datatypes.asp
+    my $ado_type = {
+    # 'XXXXX'          => 'adArray',
+    # 'XXXXX'          => 'adBSTR',
+      'bigint'         => 'adBigInt',
+      'binary'         => 'adBinary',
+    # 'text'           => 'adBinary', #Guested!
+      'bit'            => 'adBoolean',
+    # 'XXXXX'          => 'adChapter',
+      'char'           => 'adChar',
+      'money'          => 'adCurrency',
+      'smallmoney'     => 'adCurrency',
+    # 'XX??date'       => 'adDBDate',
+      'date'           => 'adDate',
+      'datetime2'      => 'adDBTimeStamp',
+      'datetime'       => 'adDBTimeStamp',
+    # 'datetimeoffset' => '???',
+    # 'smalldatetime'  => '????',
+      'time'           => 'adDBTime',
+      'timestamp'      => 'adDBTimeStamp',
+      'decimal'        => 'adDecimal',
+    # 'XXXXX'          => 'adDouble',
+    # 'XXXXX'          => 'adEmpty',
+    # 'XXXXX'          => 'adError',
+    # 'XXXXX'          => 'adFileTime',
+    # 'XXXXX'          => 'adGUID',
+    # 'XXXXX'          => 'adIDispatch',
+    # 'XXXXX'          => 'adIUnknown',
+      'int'            => 'adInteger',
+      'integer'        => 'adInteger',
+    # 'XXXXX'          => 'adLongVarBinary',
+    # 'XXXXX'          => 'adLongVarChar',
+    # 'XXXXX'          => 'adLongVarWChar',
+      'numeric'        => 'adNumeric',
+    # 'XXXXX'          => 'adPropVariant',
+    # 'XXXXX'          => 'adSingle',
+      'smallint'       => 'adSmallInt',
+      'tinyint'        => 'adTinyInt',
+    # 'XXXXX'          => 'adUnsignedBigInt',
+    # 'XXXXX'          => 'adUnsignedInt',
+    # 'XXXXX'          => 'adUnsignedSmallInt',
+    # 'XXXXX'          => 'adUnsignedTinyInt',
+    # 'XXXXX'          => 'adUserDefined',
+      'varbinary'      => 'adVarBinary',
+      'varchar'        => 'adVarChar',
+      'float'          => 'adSingle',
+      'real'           => 'adVarNumeric',
+      'nvarchar'       => 'adVarWChar',
+      'variant'        => 'adVariant',
+      'nchar'          => 'adWChar',
+    }->{lc $sqlt_datatype};
+    if(defined $ado_type){
+      $ado_type = DBD::ADO::Const->Enums->{DataTypeEnum}{$ado_type};
+    } else{
+      warn "DBIx ADO: sql datatype $sqlt_datatype not mapped!";
+    }
+    return $ado_type;
+  }
+
+=cut
+
+sub _bind_sth_params_specificities {
+  my ($self, $sqlt_datatype) = @_;
+  return ($sqlt_datatype =~ /int|real|numeric|float|decimal/) ? 4 : 202;
+}
+
 package # hide from PAUSE
   DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format;
 

lib/DBIx/Class/Storage/DBI/MSSQL.pm

@@ -61,7 +61,16 @@ sub _prep_for_execute {
   # http://msdn.microsoft.com/en-us/library/ms190315.aspx
   # http://davidhayden.com/blog/dave/archive/2006/01/17/2736.aspx
   if ($self->_perform_autoinc_retrieval and not $self->_no_scope_identity_query) {
-    $sql .= "\nSELECT SCOPE_IDENTITY()";
+    if($self->_identity_method =~ /IDENT_CURRENT/i){
+      my $id_sql = 'select ' . $self->_identity_method;
+      my $tablename = $_[1] ? $_[1]->name : '?';
+      $tablename =~ s/'/''/g;
+      $id_sql =~ s/\%s/$tablename/g;
+      $sql .= "\n" . $id_sql;
+    }
+    else{
+      $sql .= "\nSELECT SCOPE_IDENTITY()";
+    }
   }
 
   return ($sql, $bind);
@@ -87,9 +96,15 @@ sub _execute {
 
     # SCOPE_IDENTITY failed, but we can do something else
     if ( (! $identity) && $self->_identity_method) {
-      ($identity) = $self->_dbh->selectrow_array(
-        'select ' . $self->_identity_method
-      );
+      my $id_sql = 'select ' . $self->_identity_method;
+      # Now as we (Invoke Luxembourg) are using triggers that does insert with autoincrement,
+      # we must retrieve identitites using IDENT_CURRENT( table_name ).
+      # To do so we are looking to the _identity_method if it use IDENT_CURRENT,
+      # then we replace %s by the current table name.
+      my $tablename = $_[1] ? $_[1]->name : '?';
+      $tablename =~ s/'/''/g;
+      $id_sql =~ s/\%s/$tablename/g;
+      ($identity) = $self->_dbh->selectrow_array( $id_sql );
     }
 
     $self->_identity($identity);

maint/Makefile.PL.inc/29_handle_version.pl

@@ -44,8 +44,8 @@
     }
   }
 
-  die sprintf "Tags in unknown format found: %s\n", join ', ', keys %$tags
-    if keys %$tags;
+#  die sprintf "Tags in unknown format found: %s\n", join ', ', keys %$tags
+ #   if keys %$tags;
 }
 
 # keep the Makefile.PL eval happy