DateTime-Format-Genealogy

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

If a date range is given, return a two-element array in array context, or undef in scalar context

Returns undef if the date can't be parsed,
is before AD100,
is just a year or,
if it is an approximate date starting with "c", "ca" or "abt".
Can be called as a class or object method.

    my $dt = DateTime::Format::Genealogy->new()->parse_datetime('25 Dec 2022');

Recognizes GEDCOM calendar escapes such as @#DJULIAN@, @#DHEBREW@, and @#DFRENCH R@,
converting them to DateTime objects when the appropriate calendar modules are installed.

Mandatory arguments:

- `date`

    The date to be parsed.

Optional arguments:

- `quiet`

lib/DateTime/Format/Genealogy.pm  view on Meta::CPAN

If a date range is given, return a two-element array in array context, or undef in scalar context

Returns undef if the date can't be parsed,
is before AD100,
is just a year or,
if it is an approximate date starting with "c", "ca" or "abt".
Can be called as a class or object method.

    my $dt = DateTime::Format::Genealogy->new()->parse_datetime('25 Dec 2022');

Recognizes GEDCOM calendar escapes such as @#DJULIAN@, @#DHEBREW@, and @#DFRENCH R@,
converting them to DateTime objects when the appropriate calendar modules are installed.

Mandatory arguments:

=over 4

=item * C<date>

The date to be parsed.

=back

lib/DateTime/Format/Genealogy.pm  view on Meta::CPAN

		return(__PACKAGE__->new()->parse_datetime($self));
	} elsif(ref($self) eq 'HASH') {
		return(__PACKAGE__->new()->parse_datetime($self));
	}

	my $params = Params::Get::get_params('date', @_);

	if((!ref($params->{'date'})) && (my $date = $params->{'date'})) {
		my $quiet = $params->{'quiet'};

		# Detect GEDCOM calendar escape
		my $calendar_type = 'DGREGORIAN';
		if ($date =~ s/^@#D([A-Z ]+?)@\s*//) {
			$calendar_type = 'D' . uc($1);  # normalise
		}

		# TODO: Needs much more sanity checking
		if(($date =~ /^bef\s/i) || ($date =~ /^aft\s/i) || ($date =~ /^abt\s/i)) {
			Carp::carp("$date is invalid, need an exact date to create a DateTime")
				unless($quiet);
			return;
		}
		if($date =~ /^31\s+Nov/) {
			Carp::carp("$date is invalid, there are only 30 days in November");

lib/DateTime/Format/Genealogy.pm  view on Meta::CPAN

			my $dfn = $self->{'dfn'};
			if(!defined($dfn)) {
				$self->{'dfn'} = $dfn = DateTime::Format::Natural->new();
			}
			if(($date =~ /^\d/) && (my $d = $self->_date_parser_cached($date))) {
				# D:T:Natural doesn't seem to work before AD100
				return if($date =~ /\s\d{1,2}$/);
				my $rc = $dfn->parse_datetime($d->{'canonical'});

				if($rc && $calendar_type ne 'DGREGORIAN') {
					return _convert_calendar($rc, $calendar_type, $quiet);
				}

				return $rc;
			}
			if(($date !~ /^(Abt|ca?)/i) && ($date =~ /^[\w\s,]+$/)) {
				# ACOM exports full month names and non-standard format dates e.g. U.S. format MMM, DD YYYY
				# TODO: allow that when not in strict mode
				if(my $rc = $dfn->parse_datetime($date)) {
					if($dfn->success()) {
						return $rc;

lib/DateTime/Format/Genealogy.pm  view on Meta::CPAN

	}

	# Cache and return the first parsed date if it's an array reference
	if((ref($parsed_date) eq 'ARRAY') && @{$parsed_date}) {
		return $self->{'all_dates'}{$date} = $parsed_date->[0];
	}

	return;
}

sub _convert_calendar {
	my ($dt, $calendar_type, $quiet) = @_;

	if($calendar_type eq 'DJULIAN') {
		# In a Gedcom, DJULIAN refers to a date in the Julian calendar format, using the @#DJULIAN@ escape to indicate it
		# Approximate historical offset
		my $offset_days = _julian_to_gregorian_offset($dt->year);
		return $dt->clone->add(days => $offset_days);
	} elsif ($calendar_type eq 'DHEBREW') {
		eval {
			require DateTime::Calendar::Hebrew;
			my $h = DateTime::Calendar::Hebrew->new(
				year  => $dt->year,
				month => $dt->month,
				day   => $dt->day
			);
			return DateTime->from_object(object => $h);
		};
		Carp::carp("Hebrew calendar conversion failed: $@") if $@ && !$quiet;
	} elsif ($calendar_type =~ /FRENCH R/) {
		eval {
			require DateTime::Calendar::FrenchRevolutionary;
			my $f = DateTime::Calendar::FrenchRevolutionary->new(
				year  => $dt->year,
				month => $dt->month,
				day   => $dt->day
			);
			return DateTime->from_object(object => $f);
		};
		Carp::carp("French Republican calendar conversion failed: $@") if $@ && !$quiet;
	} else {	# e.g DROMAN
		Carp::carp("Calendar type $calendar_type not supported") unless $quiet;
	}
	return $dt;
}

sub _julian_to_gregorian_offset {
	my $year = $_[0];

	# The gap widened over centuries:
	# 10 days from 5 Oct 1582 to 28 Feb 1700
	# 11 days from 1 Mar 1700 to 28 Feb 1800

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;
	}
}