Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/main/java/org/perlonjava/core/Configuration.java
Original file line number Diff line number Diff line change
Expand Up @@ -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).
Expand All @@ -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() {
Expand Down
85 changes: 70 additions & 15 deletions src/main/java/org/perlonjava/runtime/perlmodule/DBI.java
Original file line number Diff line number Diff line change
Expand Up @@ -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));
}
}
}
}
Expand Down Expand Up @@ -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);
}
Expand Down Expand Up @@ -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);
}
Expand Down Expand Up @@ -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.
* <p>
Expand Down Expand Up @@ -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);
Expand Down
45 changes: 45 additions & 0 deletions src/main/perl/lib/DBI.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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') {
Expand Down
Loading