diff --git a/dev/modules/data_printer.md b/dev/modules/data_printer.md index f7a8aa883..7598acc06 100644 --- a/dev/modules/data_printer.md +++ b/dev/modules/data_printer.md @@ -4,59 +4,67 @@ - **Module**: Data::Printer 1.002001 - **Test command**: `./jcpan -j 8 -t Data::Printer` -- **Status**: Phase 2c complete + set() fast-path fix — ready for Phase 3 +- **Branch**: `feature/data-printer-phase3` +- **PR**: #434 +- **Status**: Phase 7 complete — 599/647 subtests passing (92.6%) ## Test Results Summary -### Baseline: 15/41 test files passing (191/545 subtests fail) - -### After Phase 1: 23/41 test files passing (33/545 subtests fail) - -### After Phase 2: pending re-run (READONLY_SCALAR type fully wired) - -| Test File | Baseline | After Phase 1 | Notes | -|-----------|----------|---------------|-------| -| t/000-load.t | PASS | PASS | | -| t/000.0-nsort.t | PASS | PASS | | -| t/000.1-home.t | **FAIL** 1/4 | **FAIL** 1/4 | glob `~` not expanded (not `$ENV{HOME}`) | -| t/000.2-warn.t | PASS | PASS | | -| t/001-object.t | PASS | PASS | | -| t/002-scalar.t | **FAIL** 68/72 | **FAIL** 12/72 | Remaining: readonly vars, charnames::viacode, `$!` dualvar | -| t/003-ref.t | **FAIL** 5/7 | **FAIL** 2/7 | weak circular ref detection | -| t/004-vstring.t | **FAIL** 1/1 | PASS | Fixed by isweak | -| t/005-lvalue.t | **FAIL** 2/2 | **FAIL** 2/2 | LVALUE ref type detection | -| t/006-glob.t | PASS | PASS | | -| t/007.format.t | **FAIL** 1/1 | **FAIL** 1/1 | FORMAT reference returns undef | -| t/008-regex.t | PASS | PASS | | -| t/009-array.t | **FAIL** 18/18 | **FAIL** 1/18 | 1 remaining: weak circular ref | -| t/010-hashes.t | **FAIL** 16/16 | PASS | Fixed by isweak | -| t/011-class.t | **FAIL** 27/38 | **FAIL** 2/38 | 2 remaining + 11 planned didn't run (B::CV::ROOT) | -| t/011.1-attributes.t | PASS | PASS | | -| t/011.2-roles.t | PASS | PASS | | -| t/011.3-object_pad.t | PASS | PASS | | -| t/012-code.t | **FAIL** 4/4 | **FAIL** 4/4 | `B::CV::ROOT` missing - crash | -| t/013-refcount.t | **FAIL** 16/17 | **FAIL** 16/17 | `B::SV::RV` missing - crash | -| t/014-memsize.t | PASS | PASS | | -| t/015-multiline.t | **FAIL** 1/1 | PASS | Fixed by isweak | -| t/016-merge_options.t | PASS | PASS | | -| t/017-rc_file.t | PASS | PASS | | -| t/018-alias.t | **FAIL** 1/1 | PASS | Fixed by isweak | -| t/019-output.t | **FAIL** 0 ran | **FAIL** 0 ran | `SEEK_SET` bareword error | -| t/020-return_value.t | SKIP | SKIP | Capture::Tiny not found | -| t/021-p_vs_object.t | **FAIL** 24/26 | **FAIL** 24/26 | `B::SV::RV` missing | -| t/022-no_prototypes.t | **FAIL** 4/7 | **FAIL** 1/7 | 1 remaining: readonly on `"test"` literal | -| t/023-filters.t | **FAIL** 11/11 | PASS | Fixed by isweak | -| t/024-tied.t | **FAIL** 18/18 | **FAIL** 14/18 | ClassCastException + untie issue | -| t/025-profiles.t | **FAIL** 4/34 | **FAIL** 4/34 | Dumper profile: lvalue/format + glob name + B::CV::ROOT | -| t/026-caller_message.t | **FAIL** 2/2 | PASS | Fixed by isweak | -| t/027-nativeperlclass.t | SKIP | SKIP | `class` keyword | -| t/100-filter_datetime.t | **FAIL** 6/21 | PASS | Fixed by isweak | -| t/101-filter_db.t | **FAIL** 23/24 | **FAIL** 23/24 | DBI not connecting | -| t/102-filter_digest.t | **FAIL** 3/21 | **FAIL** 3/21 | Digest filter | -| t/103-filter_contenttype.t | **FAIL** 6/32 | **FAIL** 1/32 | 1 remaining: hexdump trailing nulls | -| t/104-filter_web.t | **FAIL** 7/21 | PASS | Fixed by isweak | -| t/998-color.t | **FAIL** 1/1 | **FAIL** 1/1 | crash | -| t/999-themes.t | PASS | PASS | | +| Milestone | Test files passing | Subtests passing | Pass rate | +|-----------|-------------------|-----------------|-----------| +| Baseline | 15/41 | 354/545 | 65.0% | +| After Phase 1 | 23/41 | 512/545 | 93.9% | +| After Phase 2 | 23/41 | 512/545 | 93.9% | +| After Phase 3-6 | **29/41** | **576/624** | **92.3%** | +| After Phase 7 (DBI) | **29/41** | **599/647** | **92.6%** | + +Note: subtest totals changed between runs because some tests that previously crashed now run to completion, adding subtests to the total. + +### Current Test Status (After Phase 7) + +| Test File | Status | Failures | Root Cause | +|-----------|--------|----------|------------| +| t/000-load.t | PASS | | | +| t/000.0-nsort.t | PASS | | | +| t/000.1-home.t | **PASS** | | Fixed Phase 6e: glob tilde uses %ENV{HOME} | +| t/000.2-warn.t | PASS | | | +| t/001-object.t | PASS | | | +| t/002-scalar.t | **FAIL** 4/72 | 2,4,36-37 | Read-only constant detection | +| t/003-ref.t | **FAIL** 2/7 | 5-6 | Weak ref detection (JVM limitation) | +| t/004-vstring.t | PASS | | | +| t/005-lvalue.t | **FAIL** 2/2 | 1-2 | LVALUE ref type not implemented | +| t/006-glob.t | PASS | | | +| t/007.format.t | **FAIL** 1/1 | 1 | FORMAT ref type not implemented | +| t/008-regex.t | PASS | | | +| t/009-array.t | **FAIL** 1/18 | 4 | Weak circular ref (JVM limitation) | +| t/010-hashes.t | PASS | | | +| t/011-class.t | **PASS** | | Fixed Phase 6a: UNIVERSAL methods | +| t/011.1-attributes.t | PASS | | | +| t/011.2-roles.t | PASS | | | +| t/011.3-object_pad.t | PASS | | | +| t/012-code.t | **FAIL** 2/4 | 2,4 | B::Deparse not implemented | +| t/013-refcount.t | **FAIL** 12/17 | 1-3,5-8,11-13,16-17 | Refcount/weak refs (JVM limitation) | +| t/014-memsize.t | PASS | | | +| t/015-multiline.t | PASS | | | +| t/016-merge_options.t | PASS | | | +| t/017-rc_file.t | PASS | | | +| t/018-alias.t | PASS | | | +| t/019-output.t | SKIP | | Capture::Tiny not found | +| t/020-return_value.t | SKIP | | Capture::Tiny not found | +| t/021-p_vs_object.t | **FAIL** 11/26 | 3,5,7,9,11,13,15,17,19,23,25 | Refcount/weak refs (JVM limitation) | +| t/022-no_prototypes.t | PASS | | | +| t/023-filters.t | PASS | | | +| t/024-tied.t | **PASS** | | Fixed Phase 6d: FETCH caching on untie | +| t/025-profiles.t | **FAIL** 10/34 | 20-23,25,29-33 | LVALUE/FORMAT ref types missing (see below) | +| t/026-caller_message.t | PASS | | | +| t/027-nativeperlclass.t | SKIP | | `class` keyword not implemented | +| t/100-filter_datetime.t | PASS | | | +| t/101-filter_db.t | **FAIL** 1/24 | 8 | DESTROY not supported — `undef $sth` can't decrement Kids (16 DBIC skipped) | +| t/102-filter_digest.t | **PASS** | | Fixed Phase 6f: Digest::SHA @ISA | +| t/103-filter_contenttype.t | **FAIL** 1/32 | 29 | Hexdump trailing null bytes | +| t/104-filter_web.t | PASS | | | +| t/998-color.t | **FAIL** 1/1 | 1 | Refcount in colored output (JVM limitation) | +| t/999-themes.t | PASS | | | ## Completed Phases @@ -123,79 +131,100 @@ Lvalue operators (`substr`, `vec`, `chop`, `++/--`) already work correctly — w - **Files**: `RuntimeScalarType.java`, `ScalarSpecialVariable.java`, `RuntimeScalar.java` - **Regression tests**: re/subst.t 228/281 (restored), op/svflags.t 16/23 (baseline) -## Remaining Error Categories +### Phase 3: B module stubs (COMPLETED 2026-04-03) -### 1. HIGH: Missing `B::CV::ROOT` and `B::SV::RV` methods +**Fixed**: Missing B module introspection methods that caused crashes in Data::Printer. -- **Affected tests**: t/012-code.t (4), t/013-refcount.t (16), t/021-p_vs_object.t (24), t/011-class.t (11 didn't run) -- **Root cause**: `B.pm` stub doesn't define `ROOT` on `B::CV` or `RV` on `B::SV` -- **Fix**: Add stub methods to `src/main/perl/lib/B.pm` - - `B::CV::ROOT` → return `B::OP->new()` (Data::Printer checks if coderef has a body) - - `B::SV::RV` → return the referenced value wrapped in a B:: object +- `B::CV::ROOT` → return `B::OP->new()` (all subs have bodies on JVM) +- `B::CV::const_sv` → return `\0` (non-constant subs) +- `B::class()` → strip `B::` prefix from ref (utility for Data::Printer) +- `B::NULL` package → for undefined/stub sub detection +- `B::SV::RV` → unwrap one level of reference +- Exported `class` in `@EXPORT_OK` +- **Files**: `src/main/perl/lib/B.pm` -### 2. MEDIUM: `charnames::viacode` returns empty strings +### Phase 4: charnames, File::Temp, glob tilde (COMPLETED 2026-04-03) -- **Affected tests**: t/002-scalar.t (3 unicode_charnames tests) -- **Root cause**: `_charnames.pm` does `do "unicore/Name.pl"` but that file doesn't exist. ICU4J has `UCharacter.getName()` available but unused. -- **Fix**: Either generate `unicore/Name.pl` via `dev/import-perl5/sync.pl`, or add a Java-side `charnames::viacode` using ICU4J's `UCharacter.getName(codePoint)` +- **4a**: `charnames::viacode` via ICU4J — Created `Charnames.java` with `_java_viacode` using `UCharacter.getName()`. Modified `_charnames.pm` to use Java fallback when `unicore/Name.pl` unavailable. Registered in GlobalContext with `setInc=false` to not block Perl module loading. +- **4b**: `File::Temp :seekable` export — Added SEEK_SET/SEEK_CUR/SEEK_END to `:seekable` tag and `@EXPORT_OK`. Fixed "Bareword SEEK_SET not allowed" in strict subs. +- **4c**: Glob tilde expansion — Added `expandTilde()` to `ScalarGlobOperatorHelper.java`. Reads `$ENV{HOME}` from Perl's `%ENV` first, falls back to `System.getProperty("user.home")`. +- **Files**: `Charnames.java`, `GlobalContext.java`, `_charnames.pm`, `File/Temp.pm`, `ScalarGlobOperatorHelper.java` -### 3. MEDIUM: `SEEK_SET` bareword error in t/019-output.t +### Phase 5: Tied variable ClassCastException fix (COMPLETED 2026-04-03) -- **Affected tests**: t/019-output.t (all) -- **Root cause**: `Bareword "SEEK_SET" not allowed while "strict subs"`. Fcntl.pm defines SEEK_SET correctly but the test may use `use Fcntl;` (default export) which doesn't include SEEK_SET. Need to check the actual test code — may be a missing `:seek` tag or Fcntl export issue. +**Fixed**: Crash when `tied`/`untie` called on tied array/hash elements. -### 4. MEDIUM: Tied variable ClassCastException +- Three TiedVariableBase subclasses (TieScalar, RuntimeTiedArrayProxyEntry, RuntimeTiedHashProxyEntry) all stored with `type = TIED_SCALAR`, but code blindly cast to `TieScalar`. +- Added `instanceof TieScalar` guards in `tiedDestroy()` and `tiedUntie()` +- Fixed `TieOperators.untie()` REFERENCE case with `instanceof TieScalar` pattern match +- Fixed `TieOperators.tied()` REFERENCE case with `instanceof TiedVariableBase` + null check +- **Files**: `TieScalar.java`, `TieOperators.java` -- **Affected tests**: t/024-tied.t (crashes after test 5) -- **Root cause**: `RuntimeTiedArrayProxyEntry cannot be cast to TieScalar` — unsafe casts in `TieScalar.java` (lines 42,49) and `TieOperators.java` (lines 126,190) -- **Fix**: Use `instanceof TiedVariableBase` checks before casting. `getSelf()` exists on `TiedVariableBase`. Handle proxy entries differently in `untie()`/`tied()`. +### Phase 6: Data::Printer-specific fixes (COMPLETED 2026-04-03) -### 5. MEDIUM: glob `~` not expanded (t/000.1-home.t) +**6a - UNIVERSAL methods in class introspection**: +- Set `code.packageName` and `code.subName` in `PerlModuleBase.registerMethod()` so all Java-implemented builtins have proper names via `Sub::Util::subname()`. +- Data::Printer skips methods named `__ANON__` — all UNIVERSAL methods were reported as `__ANON__` because RuntimeCode objects created by `registerMethod()` had no name set. +- **Files**: `PerlModuleBase.java` -- **Affected tests**: t/000.1-home.t (1 failure) -- **Root cause**: Data::Printer uses `glob("~")` to find home dir. `ScalarGlobOperator.java` and `File::Glob::bsd_glob` have no tilde expansion. `$ENV{HOME}` works fine — it's the glob that returns literal `~`. -- **Fix**: Add tilde expansion to `ScalarGlobOperator.java`: when pattern starts with `~`, replace with `System.getProperty("user.home")` +**6b - $! (errno) as proper dualvar**: +- Changed `ErrnoVariable` to use `DUALVAR` type with `DualVar` value object in constructor, `set(int)`, and `set(String)`. Copies of `$!` now preserve both string ("No such file or directory") and numeric (2) representations. +- Fixed `local $!`: Added `ErrnoVariable` to special cases in `GlobalRuntimeScalar.makeLocal()` so the ErrnoVariable instance is preserved (not replaced with a plain GlobalRuntimeScalar). Overrode `dynamicSaveState`/`dynamicRestoreState` to save/restore the `errno` and `message` fields. +- **Root cause of `local $!` failure**: `GlobalRuntimeScalar.makeLocal()` was replacing the ErrnoVariable with a new plain GlobalRuntimeScalar in the global variable map. Subsequent `$! = 2` called the base class `set(int)` which just set `type = INTEGER`, losing the dualvar behavior. +- **Files**: `ErrnoVariable.java`, `GlobalRuntimeScalar.java` -### 6. LOW: LVALUE ref detection, DBI, FORMAT, color, Digest +**6c - Tied scalar FETCH caching**: +- Cache FETCH result in `TieScalar.tiedFetch()` by updating `previousValue.type`/`previousValue.value`. After untie, the cached FETCH result is restored instead of the pre-tie value, matching Perl 5's SV caching behavior. +- **Files**: `TieScalar.java` -- LVALUE ref detection (t/005-lvalue.t) -- DBI filter (t/101-filter_db.t) -- FORMAT reference (t/007.format.t) -- Color/ANSI (t/998-color.t) -- Digest filter (t/102-filter_digest.t) -- Dumper profile (t/025-profiles.t) +**6d - Glob tilde uses %ENV{HOME}**: +- Updated `expandTilde()` to read `$ENV{HOME}` from Perl's `%ENV` hash (`GlobalVariable.getGlobalHash("main::ENV")`) before falling back to Java's `System.getProperty("user.home")`. +- **Files**: `ScalarGlobOperatorHelper.java` -## Fix Plan (Remaining Phases) +**6e - Digest::SHA @ISA**: +- Changed `@ISA = qw(Exporter)` to `@ISA = qw(Exporter Digest::base)`. The previous assignment was overwriting the `Digest::base` parent set by `use base "Digest::base"` on the line above. +- **Files**: `src/main/perl/lib/Digest/SHA.pm` -### Phase 3: B module stubs (NEXT) +### Phase 7: DBI filter support (COMPLETED 2026-04-03) -| Step | Issue | Files | Expected impact | -|------|-------|-------|-----------------| -| 3a | Add `B::CV::ROOT` stub | src/main/perl/lib/B.pm | t/012-code.t, t/011-class.t | -| 3b | Add `B::SV::RV` stub | src/main/perl/lib/B.pm | t/013-refcount.t, t/021-p_vs_object.t | +**Fixed**: DBI connect failures preventing Data::Printer's DB filter tests from running. -### Phase 4: charnames::viacode + SEEK_SET + glob tilde +- **DSN attribute parsing**: Updated DBI.pm connect wrapper regex from `/^dbi:(\w+):(.*)$/i` to `/^dbi:(\w+)(?:\(([^)]*)\))?:(.*)$/i` to handle attribute syntax like `dbi:Mem(RaiseError=1):`. Parses embedded attributes and merges into `$attr` hash. +- **DBI.java connect()**: Removed `args.size() < 4` requirement — defaults user/pass to empty string when not provided. +- **DBI::db / DBI::st class names**: Changed `bless ... "DBI"` to `bless ... "DBI::db"` for database handles and `bless ... "DBI::st"` for statement handles. Added `@DBI::db::ISA = ('DBI')` and `@DBI::st::ISA = ('DBI')` for method inheritance. Data::Printer's DB filter registers for `DBI::db` and `DBI::st` classes specifically. +- **Handle attribute tracking**: Initialize `Kids`, `ActiveKids`, `Statement` on connect. Increment `Kids` and set `Statement` on prepare. Only increment `ActiveKids` for result-returning statements (`NUM_OF_FIELDS > 0`). Decrement `ActiveKids` on finish. Set `Active = 0` on disconnect. +- **$sth->{Statement}**: Set to SQL string in Java prepare method (was only stored as lowercase `sql`). +- **$dbh->{Name}**: Set to DSN rest (e.g., `dbname=:memory:`) instead of full JDBC URL. The DB filter parses this with `split /[;=]/` to show key-value pairs. +- **DBD::Mem shim**: New file `src/main/perl/lib/DBD/Mem.pm` that maps `dbi:Mem:` to `jdbc:sqlite::memory:` (using bundled sqlite-jdbc driver). +- **Result**: t/101-filter_db.t went from 0/8 DBI tests passing to 7/8 passing. Remaining 1 failure: `undef $sth` can't decrement Kids because DESTROY is not supported. +- **Files**: `DBI.pm`, `DBI.java`, `DBD/Mem.pm` -| Step | Issue | Files | Expected impact | -|------|-------|-------|-----------------| -| 4a | Implement `charnames::viacode` via ICU4J | Java-side or sync.pl | t/002-scalar.t unicode tests | -| 4b | Fix Fcntl SEEK_SET export | Investigate test code | t/019-output.t | -| 4c | Add glob `~` tilde expansion | ScalarGlobOperator.java | t/000.1-home.t | +## Remaining Failures (48/647 subtests) -### Phase 5: Tied variable cast fix +### Unfixable (JVM limitations) — ~29 subtests -| Step | Issue | Files | Expected impact | -|------|-------|-------|-----------------| -| 5a | Fix unsafe TieScalar casts | TieScalar.java, TieOperators.java | t/024-tied.t | +| Category | Tests | Subtests | Why | +|----------|-------|----------|-----| +| Weak references | t/003-ref, t/009-array | 3 | `weaken`/`isweak` not implemented; JVM uses GC, not refcounting | +| Refcount tracking | t/013-refcount, t/021-p_vs_object | 23 | JVM has no SV refcount; `Scalar::Util::refcount` would need JVM-specific instrumentation | +| Colored refcount | t/998-color | 1 | Same colored output includes `(refcount: 2)` which we can't produce | +| DESTROY cleanup | t/101-filter_db | 1 | `undef $sth` can't decrement Kids count without DESTROY support | -### Phase 6: Low priority +### Missing ref types — ~13 subtests -- LVALUE ref detection (t/005-lvalue.t) -- DBI filter (t/101-filter_db.t) -- FORMAT reference (t/007.format.t) -- Color/ANSI (t/998-color.t) -- Digest filter (t/102-filter_digest.t) -- Dumper profile (t/025-profiles.t) +| Category | Tests | Subtests | Why | +|----------|-------|----------|-----| +| LVALUE refs | t/005-lvalue (2), t/025-profiles (partial) | 2 | `\substr(...)` creates a plain scalar ref, not an LVALUE ref. `reftype` returns "SCALAR" not "LVALUE". | +| FORMAT refs | t/007.format (1), t/025-profiles (partial) | 1 | Format references not implemented on JVM. | +| Profile cascading | t/025-profiles | 10 | The Dumper and JSON profiles iterate all ref types and check which ones they can serialize. Missing LVALUE and FORMAT types cause off-by-one in the type list, shifting all warning messages. For example, the JSON profile reports "cannot express vstrings" where it should say "cannot express subroutines" because the type array is shifted. | + +### Other — 6 subtests + +| Category | Tests | Subtests | Why | +|----------|-------|----------|-----| +| Read-only constants | t/002-scalar | 4 | Literal `123` not detected as read-only. `Scalar::Util::readonly(123)` returns 0 because PerlOnJava's `$` prototype copies the value, losing the read-only flag. Tests 36-37: `Internals::SvREADONLY` on a ref shows stringified ref instead of value. | +| B::Deparse | t/012-code | 2 | Code decompilation not possible — JVM bytecode can't be decompiled back to Perl. Shows `sub { "DUMMY" }` instead of actual code body. | +| ContentType hex dump | t/103-filter_contenttype | 1 | Hexdump shows trailing null bytes `00000000` that Perl 5 doesn't. Minor string truncation difference. | ### Future: MAGIC type consolidation diff --git a/src/main/java/org/perlonjava/core/Configuration.java b/src/main/java/org/perlonjava/core/Configuration.java index d4c3c2616..3bc3d27dd 100644 --- a/src/main/java/org/perlonjava/core/Configuration.java +++ b/src/main/java/org/perlonjava/core/Configuration.java @@ -33,14 +33,14 @@ 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 = "03c7e14f2"; + public static final String gitCommitId = "dc22ca34e"; /** * Git commit date of the build (ISO format: YYYY-MM-DD). * Automatically populated by Gradle/Maven during build. * DO NOT EDIT MANUALLY - this value is replaced at build time. */ - public static final String gitCommitDate = "2026-04-03"; + public static final String gitCommitDate = "2026-04-04"; // Prevent instantiation private Configuration() { diff --git a/src/main/java/org/perlonjava/runtime/operators/ScalarGlobOperatorHelper.java b/src/main/java/org/perlonjava/runtime/operators/ScalarGlobOperatorHelper.java index 32f9e04e5..1e64a3ca0 100644 --- a/src/main/java/org/perlonjava/runtime/operators/ScalarGlobOperatorHelper.java +++ b/src/main/java/org/perlonjava/runtime/operators/ScalarGlobOperatorHelper.java @@ -486,6 +486,9 @@ static List processPattern(ScalarGlobOperator scalarGlobOperator, String // Process each pattern for (String singlePattern : patterns) { + // Expand tilde to home directory + singlePattern = expandTilde(singlePattern); + // Expand braces first List expandedPatterns = expandBraces(singlePattern); @@ -497,6 +500,36 @@ static List processPattern(ScalarGlobOperator scalarGlobOperator, String return results; } + /** + * Expands a leading tilde (~) to the user's home directory. + * "~" becomes "/home/user", "~/foo" becomes "/home/user/foo". + */ + private static String expandTilde(String pattern) { + if (pattern.equals("~") || pattern.startsWith("~/")) { + // Check Perl's %ENV{HOME} first (may be overridden by user), + // then fall back to Java system property + String home = null; + try { + org.perlonjava.runtime.runtimetypes.RuntimeHash envHash = + org.perlonjava.runtime.runtimetypes.GlobalVariable.getGlobalHash("main::ENV"); + org.perlonjava.runtime.runtimetypes.RuntimeScalar envHome = envHash.get("HOME"); + if (envHome != null && envHome.getDefinedBoolean()) { + home = envHome.toString(); + } + } catch (Exception e) { + // ignore - fall through to system property + } + if (home == null || home.isEmpty()) { + home = System.getProperty("user.home"); + } + if (pattern.equals("~")) { + return home; + } + return home + pattern.substring(1); + } + return pattern; + } + /** * Parses a pattern string into individual patterns, handling quoted sections. * diff --git a/src/main/java/org/perlonjava/runtime/operators/TieOperators.java b/src/main/java/org/perlonjava/runtime/operators/TieOperators.java index 9cf695b79..fd8baceae 100644 --- a/src/main/java/org/perlonjava/runtime/operators/TieOperators.java +++ b/src/main/java/org/perlonjava/runtime/operators/TieOperators.java @@ -120,10 +120,10 @@ public static RuntimeScalar untie(int ctx, RuntimeBase... scalars) { switch (variable.type) { case REFERENCE -> { RuntimeScalar scalar = variable.scalarDeref(); - if (scalar.type == TIED_SCALAR) { + if (scalar.type == TIED_SCALAR && scalar.value instanceof TieScalar tieScalar) { TieScalar.tiedUntie(scalar); TieScalar.tiedDestroy(scalar); - RuntimeScalar previousValue = ((TieScalar) scalar.value).getPreviousValue(); + RuntimeScalar previousValue = tieScalar.getPreviousValue(); scalar.type = previousValue.type; scalar.value = previousValue.value; } @@ -187,7 +187,12 @@ public static RuntimeScalar tied(int ctx, RuntimeBase... scalars) { case REFERENCE -> { RuntimeScalar scalar = variable.scalarDeref(); if (scalar.type == TIED_SCALAR) { - return ((TieScalar) scalar.value).getSelf(); + if (scalar.value instanceof TiedVariableBase tvb) { + RuntimeScalar selfObj = tvb.getSelf(); + if (selfObj != null) { + return selfObj; + } + } } // Handle tied($$glob_ref) where $$glob_ref evaluates to a GLOB wrapped in a reference. // In Perl 5, tied($$fh) when the glob is tied via tie(*$fh, ...) returns the tied object. diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Charnames.java b/src/main/java/org/perlonjava/runtime/perlmodule/Charnames.java new file mode 100644 index 000000000..dd7caf0ed --- /dev/null +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Charnames.java @@ -0,0 +1,45 @@ +package org.perlonjava.runtime.perlmodule; + +import com.ibm.icu.lang.UCharacter; +import org.perlonjava.runtime.runtimetypes.RuntimeArray; +import org.perlonjava.runtime.runtimetypes.RuntimeList; +import org.perlonjava.runtime.runtimetypes.RuntimeScalar; + +import static org.perlonjava.runtime.runtimetypes.RuntimeScalarCache.scalarUndef; + +/** + * Java-side implementation for _charnames module. + * Provides Unicode character name lookup via ICU4J. + */ +public class Charnames extends PerlModuleBase { + + public Charnames() { + super("_charnames", false); // Don't set %INC - let the Perl _charnames.pm load normally + } + + public static void initialize() { + Charnames charnames = new Charnames(); + try { + charnames.registerMethod("_java_viacode", "javaViacode", "$"); + } catch (NoSuchMethodException e) { + System.err.println("Warning: Missing _charnames method: " + e.getMessage()); + } + } + + /** + * Returns the Unicode character name for a given code point. + * Uses ICU4J's UCharacter.getName() which provides full Unicode name data. + * + * @param args Code point as integer + * @param ctx Context + * @return Character name string, or undef if not found + */ + public static RuntimeList javaViacode(RuntimeArray args, int ctx) { + int codePoint = args.getFirst().getInt(); + String name = UCharacter.getName(codePoint); + if (name == null || name.isEmpty()) { + return new RuntimeList(scalarUndef); + } + return new RuntimeList(new RuntimeScalar(name)); + } +} diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java b/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java index 516f695fa..a7775c72b 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/DBI.java @@ -116,14 +116,12 @@ public static RuntimeList connect(RuntimeArray args, int ctx) { String jdbcUrl = args.size() > 1 ? args.get(1).toString() : ""; return executeWithErrorHandling(() -> { - if (args.size() < 4) { - throw new IllegalStateException("Bad number of arguments for DBI->connect"); - } - - // Extract connection parameters from args - dbh.put("Username", new RuntimeScalar(args.get(2).toString())); - dbh.put("Password", new RuntimeScalar(args.get(3).toString())); - RuntimeScalar attr = args.get(4); // \%attr + // Extract connection parameters from args, defaulting user/pass to empty + String username = args.size() > 2 ? args.get(2).toString() : ""; + String password = args.size() > 3 ? args.get(3).toString() : ""; + dbh.put("Username", new RuntimeScalar(username)); + dbh.put("Password", new RuntimeScalar(password)); + RuntimeScalar attr = args.size() > 4 ? args.get(4) : new RuntimeScalar(); // Set dbh attributes dbh.put("ReadOnly", scalarFalse); @@ -157,7 +155,7 @@ public static RuntimeList connect(RuntimeArray args, int ctx) { dbh.put("Name", new RuntimeScalar(jdbcUrl)); // Create blessed reference for Perl compatibility - RuntimeScalar dbhRef = ReferenceOperators.bless(dbh.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar dbhRef = ReferenceOperators.bless(dbh.createReference(), new RuntimeScalar("DBI::db")); return dbhRef.getList(); }, dbh, "connect('" + jdbcUrl + "','" + dbh.get("Username") + "',...) failed"); } @@ -212,6 +210,7 @@ public static RuntimeList prepare(RuntimeArray args, int ctx) { // Create statement handle (sth) hash sth.put("statement", new RuntimeScalar(stmt)); sth.put("sql", new RuntimeScalar(sql)); + sth.put("Statement", new RuntimeScalar(sql)); sth.put("Type", new RuntimeScalar("st")); // Add NUM_OF_FIELDS by getting metadata @@ -237,7 +236,7 @@ public static RuntimeList prepare(RuntimeArray args, int ctx) { sth.put("NUM_OF_PARAMS", new RuntimeScalar(numParams)); // Create blessed reference for statement handle - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); dbh.get("sth").set(sthRef); @@ -260,7 +259,7 @@ public static RuntimeList last_insert_id(RuntimeArray args, int ctx) { // Use database-specific SQL to retrieve the last auto-generated ID. // This is more reliable than getGeneratedKeys() because it works // regardless of which statement was most recently prepared/executed. - String jdbcUrl = finalDbh.get("Name").toString(); + String jdbcUrl = conn.getMetaData().getURL(); String sql; if (jdbcUrl.contains("sqlite")) { sql = "SELECT last_insert_rowid()"; @@ -268,10 +267,8 @@ public static RuntimeList last_insert_id(RuntimeArray args, int ctx) { sql = "SELECT LAST_INSERT_ID()"; } else if (jdbcUrl.contains("postgresql")) { sql = "SELECT lastval()"; - } else if (jdbcUrl.contains("h2")) { - sql = "SELECT SCOPE_IDENTITY()"; } else { - // Generic fallback: try getGeneratedKeys() on the last statement + // Generic fallback (H2, etc.): use getGeneratedKeys() on the last statement RuntimeScalar sthRef = finalDbh.get("sth"); if (sthRef != null && RuntimeScalarType.isReference(sthRef)) { RuntimeHash sth = sthRef.hashDeref(); @@ -657,7 +654,6 @@ public static RuntimeList disconnect(RuntimeArray args, int ctx) { return executeWithErrorHandling(() -> { Connection conn = (Connection) dbh.get("connection").value; - String name = dbh.get("Name").toString(); conn.close(); dbh.put("Active", new RuntimeScalar(false)); @@ -835,7 +831,7 @@ public static RuntimeList table_info(RuntimeArray args, int ctx) { // Create statement handle for results RuntimeHash sth = createMetadataResultSet(dbh, rs); - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); return sthRef.getList(); }, dbh, "table_info"); } @@ -853,7 +849,7 @@ public static RuntimeList column_info(RuntimeArray args, int ctx) { // For SQLite, use PRAGMA table_info() to preserve original type case // (JDBC getColumns() uppercases type names like varchar -> VARCHAR) - String jdbcUrl = dbh.get("Name").toString(); + String jdbcUrl = conn.getMetaData().getURL(); if (jdbcUrl.contains("sqlite")) { return columnInfoViaPragma(dbh, conn, table); } @@ -868,7 +864,7 @@ public static RuntimeList column_info(RuntimeArray args, int ctx) { ResultSet rs = metaData.getColumns(catalog, schema, table, column); RuntimeHash sth = createMetadataResultSet(dbh, rs); - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); return sthRef.getList(); }, dbh, "column_info"); } @@ -956,7 +952,7 @@ private static RuntimeList columnInfoViaPragma(RuntimeHash dbh, Connection conn, result.put("has_resultset", scalarTrue); sth.put("execute_result", result.createReference()); - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); return sthRef.getList(); } @@ -978,7 +974,7 @@ public static RuntimeList primary_key_info(RuntimeArray args, int ctx) { ResultSet rs = metaData.getPrimaryKeys(catalog, schema, table); RuntimeHash sth = createMetadataResultSet(dbh, rs); - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); return sthRef.getList(); }, dbh, "primary_key_info"); } @@ -1005,7 +1001,7 @@ public static RuntimeList foreign_key_info(RuntimeArray args, int ctx) { fkCatalog, fkSchema, fkTable); RuntimeHash sth = createMetadataResultSet(dbh, rs); - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); return sthRef.getList(); }, dbh, "foreign_key_info"); } @@ -1019,7 +1015,7 @@ public static RuntimeList type_info(RuntimeArray args, int ctx) { ResultSet rs = metaData.getTypeInfo(); RuntimeHash sth = createMetadataResultSet(dbh, rs); - RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI")); + RuntimeScalar sthRef = ReferenceOperators.bless(sth.createReference(), new RuntimeScalar("DBI::st")); return sthRef.getList(); }, dbh, "type_info"); } diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/PerlModuleBase.java b/src/main/java/org/perlonjava/runtime/perlmodule/PerlModuleBase.java index 967433a1a..0226659ed 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/PerlModuleBase.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/PerlModuleBase.java @@ -73,6 +73,8 @@ protected void registerMethod(String perlMethodName, String javaMethodName, Stri RuntimeCode code = new RuntimeCode(methodHandle, this, signature); code.isStatic = true; + code.packageName = moduleName; + code.subName = perlMethodName; String fullMethodName = NameNormalizer.normalizeVariableName(perlMethodName, moduleName); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java b/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java index b7014de0b..785e72af1 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/ErrnoVariable.java @@ -80,8 +80,8 @@ private static void addErrno(int code, String msg) { public ErrnoVariable() { super(); - this.type = RuntimeScalarType.INTEGER; - this.value = 0; + this.type = RuntimeScalarType.DUALVAR; + this.value = new DualVar(new RuntimeScalar(0), new RuntimeScalar("")); } /** @@ -91,8 +91,8 @@ public ErrnoVariable() { public RuntimeScalar set(int value) { this.errno = value; this.message = ERRNO_MESSAGES.getOrDefault(value, value == 0 ? "" : "Unknown error " + value); - this.type = RuntimeScalarType.INTEGER; - this.value = value; + this.type = RuntimeScalarType.DUALVAR; + this.value = new DualVar(new RuntimeScalar(value), new RuntimeScalar(this.message)); return this; } @@ -107,8 +107,8 @@ public RuntimeScalar set(String value) { if (value == null || value.isEmpty()) { this.errno = 0; this.message = ""; - this.type = RuntimeScalarType.INTEGER; - this.value = 0; + this.type = RuntimeScalarType.DUALVAR; + this.value = new DualVar(new RuntimeScalar(0), new RuntimeScalar("")); return this; } @@ -117,8 +117,8 @@ public RuntimeScalar set(String value) { if (code != null) { this.errno = code; this.message = value; - this.type = RuntimeScalarType.INTEGER; - this.value = code; + this.type = RuntimeScalarType.DUALVAR; + this.value = new DualVar(new RuntimeScalar(code), new RuntimeScalar(value)); return this; } @@ -130,8 +130,8 @@ public RuntimeScalar set(String value) { // Not a number and not a known message - store as message with errno 0 this.errno = 0; this.message = value; - this.type = RuntimeScalarType.STRING; - this.value = value; + this.type = RuntimeScalarType.DUALVAR; + this.value = new DualVar(new RuntimeScalar(0), new RuntimeScalar(value)); return this; } } @@ -199,5 +199,27 @@ public boolean getBoolean() { public void clear() { set(0); } + + // Stack to save errno/message during local() + private static final java.util.Stack errnoStack = new java.util.Stack<>(); + private static final java.util.Stack messageStack = new java.util.Stack<>(); + + @Override + public void dynamicSaveState() { + errnoStack.push(new int[]{errno}); + messageStack.push(message); + super.dynamicSaveState(); + } + + @Override + public void dynamicRestoreState() { + super.dynamicRestoreState(); + if (!errnoStack.isEmpty()) { + errno = errnoStack.pop()[0]; + } + if (!messageStack.isEmpty()) { + message = messageStack.pop(); + } + } } diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java index 011b4e9da..d2be6220c 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalContext.java @@ -250,6 +250,7 @@ public static void initializeGlobals(CompilerOptions compilerOptions) { // TimeHiRes.initialize(); // Has XSLoader in Perl file // Encode.initialize(); // Has XSLoader in Perl file - deferred for Encode::Alias support UnicodeUCD.initialize(); // No XSLoader in Perl file - needed at startup + Charnames.initialize(); // Java-side charnames::viacode via ICU4J TermReadLine.initialize(); // No Perl file - needed at startup TermReadKey.initialize(); // No Perl file - needed at startup FileTemp.initialize(); // Perl uses eval require - keep for cleanup hooks diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeScalar.java index 8fcaf5322..1948455f5 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/GlobalRuntimeScalar.java @@ -27,6 +27,10 @@ public static RuntimeScalar makeLocal(String fullName) { DynamicVariableManager.pushLocalVariable(original); return original; } + if (original instanceof ErrnoVariable) { + DynamicVariableManager.pushLocalVariable(original); + return original; + } if (fullName.endsWith("::1")) { var regexVar = GlobalVariable.getGlobalVariable(fullName); DynamicVariableManager.pushLocalVariable(regexVar); diff --git a/src/main/java/org/perlonjava/runtime/runtimetypes/TieScalar.java b/src/main/java/org/perlonjava/runtime/runtimetypes/TieScalar.java index c485478c3..4a46bdb5e 100644 --- a/src/main/java/org/perlonjava/runtime/runtimetypes/TieScalar.java +++ b/src/main/java/org/perlonjava/runtime/runtimetypes/TieScalar.java @@ -39,21 +39,31 @@ public TieScalar(String tiedPackage, RuntimeScalar previousValue, RuntimeScalar * Called when a tied scalar goes out of scope (delegates to DESTROY if exists). */ public static RuntimeScalar tiedDestroy(RuntimeScalar runtimeScalar) { - return ((TieScalar) runtimeScalar.value).tieCallIfExists("DESTROY"); + if (runtimeScalar.value instanceof TieScalar tieScalar) { + return tieScalar.tieCallIfExists("DESTROY"); + } + return RuntimeScalarCache.scalarUndef; } /** * Unties a tied scalar (delegates to UNTIE if exists). */ public static RuntimeScalar tiedUntie(RuntimeScalar runtimeScalar) { - return ((TieScalar) runtimeScalar.value).tieCallIfExists("UNTIE"); + if (runtimeScalar.value instanceof TieScalar tieScalar) { + return tieScalar.tieCallIfExists("UNTIE"); + } + return RuntimeScalarCache.scalarUndef; } /** * Fetches the value from a tied scalar (delegates to FETCH). */ public RuntimeScalar tiedFetch() { - return tieCall("FETCH"); + RuntimeScalar result = tieCall("FETCH"); + // Cache the FETCH result so untie restores it (matches Perl 5 SV caching) + previousValue.type = result.type; + previousValue.value = result.value; + return result; } /** diff --git a/src/main/perl/lib/B.pm b/src/main/perl/lib/B.pm index a42a1fcaa..a35efc7ef 100644 --- a/src/main/perl/lib/B.pm +++ b/src/main/perl/lib/B.pm @@ -20,7 +20,7 @@ our $VERSION = '1.88'; # Export functionality use Exporter 'import'; -our @EXPORT_OK = qw(svref_2object perlstring CVf_ANON SVf_IOK SVf_NOK SVf_POK SVp_IOK SVp_NOK SVp_POK); +our @EXPORT_OK = qw(svref_2object class perlstring CVf_ANON SVf_IOK SVf_NOK SVf_POK SVp_IOK SVp_NOK SVp_POK); our %EXPORT_TAGS = ( all => \@EXPORT_OK, ); @@ -59,6 +59,16 @@ package B::SV { return 0; } + sub RV { + my $self = shift; + my $r = $self->{ref}; + if (ref($r) eq 'SCALAR' || ref($r) eq 'REF') { + return B::svref_2object($$r); + } + # For other reference types, return the referent wrapped + return B::SV->new($r); + } + sub FLAGS { my $self = shift; my $r = $self->{ref}; @@ -161,6 +171,16 @@ package B::CV { return B::OP->new(); } + sub ROOT { + # PerlOnJava: all subs have bodies, return a real B::OP (not B::NULL) + return B::OP->new(); + } + + sub const_sv { + # Return a scalar ref to 0 so ${$cv->const_sv} is false + return \0; + } + sub SV { my $self = shift; return B::SV->new($self->{ref}); @@ -221,8 +241,24 @@ package B::OP { } } +package B::NULL { + our @ISA = ('B::OP'); + sub new { + my $class = shift; + return bless {}, $class; + } +} + package B; +# Utility: extract B:: class name from a B object +sub class { + my $obj = shift; + my $name = ref $obj; + $name =~ s/^B:://; + return $name; +} + # Main introspection function sub svref_2object { my $ref = shift; diff --git a/src/main/perl/lib/DBD/Mem.pm b/src/main/perl/lib/DBD/Mem.pm new file mode 100644 index 000000000..23ddfce7a --- /dev/null +++ b/src/main/perl/lib/DBD/Mem.pm @@ -0,0 +1,41 @@ +package DBD::Mem; +use strict; +use warnings; + +our $VERSION = '0.001'; + +# DBD::Mem compatibility shim for PerlOnJava +# Maps dbi:Mem: to SQLite in-memory via jdbc:sqlite::memory: +# Perl 5's DBD::Mem is a pure-Perl in-memory table engine. +# We emulate it using SQLite's in-memory mode which provides +# equivalent SQL functionality. + +sub _dsn_to_jdbc { + my ($class, $dsn_rest) = @_; + return "jdbc:sqlite::memory:"; +} + +1; + +__END__ + +=head1 NAME + +DBD::Mem - PerlOnJava in-memory database driver via SQLite + +=head1 SYNOPSIS + + use DBI; + my $dbh = DBI->connect("dbi:Mem:", "", ""); + my $dbh = DBI->connect("dbi:Mem(RaiseError=1):", "", ""); + +=head1 DESCRIPTION + +This is a PerlOnJava compatibility shim that maps C connections +to SQLite in-memory databases (C). + +In Perl 5, C is a pure-Perl in-memory table engine built on +C. PerlOnJava emulates this using SQLite's in-memory mode, +which provides equivalent SQL functionality. + +=cut diff --git a/src/main/perl/lib/DBI.pm b/src/main/perl/lib/DBI.pm index 5c354634d..dd0d115ac 100644 --- a/src/main/perl/lib/DBI.pm +++ b/src/main/perl/lib/DBI.pm @@ -8,7 +8,12 @@ our $VERSION = '1.643'; XSLoader::load( 'DBI' ); -# Wrap Java DBI methods with HandleError support. +# DBI::db and DBI::st inherit from DBI so method dispatch works +# when handles are blessed into subclass packages +@DBI::db::ISA = ('DBI'); +@DBI::st::ISA = ('DBI'); + +# Wrap Java DBI methods with HandleError support and DBI attribute tracking. # In real DBI, HandleError is called from C before RaiseError/die. # Since our Java methods just die with RaiseError, we wrap them in Perl # to intercept the die and call HandleError from Perl context (where @@ -16,6 +21,8 @@ XSLoader::load( 'DBI' ); { my $orig_prepare = \&DBI::prepare; my $orig_execute = \&DBI::execute; + my $orig_finish = \&DBI::finish; + my $orig_disconnect = \&DBI::disconnect; no warnings 'redefine'; @@ -24,6 +31,15 @@ XSLoader::load( 'DBI' ); if ($@) { return _handle_error($_[0], $@); } + if ($result) { + my $dbh = $_[0]; + my $sql = $_[1]; + # Track statement handle count (Kids) and last statement + $dbh->{Kids} = ($dbh->{Kids} || 0) + 1; + $dbh->{Statement} = $sql; + # Link sth back to parent dbh + $result->{Database} = $dbh; + } return $result; }; @@ -38,8 +54,36 @@ XSLoader::load( 'DBI' ); } return _handle_error($sth_handle, $@); } + if ($result) { + my $sth = $_[0]; + my $dbh = $sth->{Database}; + if ($dbh) { + # Only mark as active for result-returning statements (SELECT etc.) + # DDL/DML statements (CREATE, INSERT, etc.) have NUM_OF_FIELDS == 0 + if (($sth->{NUM_OF_FIELDS} || 0) > 0) { + $dbh->{ActiveKids} = ($dbh->{ActiveKids} || 0) + 1; + $sth->{Active} = 1; + } + } + } return $result; }; + + *DBI::finish = sub { + my $sth = $_[0]; + if ($sth->{Active} && $sth->{Database}) { + my $active = $sth->{Database}{ActiveKids} || 0; + $sth->{Database}{ActiveKids} = $active > 0 ? $active - 1 : 0; + $sth->{Active} = 0; + } + return $orig_finish->(@_); + }; + + *DBI::disconnect = sub { + my $dbh = $_[0]; + $dbh->{Active} = 0; + return $orig_disconnect->(@_); + }; } sub _handle_error { @@ -112,16 +156,32 @@ use constant { # DSN translation: convert Perl DBI DSN format to JDBC URL # This wraps the Java-side connect() to support dbi:Driver:... format +# Handles attribute syntax: dbi:Driver(RaiseError=1):rest { no warnings 'redefine'; my $orig_connect = \&connect; *connect = sub { my ($class, $dsn, $user, $pass, $attr) = @_; $dsn = '' unless defined $dsn; + $user = '' unless defined $user; + $pass = '' unless defined $pass; + $attr = {} unless ref $attr eq 'HASH'; my $driver_name; - if ($dsn =~ /^dbi:(\w+):(.*)$/i) { - my ($driver, $rest) = ($1, $2); + my $dsn_rest; + if ($dsn =~ /^dbi:(\w+)(?:\(([^)]*)\))?:(.*)$/i) { + my ($driver, $dsn_attrs, $rest) = ($1, $2, $3); $driver_name = $driver; + $dsn_rest = $rest; + + # Parse DSN-embedded attributes like (RaiseError=1,PrintError=0) + if (defined $dsn_attrs && length $dsn_attrs) { + for my $pair (split /,/, $dsn_attrs) { + if ($pair =~ /^\s*(\w+)\s*=\s*(.*?)\s*$/) { + $attr->{$1} = $2 unless exists $attr->{$1}; + } + } + } + my $dbd_class = "DBD::$driver"; eval "require $dbd_class"; if ($dbd_class->can('_dsn_to_jdbc')) { @@ -133,6 +193,12 @@ use constant { # Set Driver attribute so DBIx::Class can detect the driver # (e.g. $dbh->{Driver}{Name} returns "SQLite") $dbh->{Driver} = bless { Name => $driver_name }, 'DBI::dr'; + # Initialize DBI handle tracking attributes + $dbh->{Kids} = 0; + $dbh->{ActiveKids} = 0; + $dbh->{Statement} = ''; + # Set Name to DSN rest (after driver:), not the JDBC URL + $dbh->{Name} = $dsn_rest if defined $dsn_rest; } return $dbh; }; diff --git a/src/main/perl/lib/Digest/SHA.pm b/src/main/perl/lib/Digest/SHA.pm index 41f7a08a9..cea691a09 100644 --- a/src/main/perl/lib/Digest/SHA.pm +++ b/src/main/perl/lib/Digest/SHA.pm @@ -6,7 +6,7 @@ use base "Digest::base"; our $VERSION = '6.04'; use Exporter; -our @ISA = qw(Exporter); +our @ISA = qw(Exporter Digest::base); XSLoader::load( 'Digest::SHA' ); diff --git a/src/main/perl/lib/File/Temp.pm b/src/main/perl/lib/File/Temp.pm index 6e904c6e6..520c8ca97 100644 --- a/src/main/perl/lib/File/Temp.pm +++ b/src/main/perl/lib/File/Temp.pm @@ -24,11 +24,11 @@ our $VERSION = '0.2311'; use Exporter 'import'; our @EXPORT = qw(); -our @EXPORT_OK = qw(tempfile tempdir mkstemp mkstemps mkdtemp mktemp tmpnam tmpfile tempnam unlink0 unlink1 cleanup); +our @EXPORT_OK = qw(tempfile tempdir mkstemp mkstemps mkdtemp mktemp tmpnam tmpfile tempnam unlink0 unlink1 cleanup SEEK_SET SEEK_CUR SEEK_END); our %EXPORT_TAGS = ( 'POSIX' => [qw(tmpnam tmpfile)], 'mktemp' => [qw(mkstemp mkstemps mkdtemp mktemp)], - 'seekable' => [], + 'seekable' => [qw(SEEK_SET SEEK_CUR SEEK_END)], ); # Global variables diff --git a/src/main/perl/lib/_charnames.pm b/src/main/perl/lib/_charnames.pm index e2acef0cd..d50da2a39 100644 --- a/src/main/perl/lib/_charnames.pm +++ b/src/main/perl/lib/_charnames.pm @@ -807,6 +807,15 @@ sub viacode ($arg) { return $algorithmic; } + # PerlOnJava: use Java's ICU4J for name lookup when unicore/Name.pl is unavailable + if (!$txt && defined &_charnames::_java_viacode) { + my $java_name = _charnames::_java_viacode(CORE::hex $hex); + if (defined $java_name && $java_name ne '') { + $viacode{$hex} = $java_name; + return $java_name; + } + } + # Return the official name, if exists. It's unclear to me (khw) at # this juncture if it is better to return a user-defined override, so # leaving it as is for now.