Add DBR::Misc::DBI::Compat shim to restore DBD::mysql 4.036 string behavior

.github/workflows/build-and-test.yml

@@ -0,0 +1,18 @@
+name: Build and Test
+
+on:
+  push:
+
+jobs:
+  test:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - name: Install system dependencies
+        run: sudo apt-get update -qq && sudo apt-get install -y --no-install-recommends cpanminus libncurses-dev libsqlite3-dev
+      - name: Install Perl dependencies
+        run: sudo cpanm --notest --installdeps . && sudo chown -R "$USER:$USER" .
+      - name: Build
+        run: perl Makefile.PL && make
+      - name: Test
+        run: make test

lib/DBR/Config/Instance.pm

@@ -298,6 +298,10 @@ sub _new_connection{
       my $config = $INSTANCES_BY_GUID{ $self->{guid} };
       my @params = ($config->{connectstring}, $config->{user}, $config->{password});
 
+      if ( $config->{connectstring} =~ /^dbi:mysql:/i ) {
+          push @params, { RootClass => 'DBR::Misc::DBI::Compat' };
+      }
+
       my $dbh = DBI->connect(@params);
       unless ($dbh) {
           $self->_log("DBI error attempting to connect to db $config->{handle},$config->{class}: $DBI::errstr");

lib/DBR/Misc/DBI/Compat.pm

@@ -0,0 +1,64 @@
+package DBR::Misc::DBI::Compat;
+
+# DBI RootClass that restores DBD::mysql 4.036 behavior: all values returned
+# by fetch methods are string scalars (SVp_POK), regardless of MySQL column type.
+#
+# Required because DBD::mysql 4.050 returns IV/NV scalars for numeric columns,
+# changing JSON::XS output from quoted strings ("42") to bare numbers (42).
+# Remove this shim once all consumers are verified safe with bare-number encoding.
+
+package DBR::Misc::DBI::Compat::db;
+use parent -norequire, 'DBI::db';
+
+package DBR::Misc::DBI::Compat::st;
+use parent -norequire, 'DBI::st';
+
+sub fetchrow_arrayref {
+    my $row = $_[0]->SUPER::fetchrow_arrayref;
+    return undef unless $row;
+    @$row = map { defined $_ ? "$_" : $_ } @$row;
+    return $row;
+}
+
+*fetch = \&fetchrow_arrayref;
+
+sub fetchrow_array {
+    my @row = $_[0]->SUPER::fetchrow_array;
+    return map { defined $_ ? "$_" : $_ } @row;
+}
+
+sub fetchrow_hashref {
+    my $row = $_[0]->SUPER::fetchrow_hashref(@_[1..$#_]);
+    return undef unless $row;
+    $row->{$_} = "$row->{$_}" for grep { defined $row->{$_} } keys %$row;
+    return $row;
+}
+
+sub fetchall_arrayref {
+    my $self  = shift;
+    my $slice = $_[0];
+    my $rows  = $self->SUPER::fetchall_arrayref(@_);
+    return $rows unless $rows && @$rows;
+    if ( ref($slice) eq 'HASH' ) {
+        for my $row (@$rows) {
+            $row->{$_} = "$row->{$_}" for grep { defined $row->{$_} } keys %$row;
+        }
+    } else {
+        for my $row (@$rows) {
+            @$row = map { defined $_ ? "$_" : $_ } @$row;
+        }
+    }
+    return $rows;
+}
+
+sub fetchall_hashref {
+    my ($self, $key_field) = @_;
+    my $result = $self->SUPER::fetchall_hashref($key_field);
+    return $result unless $result;
+    for my $row (values %$result) {
+        $row->{$_} = "$row->{$_}" for grep { defined $row->{$_} } keys %$row;
+    }
+    return $result;
+}
+
+1;