DateTime-Format-Genealogy
view release on metacpan or search on metacpan
Revision history for DateTime::Format::Genealogy
0.13 Sat Jul 25 17:27:13 EDT 2026
[ Bug Fixes ]
- Fix t/error.t failures when Params::Get >= 0.13 croaks before our own usage check
See https://github.com/nigelhorne/DateTime-Format-Genealogy/issues/11
- Fix 'return inside eval' bug in _convert_calendar that silently discarded
Hebrew and French Republican calendar conversions
- Fix bare clone (->new() on an object) returning the original reference
instead of a copy
- Fix ISO date month 00 silently mapping to December via Perl's negative
array-index wrap; month 13-99 no longer produces undef month name
- Fix $@ race condition: three eval blocks (validate_strict, Hebrew calendar,
French Republican calendar) now capture $@ into a lexical immediately so
a DESTROY firing between the eval and the check cannot silently clear it
- Fix greedy first-group quantifier in 'bet X and Y' / 'from X to Y' range
patterns; was picking the last keyword occurrence rather than the first
- Fix unanchored =~ /FRENCH R/ calendar-type test replaced with string
equality, preventing false matches on future escape variants
- Fix 3-digit and oversized years returning today's date instead of undef
(DateTime::Format::Natural success() was not checked in the GGD-cached path)
- Fix missing optional calendar module returning a Gregorian DateTime instead
of undef when DateTime::Calendar::Hebrew or ::FrenchRevolutionary is absent
- Fix undef canonical field in GGD result crashing DateTime::Format::Natural
[ Security ]
- Sanitise user-supplied date strings in all Carp messages via new _safe_str()
helper: control characters (including CR/LF for log injection, ANSI escapes)
are replaced with '?' and messages are truncated at 120 characters
- Add MAX_CACHE_SIZE guard (10,000 entries) in _date_parser_cached to prevent
memory exhaustion when an adversarial caller feeds unbounded unique strings
invalid string and duplicate carp emissions
- _date_parser_cached now accepts a plain positional arg instead of routing
through Params::Get, removing measurable dispatch overhead from the hot path
- _julian_to_gregorian_offset uses a for-loop with early exit instead of grep,
avoiding temporary list allocation on each Julian date conversion
[ Enhancements ]
- Support Object::Configure
- Use Params::Get in new()
- Use Params::Validate::Strict to reject unknown parameter keys
- Use Sub::Private (enforce mode) for _convert_calendar and
_julian_to_gregorian_offset; use Sub::Protected for _date_parser_cached
- Use Readonly constants for month alias table, Julian offset tiers, and
new MAX_CACHE_SIZE limit
- Consolidate French/German month aliases (Janv, Juli, Mai) into the main
%MONTH_ALIAS lookup table; remove separate special-case branches
- quiet and strict flags now fall back to object-level attributes when
not supplied per-call to parse_datetime
- Full POD added: EXAMPLE, API SPECIFICATION, MESSAGES, FORMAL SPECIFICATION,
PSEUDOCODE, and LIMITATIONS sections
- New t/locales.t covering POSIX locale behaviour
# VERSION
Version 0.13
# SYNOPSIS
`DateTime::Format::Genealogy` is a Perl module designed to parse genealogy-style
date strings (primarily GEDCOM format) and convert them into [DateTime](https://metacpan.org/pod/DateTime) objects.
It wraps [Genealogy::Gedcom::Date](https://metacpan.org/pod/Genealogy%3A%3AGedcom%3A%3ADate) and [DateTime::Format::Natural](https://metacpan.org/pod/DateTime%3A%3AFormat%3A%3ANatural), adds GEDCOM
calendar-escape handling, and accepts common non-standard month names found in
exported genealogical trees.
use DateTime::Format::Genealogy;
my $dtg = DateTime::Format::Genealogy->new();
my $dt = $dtg->parse_datetime('25 Dec 2022');
print $dt->dmy; # 25-12-2022
# SUBROUTINES/METHODS
## new
ELSE IF class is already an object (blessed):
RETURN bless( merge(class.attrs, params), ref(class) )
params = configure(class, params) # merge any config-file settings
RETURN bless(params, class)
END FUNCTION
## parse\_datetime
Parses a genealogy-style date string and returns a [DateTime](https://metacpan.org/pod/DateTime) object.
Recognises GEDCOM calendar escapes (`@#DJULIAN@`, `@#DHEBREW@`,
`@#DFRENCH R@`) and converts them via the appropriate calendar module when
available.
Can be called as a class method, an object method, or a bare function.
Returns:
- A single [DateTime](https://metacpan.org/pod/DateTime) object for exact, parseable dates.
- A two-element list of [DateTime](https://metacpan.org/pod/DateTime) objects in _list_ context when the date
string is a range (`bet X and Y` / `from X to Y`).
- `undef` (scalar) or the empty list (list context) when the date cannot be
my $dtg = DateTime::Format::Genealogy->new();
# Simple exact date
my $dt = $dtg->parse_datetime('25 Dec 2022');
print $dt->dmy; # 25-12-2022
# Date range (list context)
my ($start, $end) = $dtg->parse_datetime('bet 1 Sep 1939 and 2 Sep 1945');
# GEDCOM calendar escape
my $julian = $dtg->parse_datetime('@#DJULIAN@ 15 Mar 1620');
# Class-method form (no constructor required)
my $dt2 = DateTime::Format::Genealogy->parse_datetime('1 Jan 2000');
# Long month name (non-strict only)
my $dt3 = $dtg->parse_datetime('12 June 2020');
# French month variant (non-strict only)
my $dt4 = $dtg->parse_datetime('21 Mai 1681');
- `Unparseable date $date - often because the month name isn't 3 letters`
Warned (carp) in strict mode for non-3-letter months, or in non-strict mode
for unrecognised long month names. Silenced by `quiet`.
- `$dfn_error_string`
Warned (carp) when [DateTime::Format::Natural](https://metacpan.org/pod/DateTime%3A%3AFormat%3A%3ANatural) rejects the date string.
Silenced by `quiet`.
- `Hebrew calendar conversion failed: ...`
Warned (carp) when [DateTime::Calendar::Hebrew](https://metacpan.org/pod/DateTime%3A%3ACalendar%3A%3AHebrew) is unavailable or throws.
Silenced by `quiet`.
- `French Republican calendar conversion failed: ...`
Warned (carp) when [DateTime::Calendar::FrenchRevolutionary](https://metacpan.org/pod/DateTime%3A%3ACalendar%3A%3AFrenchRevolutionary) is unavailable
or throws. Silenced by `quiet`.
- `Calendar type $type not supported`
Warned (carp) for GEDCOM calendar escapes other than GREGORIAN, JULIAN,
HEBREW, and FRENCH R. Silenced by `quiet`.
### PSEUDOCODE
FUNCTION parse_datetime(self, *args):
-- Dispatch class/function/hash-invocant calls to an object instance
IF self is not a reference:
RETURN new()->parse_datetime(args or self)
IF ref(self) == 'HASH':
RETURN new()->parse_datetime(self)
ABORT unless args non-empty
params = get_params('date', args)
ABORT on unknown keys (validate_strict)
date = params.date
quiet = params.quiet // self.quiet
strict = params.strict // self.strict
ABORT unless date is defined, non-empty, and not a reference
-- Strip GEDCOM calendar escape if present
IF date =~ s/^@#D([A-Z ]+?)@\s*//: calendar_type = 'D' + uc(match)
-- Reject approximate/relative dates
IF date =~ /^(bef|aft|abt)\s/i: CARP and RETURN undef
-- Reject calendar impossibilities
IF date =~ /^31\s+Nov/: CARP and RETURN undef
-- Rewrite dash-separated ranges and ISO dates
IF date =~ /X - Y/:
IF date =~ /YYYY-MM-DD/: REFORMAT to "DD Mon YYYY" (carp)
ELSE: REFORMAT to "bet X and Y" (carp)
-- Dispatch ranges to recursive calls
IF date =~ /^bet X and Y/i:
RETURN (parse_datetime(X), parse_datetime(Y)) IF wantarray
IF lookup: REWRITE month to lookup
ELSE IF month is more than 3 letters: CARP and RETURN undef
-- 3-letter unknown months fall through unchanged to the parser
-- Parse with Genealogy::Gedcom::Date (cached) then DateTime::Format::Natural
IF date starts with digit:
d = _date_parser_cached(date)
IF d defined:
RETURN undef if date ends with year-only (< AD100 guard)
rc = DateTime::Format::Natural->parse_datetime(d.canonical)
IF calendar_type != DGREGORIAN:
rc = _convert_calendar(rc, calendar_type, quiet)
RETURN rc
-- Fallback: try DateTime::Format::Natural directly on the raw string
IF date not ~= /^(Abt|ca?)/i AND date =~ /^[\w\s,]+$/:
rc = DateTime::Format::Natural->parse_datetime(date)
IF rc AND success: RETURN rc
ELSE: CARP error
RETURN undef
END FUNCTION
# LIMITATIONS
- Dates before AD 100 are rejected because [DateTime::Format::Natural](https://metacpan.org/pod/DateTime%3A%3AFormat%3A%3ANatural) cannot
parse them reliably (it returns today's date instead of an error).
- The `Aout` (French August with circumflex-u) entry in the month-alias table
uses a non-ASCII Unicode escape (`\x{FB}`). The module file must be read as
UTF-8; this is satisfied by the standard `perl -Ilib` invocation but may
require `use utf8` or `open ':encoding(UTF-8)'` in unusual environments.
- Hebrew and French Republican calendar conversions require
[DateTime::Calendar::Hebrew](https://metacpan.org/pod/DateTime%3A%3ACalendar%3A%3AHebrew) and [DateTime::Calendar::FrenchRevolutionary](https://metacpan.org/pod/DateTime%3A%3ACalendar%3A%3AFrenchRevolutionary)
respectively. These are optional and not listed as hard dependencies. When
absent, the GEDCOM escape is silently discarded and undef is returned unless
the `quiet` flag is off, in which case a carp is emitted.
- [Genealogy::Gedcom::Date](https://metacpan.org/pod/Genealogy%3A%3AGedcom%3A%3ADate) cannot parse native Hebrew or French Revolutionary
month names (e.g. `Tishri`, `Vendemiaire`). Only dates written in
Gregorian form with the `@#DHEBREW@` escape are converted.
- The `quiet` and `strict` flags may be set at construction time
(`->new(quiet => 1)`) and will be respected by all subsequent calls to
`parse_datetime` unless overridden on a per-call basis. The per-call value
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
=cut
our $VERSION = '0.13';
=head1 SYNOPSIS
C<DateTime::Format::Genealogy> is a Perl module designed to parse genealogy-style
date strings (primarily GEDCOM format) and convert them into L<DateTime> objects.
It wraps L<Genealogy::Gedcom::Date> and L<DateTime::Format::Natural>, adds GEDCOM
calendar-escape handling, and accepts common non-standard month names found in
exported genealogical trees.
use DateTime::Format::Genealogy;
my $dtg = DateTime::Format::Genealogy->new();
my $dt = $dtg->parse_datetime('25 Dec 2022');
print $dt->dmy; # 25-12-2022
=head1 SUBROUTINES/METHODS
=head2 new
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
}
$params = Object::Configure::configure($class, $params);
return bless $params, $class;
}
=head2 parse_datetime
Parses a genealogy-style date string and returns a L<DateTime> object.
Recognises GEDCOM calendar escapes (C<@#DJULIAN@>, C<@#DHEBREW@>,
C<@#DFRENCH R@>) and converts them via the appropriate calendar module when
available.
Can be called as a class method, an object method, or a bare function.
Returns:
=over 4
=item *
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
my $dtg = DateTime::Format::Genealogy->new();
# Simple exact date
my $dt = $dtg->parse_datetime('25 Dec 2022');
print $dt->dmy; # 25-12-2022
# Date range (list context)
my ($start, $end) = $dtg->parse_datetime('bet 1 Sep 1939 and 2 Sep 1945');
# GEDCOM calendar escape
my $julian = $dtg->parse_datetime('@#DJULIAN@ 15 Mar 1620');
# Class-method form (no constructor required)
my $dt2 = DateTime::Format::Genealogy->parse_datetime('1 Jan 2000');
# Long month name (non-strict only)
my $dt3 = $dtg->parse_datetime('12 June 2020');
# French month variant (non-strict only)
my $dt4 = $dtg->parse_datetime('21 Mai 1681');
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
=item C<< Unparseable date $date - often because the month name isn't 3 letters >>
Warned (carp) in strict mode for non-3-letter months, or in non-strict mode
for unrecognised long month names. Silenced by C<quiet>.
=item C<< $dfn_error_string >>
Warned (carp) when L<DateTime::Format::Natural> rejects the date string.
Silenced by C<quiet>.
=item C<< Hebrew calendar conversion failed: ... >>
Warned (carp) when L<DateTime::Calendar::Hebrew> is unavailable or throws.
Silenced by C<quiet>.
=item C<< French Republican calendar conversion failed: ... >>
Warned (carp) when L<DateTime::Calendar::FrenchRevolutionary> is unavailable
or throws. Silenced by C<quiet>.
=item C<< Calendar type $type not supported >>
Warned (carp) for GEDCOM calendar escapes other than GREGORIAN, JULIAN,
HEBREW, and FRENCH R. Silenced by C<quiet>.
=back
=head3 PSEUDOCODE
FUNCTION parse_datetime(self, *args):
-- Dispatch class/function/hash-invocant calls to an object instance
IF self is not a reference:
RETURN new()->parse_datetime(args or self)
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
ABORT unless args non-empty
params = get_params('date', args)
ABORT on unknown keys (validate_strict)
date = params.date
quiet = params.quiet // self.quiet
strict = params.strict // self.strict
ABORT unless date is defined, non-empty, and not a reference
-- Strip GEDCOM calendar escape if present
IF date =~ s/^@#D([A-Z ]+?)@\s*//: calendar_type = 'D' + uc(match)
-- Reject approximate/relative dates
IF date =~ /^(bef|aft|abt)\s/i: CARP and RETURN undef
-- Reject calendar impossibilities
IF date =~ /^31\s+Nov/: CARP and RETURN undef
-- Rewrite dash-separated ranges and ISO dates
IF date =~ /X - Y/:
IF date =~ /YYYY-MM-DD/: REFORMAT to "DD Mon YYYY" (carp)
ELSE: REFORMAT to "bet X and Y" (carp)
-- Dispatch ranges to recursive calls
IF date =~ /^bet X and Y/i:
RETURN (parse_datetime(X), parse_datetime(Y)) IF wantarray
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
IF lookup: REWRITE month to lookup
ELSE IF month is more than 3 letters: CARP and RETURN undef
-- 3-letter unknown months fall through unchanged to the parser
-- Parse with Genealogy::Gedcom::Date (cached) then DateTime::Format::Natural
IF date starts with digit:
d = _date_parser_cached(date)
IF d defined:
RETURN undef if date ends with year-only (< AD100 guard)
rc = DateTime::Format::Natural->parse_datetime(d.canonical)
IF calendar_type != DGREGORIAN:
rc = _convert_calendar(rc, calendar_type, quiet)
RETURN rc
-- Fallback: try DateTime::Format::Natural directly on the raw string
IF date not ~= /^(Abt|ca?)/i AND date =~ /^[\w\s,]+$/:
rc = DateTime::Format::Natural->parse_datetime(date)
IF rc AND success: RETURN rc
ELSE: CARP error
RETURN undef
END FUNCTION
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
eval { validate_strict(schema => \%PARSE_DATETIME_SCHEMA, input => $params); 1 }
or $validate_err = $@;
Carp::croak("Invalid parse_datetime parameters: $validate_err") if $validate_err;
if((!ref($params->{'date'})) && (my $date = $params->{'date'})) {
# Per-call flags shadow object-level defaults, enabling per-call overrides
# without losing the convenience of constructor-level configuration.
my $quiet = $params->{'quiet'} // $self->{'quiet'};
my $strict = $params->{'strict'} // $self->{'strict'};
# Detect and strip any GEDCOM calendar escape at the front of the string.
# Pattern: @#D<NAME>@ where NAME is uppercase letters/spaces (lazy match
# so it stops at the first closing '@' rather than a later one).
my $calendar_type = 'DGREGORIAN';
if($date =~ s/^@#D([A-Z ]+?)@\s*//) {
$calendar_type = 'D' . uc($1);
}
# Approximate-date prefixes (bef/aft/abt) signal "no exact date known",
# so a DateTime object would be misleading.
if($date =~ /^(?:bef|aft|abt)\s/i) {
Carp::carp(_safe_str($date) . ' is invalid, need an exact date to create a DateTime')
unless($quiet);
return;
}
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
# DFN silently returns today's date when it cannot parse the
# canonical string (e.g. 3-digit years 100-999, very large
# years). We must check success() here just as we do in the
# DFN fallback path below, otherwise the caller receives a
# completely wrong DateTime.
unless($dfn->success) {
Carp::carp($dfn->error) unless $quiet;
return;
}
if($rc && $calendar_type ne 'DGREGORIAN') {
return _convert_calendar($rc, $calendar_type, $quiet);
}
return $rc;
}
# Last resort: try DateTime::Format::Natural on the raw string.
# Approximate-prefix forms are excluded here because they already
# returned undef above; the pattern here guards against 'Abt'/'ca'
# leaking through when quiet is enabled (e.g. "Abt1Jan2000" has no
# space so it was not caught by the /^abt\s/i check above).
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
if((ref($parsed_date) eq 'ARRAY') && @{$parsed_date}) {
return $self->{'all_dates'}{$date} = $parsed_date->[0];
}
# Empty or unexpected result -- also cache to prevent repeated GGD calls.
return ($self->{'all_dates'}{$date} = undef);
}
# ---------------------------------------------------------------------------
# _convert_calendar
#
# Purpose: Convert a Gregorian DateTime produced by
# Genealogy::Gedcom::Date/DateTime::Format::Natural to the
# calendar indicated by the GEDCOM escape that preceded the date.
# Entry: $dt - DateTime object in Gregorian coordinates
# $calendar_type - normalised escape string (e.g. 'DJULIAN')
# $quiet - truthy to suppress carp on failure
# Exit: Converted DateTime, or the original $dt for unknown types.
# Side Effects: May carp on conversion failure (unless $quiet).
# ---------------------------------------------------------------------------
sub _convert_calendar :Private
{
my ($dt, $calendar_type, $quiet) = @_;
if($calendar_type eq 'DJULIAN') {
# Add the historical Julian-to-Gregorian day offset.
my $offset_days = _julian_to_gregorian_offset($dt->year);
return $dt->clone->add(days => $offset_days);
} elsif($calendar_type eq 'DHEBREW') {
# "return" inside eval{} exits the eval block, NOT the enclosing sub,
# so we capture the result in $result and return it afterwards.
# $@ is captured into a lexical immediately after the eval to prevent
# a DESTROY method from clearing the global before we can read it.
my $result;
my $convert_err;
eval {
require DateTime::Calendar::Hebrew;
my $h = DateTime::Calendar::Hebrew->new(
year => $dt->year,
month => $dt->month,
day => $dt->day
);
$result = DateTime->from_object(object => $h);
1;
} or $convert_err = $@;
Carp::carp("Hebrew calendar conversion failed: $convert_err")
if $convert_err && !$quiet;
# Return the converted DateTime on success, undef on failure.
# The POD (LIMITATIONS) documents that undef is returned when the
# optional module is unavailable rather than passing back the
# unconverted Gregorian DateTime.
return $result;
} elsif($calendar_type eq 'DFRENCH R') {
my $result;
my $convert_err;
eval {
require DateTime::Calendar::FrenchRevolutionary;
my $f = DateTime::Calendar::FrenchRevolutionary->new(
year => $dt->year,
month => $dt->month,
day => $dt->day
);
$result = DateTime->from_object(object => $f);
1;
} or $convert_err = $@;
Carp::carp("French Republican calendar conversion failed: $convert_err")
if $convert_err && !$quiet;
return $result;
} else {
# DROMAN and any other future escape types are not yet supported.
Carp::carp("Calendar type $calendar_type not supported") unless $quiet;
}
return $dt;
}
# ---------------------------------------------------------------------------
# _safe_str
#
# Purpose: Sanitise a user-supplied string for inclusion in diagnostic
# messages (Carp::carp/croak). Removes ASCII control characters
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
# This neutralises CR/LF log injection and ANSI escape sequences.
(my $clean = $s) =~ s/[[:cntrl:]]/?/g;
return length($clean) <= $max ? $clean : substr($clean, 0, $max - 3) . '...';
}
# ---------------------------------------------------------------------------
# _julian_to_gregorian_offset
#
# Purpose: Return the number of days to add to a Julian date to obtain
# the Gregorian equivalent, based on the year.
# Entry: $year - integer calendar year
# Exit: Integer day offset (10, 11, 12, or 13)
# ---------------------------------------------------------------------------
sub _julian_to_gregorian_offset :Private
{
my $year = $_[0];
# Iterate once with early exit; avoids the temporary list that grep would
# build before we discard all but the first match.
# @JULIAN_OFFSET_TIERS is ordered ascending, so the first hit is correct.
lib/DateTime/Format/Genealogy.pm view on Meta::CPAN
=item *
The C<Aout> (French August with circumflex-u) entry in the month-alias table
uses a non-ASCII Unicode escape (C<\x{FB}>). The module file must be read as
UTF-8; this is satisfied by the standard C<perl -Ilib> invocation but may
require C<use utf8> or C<open ':encoding(UTF-8)'> in unusual environments.
=item *
Hebrew and French Republican calendar conversions require
L<DateTime::Calendar::Hebrew> and L<DateTime::Calendar::FrenchRevolutionary>
respectively. These are optional and not listed as hard dependencies. When
absent, the GEDCOM escape is silently discarded and undef is returned unless
the C<quiet> flag is off, in which case a carp is emitted.
=item *
L<Genealogy::Gedcom::Date> cannot parse native Hebrew or French Revolutionary
month names (e.g. C<Tishri>, C<Vendemiaire>). Only dates written in
Gregorian form with the C<@#DHEBREW@> escape are converted.
t/30-basics.t view on Meta::CPAN
# Test approximate date
my $approx_date = 'abt 2022';
my $dt_approx = $dtf->parse_datetime(date => $approx_date);
ok(!defined($dt_approx), "Approximate date: $approx_date");
# Test DJULIAN date
my $julian_date = '@#DJULIAN@ 15 Mar 1620';
my $dt_julian = $dtf->parse_datetime($julian_date);
ok(defined($dt_julian), "Parsed Julian date: $julian_date");
# Historical fact: In 1620, England was still using the Julian calendar.
# 15 Mar 1620 Julian = 25 Mar 1620 Gregorian
is($dt_julian->year(), 1620, 'Gregorian year is correct');
is($dt_julian->month(), 3, 'Gregorian month is correct');
is($dt_julian->day(), 25, 'Gregorian day is correct');
# Test Hebrew calendar date (only if module installed)
SKIP: {
if (eval { use_module('DateTime::Calendar::Hebrew'); 1 }) {
my $hebrew_date = '@#DHEBREW@ 14 Tishri 5783';
my $dt_hebrew = $dtf->parse_datetime($hebrew_date);
ok(defined $dt_hebrew, "Parsed Hebrew date: $hebrew_date");
} else {
skip 'DateTime::Calendar::Hebrew not installed', 1;
}
}
# Test French Republican calendar date (only if module installed)
SKIP: {
if (eval { use_module('DateTime::Calendar::FrenchRevolutionary'); 1 }) {
my $french_date = '@#DFRENCH R@ 1 Vendémiaire 1';
my $dt_french = $dtf->parse_datetime($french_date);
ok(defined $dt_french, "Parsed French Republican date: $french_date");
} else {
skip 'DateTime::Calendar::FrenchRevolutionary not installed', 1;
}
}
t/edge_cases.t view on Meta::CPAN
{
package DateTime::Calendar::FrenchRevolutionary;
sub new {
my ($class, %a) = @_;
return bless { %a }, $class;
}
}
$INC{'DateTime/Calendar/FrenchRevolutionary.pm'} = 1;
# Standard "safe" mock for DateTime::from_object used by calendar tests
my $FROM_OBJECT_SENTINEL = DateTime->new(year => 2022, month => 10, day => 9);
# ===========================================================================
# SECTION 1: Hostile inputs to new()
# ===========================================================================
subtest 'new() - hostile constructor arguments' => sub {
# Verify the constructor does not die on zero-ish flag values.
for my $val (0, '', undef) {
my $label = defined $val ? "'$val'" : 'undef';
t/edge_cases.t view on Meta::CPAN
sub { $obj->parse_datetime(date => '31 Nov 2022', quiet => 1) },
qr/31 Nov.*invalid/,
'31 Nov carp fires even with quiet => 1',
);
ok(!defined $obj->parse_datetime('31 Nov 2022'),
'31 Nov returns undef');
};
# ===========================================================================
# SECTION 6: GEDCOM calendar escape edge cases
# ===========================================================================
subtest 'parse_datetime - GEDCOM escape with no date after it' => sub {
my $obj = $PKG->new(quiet => 1);
# Escape with nothing following: the remaining string is empty or
# whitespace, which fails all downstream checks and returns undef.
ok(!defined $obj->parse_datetime('@#DJULIAN@'),
'@#DJULIAN@ with no date returns undef');
ok(!defined $obj->parse_datetime('@#DJULIAN@ '),
'@#DJULIAN@ + whitespace returns undef');
};
subtest 'parse_datetime - unknown GEDCOM calendar type is tolerated' => sub {
my $obj = $PKG->new();
# An unknown calendar escape (DROMAN, DGREEK, etc.) must carp and return
# the Gregorian-interpreted DateTime rather than crashing.
my $result;
warning_like(
sub { $result = $obj->parse_datetime('@#DROMAN@ 25 Dec 2022') },
qr/Calendar type DROMAN not supported/,
'@#DROMAN@: calendar-not-supported carp emitted',
);
isa_ok($result, 'DateTime',
'@#DROMAN@: still returns the Gregorian-interpreted DateTime');
# Very long unknown calendar type must not crash the regex.
my $long_type = 'A' x 500;
my $long_result;
lives_ok(
sub { $long_result = $obj->parse_datetime("\@#D${long_type}\@ 25 Dec 2022") },
'Extremely long calendar type does not crash',
);
diag("Long calendar type result: " . (defined $long_result ? $long_result->dmy : 'undef'))
if $ENV{TEST_VERBOSE};
};
subtest 'parse_datetime - lowercase GEDCOM escape is not recognised' => sub {
# The regex @#D([A-Z ]+?)@ requires uppercase letters; lowercase should
# not be treated as a calendar escape and falls through to normal parsing.
my $obj = $PKG->new(quiet => 1);
my $result = $obj->parse_datetime('@#djulian@ 25 Dec 2022');
ok(!defined $result,
'Lowercase GEDCOM escape not recognised: date cannot be parsed normally');
};
subtest 'parse_datetime - GEDCOM Julian offset for each century tier' => sub {
# Verify all four offset tiers (<1700=>10, <1800=>11, <1900=>12, >=1900=>13)
# are applied correctly end-to-end.
t/edge_cases.t view on Meta::CPAN
mock 'DateTime::Format::Natural::parse_datetime' => sub { return undef };
my $obj = $PKG->new(quiet => 1);
my $r;
lives_ok(sub { $r = $obj->parse_datetime('25 Dec 2022') },
'DFN returning undef does not crash parse_datetime');
restore_all();
};
subtest 'parse_datetime - DateTime::from_object throws during calendar conversion' => sub {
# If DateTime->from_object throws, _convert_calendar must carp and return
# undef (not propagate the exception).
no warnings 'redefine';
local *DateTime::from_object = sub { die "from_object hard failure\n" };
my $obj = $PKG->new();
my $result;
warning_like(
sub { $result = $obj->parse_datetime('@#DHEBREW@ 9 Oct 2022') },
qr/Hebrew calendar conversion failed/,
'from_object throwing: conversion-failed carp emitted',
);
ok(!defined $result, 'from_object throwing: parse_datetime returns undef');
};
# ===========================================================================
# SECTION 10: Global variable integrity under hostile conditions
# ===========================================================================
subtest 'global variables are not clobbered by hostile inputs' => sub {
t/extended_tests.t view on Meta::CPAN
use Scalar::Util qw(blessed);
# Allow direct access to private/protected helpers for white-box assertions.
$Sub::Private::BYPASS = 1;
BEGIN { use_ok('DateTime::Format::Genealogy') || BAIL_OUT('Cannot load module') }
Readonly my $PKG => 'DateTime::Format::Genealogy';
# ---------------------------------------------------------------------------
# Minimal calendar back-end stubs so require() short-circuits.
# ---------------------------------------------------------------------------
{
package DateTime::Calendar::Hebrew;
sub new { my ($c, %a) = @_; bless { %a }, $c }
}
$INC{'DateTime/Calendar/Hebrew.pm'} = 1;
{
package DateTime::Calendar::FrenchRevolutionary;
sub new { my ($c, %a) = @_; bless { %a }, $c }
t/extended_tests.t view on Meta::CPAN
$err = $@ // '';
unlike($err, qr/^Usage:/, 'ref date error is NOT the line-421 usage message');
pass('All ref types are intercepted by validate_strict before line 421');
};
# ===========================================================================
# SECTION 5: Dead-code documentation — condition 531 !l
#
# The condition at line 531 is:
# if ($rc && $calendar_type ne 'DGREGORIAN')
#
# The !l case ($rc is falsy) would fall through without calling
# _convert_calendar. However, the guard added at line 526:
# unless ($dfn->success) { carp...; return }
# ensures that when we reach line 531, $dfn->success() was true and
# $rc holds the DateTime object DFN returned — which is always truthy.
#
# Therefore the !l path (rc is false/undef at line 531) is dead code.
# ===========================================================================
subtest 'Dead code — condition 531 !l: $rc is always truthy when we reach it' => sub {
# Mock DFN to return a truthy object and report success.
# Verify that $rc at line 531 is always a DateTime.
t/function.t view on Meta::CPAN
# enforcer automatically; this covers direct 'perl t/function.t' runs.
$Sub::Private::BYPASS = 1;
BEGIN {
use_ok('DateTime::Format::Genealogy') || BAIL_OUT('Cannot load module');
}
Readonly my $PKG => 'DateTime::Format::Genealogy';
# -----------------------------------------------------------------------
# Inject lightweight stubs for the two optional calendar back-ends so
# the _convert_calendar tests can exercise the real conversion paths
# without requiring the optional distributions to be installed.
# We set %INC entries so that "require DateTime::Calendar::*" inside
# _convert_calendar short-circuits immediately instead of searching @INC.
# -----------------------------------------------------------------------
{
package DateTime::Calendar::Hebrew;
sub new {
my ($class, %args) = @_;
return bless { year => $args{year}, month => $args{month}, day => $args{day} }, $class;
}
}
$INC{'DateTime/Calendar/Hebrew.pm'} = 1;
t/function.t view on Meta::CPAN
subtest '_date_parser_cached - undef on unparseable input' => sub {
my $obj = $PKG->new(quiet => 1);
# The quiet attribute on $self suppresses the internal carp here.
# Failures are now cached as undef so repeated calls are O(1).
my $result = $obj->_date_parser_cached('not a date xyzzy 99999');
ok(!defined $result, 'returns undef for garbage input');
};
# =======================================================================
# SECTION 4: _convert_calendar
#
# This private function dispatches on a calendar-type string. We test
# each branch: Julian offset arithmetic, Hebrew and French Revolutionary
# stub conversions, and the unknown-type carp path.
#
# BUG NOTE: the original code used "return ..." inside eval{} for the
# Hebrew and French Republican branches. In Perl, "return" inside
# eval{} exits the eval block rather than the enclosing sub, so the
# converted DateTime was silently discarded and the original $dt was
# returned. The tests below assert the *intended* behaviour (return the
# converted DateTime); the corresponding fix is applied to the module.
# =======================================================================
subtest '_convert_calendar - DJULIAN' => sub {
my $fn = \&{"${PKG}::_convert_calendar"};
# 15 Mar 1620 Julian = 25 Mar 1620 Gregorian (pre-1700 offset = 10 days)
my $julian_dt = DateTime->new(year => 1620, month => 3, day => 15);
my $gregorian = $fn->($julian_dt, 'DJULIAN', 0);
isa_ok($gregorian, 'DateTime', 'DJULIAN returns a DateTime');
is($gregorian->year, 1620, 'DJULIAN: year unchanged');
is($gregorian->month, 3, 'DJULIAN: month unchanged');
is($gregorian->day, 25, 'DJULIAN: day advanced by 10-day offset');
t/function.t view on Meta::CPAN
my $spy = spy("${PKG}::_julian_to_gregorian_offset");
$fn->($julian_dt, 'DJULIAN', 0);
my @calls = $spy->();
is(scalar @calls, 1, '_julian_to_gregorian_offset called exactly once');
is($calls[0][1], 1620, 'offset helper receives the correct year');
restore_all();
diag('DJULIAN result: ' . $gregorian->dmy) if $ENV{TEST_VERBOSE};
};
subtest '_convert_calendar - DHEBREW returns converted DateTime' => sub {
my $fn = \&{"${PKG}::_convert_calendar"};
# Stub DateTime->from_object with a sentinel year so we can distinguish
# "returned the converted object" from "returned the original $dt".
Readonly my $CONVERTED_YEAR => 5783;
mock 'DateTime::from_object' => sub {
return DateTime->new(year => $CONVERTED_YEAR, month => 10, day => 1);
};
my $original = DateTime->new(year => 2022, month => 10, day => 9);
my $result = $fn->($original, 'DHEBREW', 0);
isa_ok($result, 'DateTime', 'DHEBREW returns a DateTime');
is($result->year, $CONVERTED_YEAR,
'DHEBREW returns the converted DateTime, not the original');
restore_all();
diag('DHEBREW converted year: ' . $result->year) if $ENV{TEST_VERBOSE};
};
subtest '_convert_calendar - DFRENCH R returns converted DateTime' => sub {
my $fn = \&{"${PKG}::_convert_calendar"};
# Sentinel: any year that differs from the input year proves conversion ran
Readonly my $SENTINEL_YEAR => 2000;
mock 'DateTime::from_object' => sub {
return DateTime->new(year => $SENTINEL_YEAR, month => 9, day => 22);
};
my $original = DateTime->new(year => 1792, month => 9, day => 22);
my $result = $fn->($original, 'DFRENCH R', 0);
isa_ok($result, 'DateTime', 'DFRENCH R returns a DateTime');
is($result->year, $SENTINEL_YEAR,
'DFRENCH R returns the converted DateTime, not the original');
restore_all();
};
subtest '_convert_calendar - unknown type carps and passes through' => sub {
my $fn = \&{"${PKG}::_convert_calendar"};
my $dt = DateTime->new(year => 2000, month => 6, day => 15);
# An unrecognised calendar type should carp but return $dt unchanged
my $result;
warning_like(
sub { $result = $fn->($dt, 'DROMAN', 0) },
qr/Calendar type DROMAN not supported/,
'unknown calendar type emits a carp',
);
is($result, $dt, 'unknown calendar: original DateTime returned unchanged');
# With quiet set, the carp must be suppressed entirely
my $quiet_result;
warnings_are(
sub { $quiet_result = $fn->($dt, 'DROMAN', 1) },
[],
'quiet flag suppresses carp for unknown calendar',
);
is($quiet_result, $dt, 'quiet + unknown calendar: original DateTime still returned');
};
# =======================================================================
# SECTION 5: parse_datetime - calling conventions
#
# parse_datetime must accept a plain string, a key-value pair, a hashref,
# and work when called as a class method or a bare function.
# =======================================================================
subtest 'parse_datetime - all calling conventions produce the same result' => sub {
t/function.t view on Meta::CPAN
# Long month names are not valid GEDCOM and must be rejected.
# strict and quiet are passed per-call (not inherited from the object).
ok(!defined $obj->parse_datetime(date => '12 June 2020', strict => 1, quiet => 1),
'strict: long month name returns undef');
ok(!defined $obj->parse_datetime(date => '29 Sept. 1939', strict => 1, quiet => 1),
'strict: Sept. abbreviation rejected');
};
# =======================================================================
# SECTION 12: parse_datetime - GEDCOM calendar escapes
# =======================================================================
subtest 'parse_datetime - @#DJULIAN@ escape' => sub {
my $obj = $PKG->new();
# 15 Mar 1620 Julian = 25 Mar 1620 Gregorian (pre-1700, offset = 10)
my $dt = $obj->parse_datetime(date => '@#DJULIAN@ 15 Mar 1620');
isa_ok($dt, 'DateTime', '@#DJULIAN@ produces a DateTime');
is($dt->day, 25, 'DJULIAN: day advanced by offset');
is($dt->month, 3, 'DJULIAN: month unchanged');
is($dt->year, 1620, 'DJULIAN: year unchanged');
diag('@#DJULIAN@ 15 Mar 1620 => ' . $dt->dmy) if $ENV{TEST_VERBOSE};
};
subtest 'parse_datetime - @#DHEBREW@ escape reaches _convert_calendar' => sub {
# Genealogy::Gedcom::Date cannot parse Hebrew month names such as "Tishri",
# so we mock _date_parser_cached to return a plausible Gregorian parse
# result. That lets parse_datetime reach the _convert_calendar call for
# DHEBREW, which we then verify returns the from_object sentinel rather
# than the intermediate Gregorian DateTime.
Readonly my $SENTINEL_YEAR => 5783;
mock "${PKG}::_date_parser_cached" => sub {
return {
canonical => '9 Oct 2022',
day => '9',
month => 'Oct',
year => '2022',
t/integration.t view on Meta::CPAN
# Test::Without::Module blocks require() at load time; import it before the
# module under test so we can selectively hide optional back-ends.
use Test::Without::Module ();
BEGIN { use_ok('DateTime::Format::Genealogy') || BAIL_OUT('Cannot load module') }
Readonly my $PKG => 'DateTime::Format::Genealogy';
# ---------------------------------------------------------------------------
# Lightweight stubs for optional calendar back-ends.
#
# Neither DateTime::Calendar::Hebrew nor DateTime::Calendar::FrenchRevolutionary
# is installed in this environment, so we inject stubs that behave like the
# real modules. %INC entries prevent require() from searching @INC.
#
# The stubs record how they are constructed so spy-style assertions can verify
# that _convert_calendar passes the right coordinates.
# ---------------------------------------------------------------------------
my @hebrew_new_calls;
my @french_new_calls;
{
package DateTime::Calendar::Hebrew;
sub new {
my ($class, %args) = @_;
push @hebrew_new_calls, \%args;
t/integration.t view on Meta::CPAN
my $cache = $obj->{all_dates} // {};
for my $date (@DATES) {
ok(exists $cache->{$date}, "cache contains entry for '$date'");
}
diag('Cache entries: ' . join(', ', sort keys %{$cache}))
if $ENV{TEST_VERBOSE};
};
# ===========================================================================
# SECTION 6: GEDCOM calendar escapes — end-to-end with stubs installed
# ===========================================================================
subtest '@#DJULIAN@ escape applies correct offset for each century tier' => sub {
my $obj = $PKG->new();
# Offset tiers: <1700 => 10, <1800 => 11, <1900 => 12, >= 1900 => 13
Readonly my %JULIAN_CASES => (
# [ input_day, month, year ] => expected_gregorian_day (same month/year)
'15 Mar 1620' => { day => 25, offset => 10 },
'1 Mar 1750' => { day => 12, offset => 11 },
t/integration.t view on Meta::CPAN
"$date_str: day advanced by $expected->{offset} days");
}
}
};
subtest '@#DHEBREW@ escape delegates to Hebrew stub and returns converted DateTime' => sub {
# Reset the spy array so only calls from this subtest are counted.
@hebrew_new_calls = ();
# Override DateTime->from_object to return a sentinel year that proves
# _convert_calendar returned the converted object and not the original.
Readonly my $SENTINEL_YEAR => 5783;
no warnings 'redefine';
local *DateTime::from_object = sub {
return DateTime->new(year => $SENTINEL_YEAR, month => 10, day => 1);
};
my $obj = $PKG->new();
my $dt = $obj->parse_datetime('@#DHEBREW@ 9 Oct 2022');
isa_ok($dt, 'DateTime', '@#DHEBREW@ returns a DateTime');
is($dt->year, $SENTINEL_YEAR,
'@#DHEBREW@: from_object result returned, not original Gregorian');
# The stub must have been called with Gregorian coordinates from the
# date string so that _convert_calendar passed the right year/month/day.
is(scalar @hebrew_new_calls, 1, 'Hebrew::new called exactly once');
is($hebrew_new_calls[0]{year}, 2022, 'Hebrew::new passed correct year');
is($hebrew_new_calls[0]{month}, 10, 'Hebrew::new passed correct month');
is($hebrew_new_calls[0]{day}, 9, 'Hebrew::new passed correct day');
diag("Hebrew stub called with: " . join(', ', map { "$_=$hebrew_new_calls[0]{$_}" } qw(year month day)))
if $ENV{TEST_VERBOSE};
};
subtest '@#DFRENCH R@ escape delegates to FrenchRevolutionary stub' => sub {
t/integration.t view on Meta::CPAN
local %INC = %INC;
delete $INC{'DateTime/Calendar/Hebrew.pm'};
Test::Without::Module->import('DateTime::Calendar::Hebrew');
my $obj = $PKG->new();
# Must carp about conversion failure (not die).
warning_like(
sub { $obj->parse_datetime('@#DHEBREW@ 9 Oct 2022') },
qr/Hebrew calendar conversion failed/,
'missing Hebrew module: parse_datetime carps',
);
# With quiet => 1 the carp must be suppressed and undef returned.
warnings_are(
sub {
my $rc = $obj->parse_datetime(date => '@#DHEBREW@ 9 Oct 2022', quiet => 1);
ok(!defined $rc, 'missing Hebrew module + quiet: returns undef');
},
[],
t/integration.t view on Meta::CPAN
subtest 'graceful degradation without DateTime::Calendar::FrenchRevolutionary' => sub {
local %INC = %INC;
delete $INC{'DateTime/Calendar/FrenchRevolutionary.pm'};
Test::Without::Module->import('DateTime::Calendar::FrenchRevolutionary');
my $obj = $PKG->new();
warning_like(
sub { $obj->parse_datetime('@#DFRENCH R@ 22 Sep 1792') },
qr/French Republican calendar conversion failed/,
'missing FrenchRevolutionary module: parse_datetime carps',
);
warnings_are(
sub {
my $rc = $obj->parse_datetime(date => '@#DFRENCH R@ 22 Sep 1792', quiet => 1);
ok(!defined $rc, 'missing FrenchRevolutionary + quiet: returns undef');
},
[],
'missing FrenchRevolutionary + quiet: no warnings',
);
Test::Without::Module->unimport('DateTime::Calendar::FrenchRevolutionary');
$INC{'DateTime/Calendar/FrenchRevolutionary.pm'} = 1;
};
subtest 'graceful degradation with both optional calendar modules absent' => sub {
local %INC = %INC;
delete $INC{'DateTime/Calendar/Hebrew.pm'};
delete $INC{'DateTime/Calendar/FrenchRevolutionary.pm'};
Test::Without::Module->import(
'DateTime::Calendar::Hebrew',
'DateTime::Calendar::FrenchRevolutionary',
);
my $obj = $PKG->new(quiet => 1);
# Core functionality must be completely unaffected.
my $dt = $obj->parse_datetime('25 Dec 2022');
isa_ok($dt, 'DateTime', 'core parse works without optional calendar modules');
is($dt->dmy, '25-12-2022', 'correct date value');
my $julian = $obj->parse_datetime('@#DJULIAN@ 15 Mar 1620');
isa_ok($julian, 'DateTime', 'DJULIAN works without optional calendar modules');
is($julian->day, 25, 'Julian offset still applied');
# Both optional escapes must degrade gracefully (no die, no exception).
my $h = $obj->parse_datetime('@#DHEBREW@ 9 Oct 2022');
ok(!defined $h, 'DHEBREW with both absent returns undef (quiet)');
my $f = $obj->parse_datetime('@#DFRENCH R@ 22 Sep 1792');
ok(!defined $f, 'DFRENCH R with both absent returns undef (quiet)');
Test::Without::Module->unimport(
use Test::Returns;
use Readonly;
use Scalar::Util qw(blessed refaddr);
use POSIX ();
BEGIN { use_ok('DateTime::Format::Genealogy') || BAIL_OUT('Cannot load module') }
Readonly my $PKG => 'DateTime::Format::Genealogy';
# ---------------------------------------------------------------------------
# Optional calendar back-end stubs.
#
# Both modules are injected into %INC so that `require` inside the module
# short-circuits. Their `new` methods die by default, which triggers the
# "conversion failed" carp paths. Subtests that need successful conversions
# override `new` with Test::Mockingbird::mock for the duration of the test.
# ---------------------------------------------------------------------------
{
package DateTime::Calendar::Hebrew;
sub new { die "Hebrew stub: module not installed\n" }
'carp: bef prefix (not an exact date)' => 1,
'carp: aft prefix (not an exact date)' => 1,
'carp: abt prefix (not an exact date)' => 1,
'carp: 31 Nov invalid (never suppressed by quiet)' => 1,
'carp: Changing date - ISO YYYY-MM-DD normalised' => 1,
'carp: Changing date - dash range rewritten to bet' => 1,
'carp: Unparseable date - strict mode non-3-letter month' => 1,
'carp: Unparseable date - unrecognised long month name (non-strict)' => 1,
'carp: DateTime::Format::Natural parse error string' => 1,
'carp: Calendar type not supported' => 1,
'carp: Hebrew calendar conversion failed' => 1,
'carp: French Republican calendar conversion failed' => 1,
# --- Return states ----------------------------------------------------
'return: DateTime - exact parseable date' => 1,
'return: (DateTime,DateTime) list - bet...and... range' => 1,
'return: (DateTime,DateTime) list - from...to... range non-strict' => 1,
'return: undef - bet range in scalar context' => 1,
'return: undef - from range in scalar context' => 1,
'return: undef - 4-digit year-only' => 1,
'return: undef - 3-digit year-only' => 1,
'return: undef - approximate prefix' => 1,
"'xyzzy' triggers DFN error carp",
);
warnings_are(
sub { $obj->parse_datetime(date => 'xyzzy', quiet => 1) },
[],
'quiet => 1 (named) suppresses DFN error carp',
);
covered('carp: DateTime::Format::Natural parse error string');
};
subtest 'parse_datetime - carp for unsupported GEDCOM calendar type' => sub {
my $obj = $PKG->new();
# @#DROMAN@ is a valid GEDCOM escape that this module does not implement.
# The date portion ('25 Dec 2022') parses normally; _convert_calendar then
# carps when it encounters an unknown type.
warning_like(
sub { $obj->parse_datetime('@#DROMAN@ 25 Dec 2022') },
qr/Calendar type DROMAN not supported/,
'@#DROMAN@ triggers calendar-not-supported carp',
);
warnings_are(
sub { $obj->parse_datetime(date => '@#DROMAN@ 25 Dec 2022', quiet => 1) },
[],
'quiet => 1 (named) suppresses calendar-not-supported carp',
);
covered('carp: Calendar type not supported');
};
subtest 'parse_datetime - carp for Hebrew calendar conversion failure' => sub {
my $obj = $PKG->new();
# The Hebrew stub has new() die; _convert_calendar's eval catches it and
# carps the failure.
warning_like(
sub { $obj->parse_datetime('@#DHEBREW@ 9 Oct 2022') },
qr/Hebrew calendar conversion failed/,
'stub Hebrew new() failure triggers conversion-failed carp',
);
warnings_are(
sub { $obj->parse_datetime(date => '@#DHEBREW@ 9 Oct 2022', quiet => 1) },
[],
'quiet => 1 (named) suppresses Hebrew conversion-failed carp',
);
covered('carp: Hebrew calendar conversion failed');
};
subtest 'parse_datetime - carp for French Republican conversion failure' => sub {
my $obj = $PKG->new();
warning_like(
sub { $obj->parse_datetime('@#DFRENCH R@ 22 Sep 1792') },
qr/French Republican calendar conversion failed/,
'stub FrenchRevolutionary new() failure triggers conversion-failed carp',
);
warnings_are(
sub { $obj->parse_datetime(date => '@#DFRENCH R@ 22 Sep 1792', quiet => 1) },
[],
'quiet => 1 (named) suppresses French Republican carp',
);
covered('carp: French Republican calendar conversion failed');
};
# ==========================================================================
# SECTION E: parse_datetime - DateTime return conditions
# ==========================================================================
subtest 'parse_datetime - returns DateTime for exact date' => sub {
my $obj = $PKG->new();
my $dt = $obj->parse_datetime('25 Dec 2022');
isa_ok($dt, 'DateTime', '@#DJULIAN@ returns a DateTime');
is($dt->day, 25, 'DJULIAN: day advanced by 10-day offset');
is($dt->month, 3, 'DJULIAN: month unchanged');
is($dt->year, 1620, 'DJULIAN: year unchanged');
diag('@#DJULIAN@ 15 Mar 1620 => ' . $dt->dmy) if $ENV{TEST_VERBOSE};
};
subtest 'parse_datetime - GEDCOM @#DHEBREW@ escape with mocked conversion' => sub {
# Override the failing Hebrew stub with one that succeeds so we can
# verify that _convert_calendar returns the from_object result, not the
# intermediate Gregorian DateTime.
Readonly my $SENTINEL_YEAR => 5783;
mock 'DateTime::Calendar::Hebrew::new' => sub {
my ($class, %args) = @_;
return bless { %args }, $class;
};
mock 'DateTime::from_object' => sub {
return DateTime->new(year => $SENTINEL_YEAR, month => 10, day => 1);
};
( run in 2.104 seconds using v1.01-cache-2.11-cpan-364913b4093 )