From 7f8f933aef553c33bd2263b27fd29d76be6381b6 Mon Sep 17 00:00:00 2001 From: Nicolas GEORGES Date: Wed, 3 Aug 2016 11:27:37 +0200 Subject: [PATCH 1/4] change datatype sizes for DBI/ADO/MSSQL --- lib/DBIx/Class.pm | 2 +- .../Storage/DBI/ADO/Microsoft_SQL_Server.pm | 16 +- maint/Makefile.PL.inc/29_handle_version.pl | 4 +- script/dbicadmin | 215 ++++++++++++++++++ 4 files changed, 226 insertions(+), 11 deletions(-) diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index ba237a2ee..92c8b202f 100644 --- a/lib/DBIx/Class.pm +++ b/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_01'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases diff --git a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm index 09cbee649..301102343 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm +++ b/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, diff --git a/maint/Makefile.PL.inc/29_handle_version.pl b/maint/Makefile.PL.inc/29_handle_version.pl index 22d21fd2b..4056ee1ce 100644 --- a/maint/Makefile.PL.inc/29_handle_version.pl +++ b/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 diff --git a/script/dbicadmin b/script/dbicadmin index e6066fbc4..36ad27cc7 100755 --- a/script/dbicadmin +++ b/script/dbicadmin @@ -135,3 +135,218 @@ if ($action eq 'select') { 1; __END__ + +=head1 NAME + +dbicadmin - utility for administrating DBIx::Class schemata + +=head1 SYNOPSIS + +dbicadmin: [-I] [long options...] + + deploy a schema to a database + dbicadmin --schema=MyApp::Schema \ + --connect='["dbi:SQLite:my.db", "", ""]' \ + --deploy + + update an existing record + dbicadmin --schema=MyApp::Schema --class=Employee \ + --connect='["dbi:SQLite:my.db", "", ""]' \ + --op=update --set='{ "name": "New_Employee" }' + + + +=head1 OPTIONS + +=over + +=back + +=head2 Actions + +=cut + +=over + +=item B<--create> + +Create version diffs needs preversion + +=cut + +=item B<--upgrade> + +Upgrade the database to the current schema + +=cut + +=item B<--install> + +Install the schema version tables to an existing database + +=cut + +=item B<--deploy> + +Deploy the schema to the database + +=cut + +=item B<--select> + +Select data from the schema + +=cut + +=item B<--insert> + +Insert data into the schema + +=cut + +=item B<--update> + +Update data in the schema + +=cut + +=item B<--delete> + +Delete data from the schema + +=cut + +=item B<--op> + +compatibility option all of the above can be supplied as --op= + +=cut + +=item B<--help> + +display this help + +=cut + +=back + +=head2 Arguments + +=cut + +=over + +=item B<--config-file> or B<--config> + +Supply the config file for parsing by Config::Any + +=cut + +=item B<--connect-info> + +Supply the connect info as trailing options e.g. --connect-info dsn= user= password= + +=cut + +=item B<--connect> + +Supply the connect info as a JSON-encoded structure, e.g. an --connect=["dsn","user","pass"] + +=cut + +=item B<--schema-class> + +The class of the schema to load + +=cut + +=item B<--config-stanza> + +Where in the config to find the connection_info, supply in form MyApp::Model::DB + +=cut + +=item B<--resultset> or B<--resultset-class> or B<--class> + +The resultset to operate on for data manipulation + +=cut + +=item B<--sql-dir> + +The directory where sql diffs will be created + +=cut + +=item B<--sql-type> + +The RDBMs flavour you wish to use + +=cut + +=item B<--version> + +Supply a version install + +=cut + +=item B<--preversion> + +The previous version to diff against + +=cut + +=item B<--set> + +JSON data used to perform data operations + +=cut + +=item B<--attrs> + +JSON string to be used for the second argument for search + +=cut + +=item B<--where> + +JSON string to be used for the where clause of search + +=cut + +=item B<--force> + +Be forceful with some operations + +=cut + +=item B<--trace> + +Turn on DBIx::Class trace output + +=cut + +=item B<--quiet> + +Be less verbose + +=cut + +=item B<-I> + +Same as perl's -I, prepended to current @INC + +=cut + +=back + + +=head1 AUTHORS + +See L + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself + +=cut From 2e0ed6b8f594004d734b597be3d1fb661891b5d8 Mon Sep 17 00:00:00 2001 From: Nicolas GEORGES Date: Wed, 3 Aug 2016 12:39:55 +0200 Subject: [PATCH 2/4] allow intity method IDENT_CURRENT(%s) for MSSQL --- Changes | 3 +++ lib/DBIx/Class.pm | 2 +- lib/DBIx/Class/Storage/DBI/MSSQL.pm | 23 +++++++++++++++++++---- 3 files changed, 23 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index d557c3946..895e2aa37 100644 --- a/Changes +++ b/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 diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index 92c8b202f..2dbe97359 100644 --- a/lib/DBIx/Class.pm +++ b/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_01'; +$VERSION = '0.08270_02'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 34d3745d3..01b128cb8 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/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); From c2cb529de5089ef60b1924aaeaf857ca0c3f4a22 Mon Sep 17 00:00:00 2001 From: Geoffroy Date: Wed, 4 Sep 2019 14:08:32 +0200 Subject: [PATCH 3/4] Quick hack to manage sql server specificities for a part of numerics values with float --- lib/DBIx/Class.pm | 2 +- lib/DBIx/Class/Storage/DBI.pm | 7 ++ .../Storage/DBI/ADO/Microsoft_SQL_Server.pm | 78 +++++++++++++++++++ 3 files changed, 86 insertions(+), 1 deletion(-) diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm index 2dbe97359..3b3e057c5 100644 --- a/lib/DBIx/Class.pm +++ b/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_02'; +$VERSION = '0.08270_03'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 23a7f71e3..1d23261d2 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/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 diff --git a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm index 301102343..2c6ad3398 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm @@ -410,6 +410,84 @@ sub _mssql_max_data_type_representation_size_in_units { } } +=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; From 768018f20ce4753f159abefec6970f512e877daa Mon Sep 17 00:00:00 2001 From: Geoffroy Date: Mon, 9 Sep 2019 13:59:54 +0200 Subject: [PATCH 4/4] delete whitespace for pass units tests --- lib/DBIx/Class/Storage/DBI.pm | 4 ++-- .../Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 1d23261d2..03cbbdbff 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -1871,13 +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 diff --git a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm index 2c6ad3398..09eeb3184 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm @@ -411,15 +411,15 @@ sub _mssql_max_data_type_representation_size_in_units { } =head2 _bind_sth_params_specificities - + Quick hack to manage sql server specificities for a part of numerics values with float - - so use : + + 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 @@ -480,7 +480,7 @@ sub _mssql_max_data_type_representation_size_in_units { } return $ado_type; } - + =cut sub _bind_sth_params_specificities {