diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index d5ec19601..d8b6e0dfd 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,7 +33,7 @@ public final class Configuration { * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitId = "3fb27ed18"; + public static final String gitCommitId = "cb3dcd790"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). @@ -48,7 +48,7 @@ public final class Configuration { * Parsed by App::perlbrew and other tools via: perl -V | grep "Compiled at" * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String buildTimestamp = "Apr 29 2026 10:51:13"; + public static final String buildTimestamp = "Apr 29 2026 11:15:25"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java b/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java index ba2902253..d290987bc 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java @@ -425,10 +425,26 @@ public static RuntimeList execute(RuntimeArray args, int ctx) { RuntimeScalar boundParamsRef = sth.get("bound_params"); if (boundParamsRef != null && RuntimeScalarType.isReference(boundParamsRef)) { RuntimeHash boundParams = boundParamsRef.hashDeref(); + RuntimeScalar boundAttrsRef = sth.get("bound_attrs"); + RuntimeHash boundAttrs = (boundAttrsRef != null && RuntimeScalarType.isReference(boundAttrsRef)) + ? boundAttrsRef.hashDeref() : null; for (RuntimeScalar key : boundParams.keys().elements) { int paramIndex = Integer.parseInt(key.toString()); RuntimeScalar val = boundParams.get(key.toString()); - stmt.setObject(paramIndex, toJdbcValue(val)); + int sqlType = boundAttrs != null ? extractSqlType(boundAttrs.get(key.toString())) : 0; + if ((sqlType == 30 /* SQL_BLOB */ + || sqlType == -2 /* SQL_BINARY */ + || sqlType == -3 /* SQL_VARBINARY */ + || sqlType == -4 /* SQL_LONGVARBINARY */) + && val.type != RuntimeScalarType.UNDEF) { + // Treat each Perl character as a raw byte (ISO-8859-1) + // so binary blobs like Storable::freeze() round-trip + // through JDBC TEXT/BLOB columns without UTF-8 mangling. + String s = val.toString(); + stmt.setBytes(paramIndex, s.getBytes(StandardCharsets.ISO_8859_1)); + } else { + stmt.setObject(paramIndex, toJdbcValue(val)); + } } } } @@ -541,11 +557,20 @@ public static RuntimeList fetchrow_arrayref(RuntimeArray args, int ctx) { // level — it always decodes UTF-8 on fetch. Re-encoding to UTF-8 bytes // here restores the byte-level behavior that Perl code expects. for (int i = 1; i <= colCount; i++) { - RuntimeScalar val = RuntimeScalar.newScalarOrString(rs.getObject(i)); - if (val.type == RuntimeScalarType.STRING && val.value instanceof String s) { - byte[] utf8Bytes = s.getBytes(StandardCharsets.UTF_8); - val.value = new String(utf8Bytes, StandardCharsets.ISO_8859_1); + Object obj = rs.getObject(i); + RuntimeScalar val; + if (obj instanceof byte[] bytes) { + // BLOB column — preserve bytes 1:1 by stuffing them into + // a Java String via ISO-8859-1 and tagging as BYTE_STRING. + val = new RuntimeScalar(new String(bytes, StandardCharsets.ISO_8859_1)); val.type = RuntimeScalarType.BYTE_STRING; + } else { + val = RuntimeScalar.newScalarOrString(obj); + if (val.type == RuntimeScalarType.STRING && val.value instanceof String s) { + byte[] utf8Bytes = s.getBytes(StandardCharsets.UTF_8); + val.value = new String(utf8Bytes, StandardCharsets.ISO_8859_1); + val.type = RuntimeScalarType.BYTE_STRING; + } } RuntimeArray.push(row, val); } @@ -619,11 +644,17 @@ public static RuntimeList fetchrow_hashref(RuntimeArray args, int ctx) { for (int i = 1; i <= metaData.getColumnCount(); i++) { String columnName = columnNames.get(i - 1).toString(); Object value = rs.getObject(i); - RuntimeScalar val = RuntimeScalar.newScalarOrString(value); - if (val.type == RuntimeScalarType.STRING && val.value instanceof String s) { - byte[] utf8Bytes = s.getBytes(StandardCharsets.UTF_8); - val.value = new String(utf8Bytes, StandardCharsets.ISO_8859_1); + RuntimeScalar val; + if (value instanceof byte[] bytes) { + val = new RuntimeScalar(new String(bytes, StandardCharsets.ISO_8859_1)); val.type = RuntimeScalarType.BYTE_STRING; + } else { + val = RuntimeScalar.newScalarOrString(value); + if (val.type == RuntimeScalarType.STRING && val.value instanceof String s) { + byte[] utf8Bytes = s.getBytes(StandardCharsets.UTF_8); + val.value = new String(utf8Bytes, StandardCharsets.ISO_8859_1); + val.type = RuntimeScalarType.BYTE_STRING; + } } row.put(columnName, val); } @@ -746,6 +777,22 @@ public static RuntimeList finish(RuntimeArray args, int ctx) { * @param handle The database or statement handle * @param exception The SQL exception that occurred */ + /** + * Extracts a SQL type code from a bind_param attribute argument. + * Real DBI accepts either a plain integer (e.g. SQL_BLOB == 30) or a + * hashref with a TYPE key. Returns 0 if no type is set. + */ + private static int extractSqlType(RuntimeScalar attr) { + if (attr == null || attr.type == RuntimeScalarType.UNDEF) return 0; + if (RuntimeScalarType.isReference(attr)) { + RuntimeHash h = attr.hashDeref(); + RuntimeScalar t = h.get("TYPE"); + if (t != null && t.type != RuntimeScalarType.UNDEF) return t.getInt(); + return 0; + } + return attr.getInt(); + } + /** * Converts a RuntimeScalar to a JDBC-compatible Java object. *

@@ -964,12 +1011,20 @@ public static RuntimeList table_info(RuntimeArray args, int ctx) { Connection conn = (Connection) dbh.get("connection").value; DatabaseMetaData metaData = conn.getMetaData(); - String catalog = args.size() > 1 ? args.get(1).toString() : null; - String schema = args.size() > 2 ? args.get(2).toString() : null; - String table = args.size() > 3 ? args.get(3).toString() : "%"; - String type = args.size() > 4 ? args.get(4).toString() : null; - - ResultSet rs = metaData.getTables(catalog, schema, table, type != null ? new String[]{type} : null); + // Treat undef/empty as null so JDBC drivers apply their default + // matching ("any") instead of looking for a literal empty string. + String catalog = (args.size() > 1 && args.get(1).getDefinedBoolean()) ? args.get(1).toString() : null; + String schema = (args.size() > 2 && args.get(2).getDefinedBoolean()) ? args.get(2).toString() : null; + String table = (args.size() > 3 && args.get(3).getDefinedBoolean()) ? args.get(3).toString() : "%"; + String type = (args.size() > 4 && args.get(4).getDefinedBoolean()) ? args.get(4).toString() : null; + + // Real DBI accepts a comma-separated list of types like "TABLE,VIEW". + // JDBC's getTables() takes a String[] of types instead. + String[] types = null; + if (type != null && !type.isEmpty()) { + types = type.split("\\s*,\\s*"); + } + ResultSet rs = metaData.getTables(catalog, schema, table, types); // Create statement handle for results RuntimeHash sth = createMetadataResultSet(dbh, rs); diff --git a/src/main/perl/lib/DBI.pm b/src/main/perl/lib/DBI.pm index 23c300829..0bab9196c 100644 --- a/src/main/perl/lib/DBI.pm +++ b/src/main/perl/lib/DBI.pm @@ -3,9 +3,30 @@ use strict; use warnings; use Scalar::Util (); use XSLoader; +use Exporter 'import'; our $VERSION = '1.643'; +# SQL type constants exported on demand, e.g. `use DBI qw(SQL_BLOB SQL_VARCHAR)` +# or via the :sql_types tag. Mirrors real DBI's export interface so modules +# like CGI::Session::Driver::sqlite can `use DBI qw(SQL_BLOB)` and use the +# bareword under `use strict`. +our @SQL_TYPES = qw( + SQL_GUID SQL_WLONGVARCHAR SQL_WVARCHAR SQL_WCHAR SQL_BIGINT SQL_BIT + SQL_TINYINT SQL_LONGVARBINARY SQL_VARBINARY SQL_BINARY SQL_LONGVARCHAR + SQL_UNKNOWN_TYPE SQL_ALL_TYPES SQL_CHAR SQL_NUMERIC SQL_DECIMAL SQL_INTEGER + SQL_SMALLINT SQL_FLOAT SQL_REAL SQL_DOUBLE SQL_DATETIME SQL_DATE + SQL_INTERVAL SQL_TIME SQL_TIMESTAMP SQL_VARCHAR SQL_BOOLEAN SQL_UDT + SQL_UDT_LOCATOR SQL_ROW SQL_REF SQL_BLOB SQL_BLOB_LOCATOR SQL_CLOB + SQL_CLOB_LOCATOR SQL_ARRAY SQL_MULTISET SQL_TYPE_DATE SQL_TYPE_TIME + SQL_TYPE_TIMESTAMP SQL_TYPE_TIME_WITH_TIMEZONE + SQL_TYPE_TIMESTAMP_WITH_TIMEZONE +); +our @EXPORT_OK = (@SQL_TYPES); +our %EXPORT_TAGS = ( + sql_types => [@SQL_TYPES], +); + XSLoader::load( 'DBI' ); # DBI::db and DBI::st inherit from DBI so method dispatch works @@ -175,6 +196,30 @@ sub DBI::st::STORABLE_thaw { $self->{Active} = 0; } +# $dbh->tables([$catalog, $schema, $table, $type]) +# Returns a list of table names from table_info(). Names are quoted with +# the database identifier quote (or '"' as a safe default) to match real +# DBI behaviour — callers like CGI::Session's t/g4_sqlite.t strip quotes +# before using the names. +sub DBI::db::tables { + my ($dbh, $catalog, $schema, $table, $type) = @_; + $type = 'TABLE,VIEW' unless defined $type; + my $sth = $dbh->table_info($catalog, $schema, $table, $type) or return; + my $q = eval { $dbh->get_info(29) }; # SQL_IDENTIFIER_QUOTE_CHAR + $q = '"' unless defined $q && length $q; + my @names; + while (my $row = $sth->fetchrow_arrayref) { + my ($cat, $sch, $name) = @$row[0,1,2]; + next unless defined $name; + my $full = ''; + $full .= "$q$cat$q." if defined $cat && length $cat; + $full .= "$q$sch$q." if defined $sch && length $sch; + $full .= "$q$name$q"; + push @names, $full; + } + return @names; +} + sub _handle_error { my ($handle, $err) = @_; if (ref($handle) && Scalar::Util::reftype($handle->{HandleError} || '') eq 'CODE') {