From 05a09b2b98658e4601ad15ac01b4d357164a1d99 Mon Sep 17 00:00:00 2001
From: Julian Maurice <julian.maurice@biblibre.com>
Date: Tue, 26 Mar 2024 16:19:41 +0100
Subject: [PATCH] Bug 36432: Remove circular dependency from Koha::Object

Koha::Object depends on Koha::DateUtils, which depends on C4::Context,
which depends on Koha::Config::SysPref, which depends on... Koha::Object

Apart from the circular dependency, the dependency on C4::Context alone
is problematic as it loads a bunch of modules that are not needed at all
in Koha::Object (YAML::XS and ZOOM for instance).
As Koha::Object is used as a base for a lot of modules, we should take
care to only load the minimum required.

This patch moves some date parsing code to specific modules:
- Koha::DateTime::Format::RFC3339
- Koha::DateTime::Format::SQL

and it uses them in Koha::Object and Koha::DateUtils where it is
possible.

Test plan:
1. Do not apply the patch yet and run the following command:
   `perl -cw Koha/Object.pm`
   It should print several warnings about redefined subroutines, meaning
   there is a circular dependency.
2. Apply the patch
3. Run `perl -cw Koha/Object.pm`. It should only say:
   "Koha/Object.pm syntax OK"
4. Run the following command:
    prove \
        t/DateUtils.t \
        t/Koha/DateTime/Format/RFC3339.t \
        t/db_dependent/Koha/Object.t
---
 Koha/DateTime/Format/RFC3339.pm  | 38 ++++++++++++++++++++
 Koha/DateTime/Format/SQL.pm      | 25 +++++++++++++
 Koha/DateUtils.pm                | 32 ++++-------------
 Koha/Object.pm                   | 33 +++++++++---------
 t/DateUtils.t                    |  2 +-
 t/Koha/DateTime/Format/RFC3339.t | 60 ++++++++++++++++++++++++++++++++
 t/db_dependent/Koha/Object.t     |  2 +-
 7 files changed, 149 insertions(+), 43 deletions(-)
 create mode 100644 Koha/DateTime/Format/RFC3339.pm
 create mode 100644 Koha/DateTime/Format/SQL.pm
 create mode 100755 t/Koha/DateTime/Format/RFC3339.t

diff --git a/Koha/DateTime/Format/RFC3339.pm b/Koha/DateTime/Format/RFC3339.pm
new file mode 100644
index 0000000000..65d97fc231
--- /dev/null
+++ b/Koha/DateTime/Format/RFC3339.pm
@@ -0,0 +1,38 @@
+package Koha::DateTime::Format::RFC3339;
+
+use Modern::Perl;
+
+use DateTime::Format::Builder (
+    parsers => {
+        parse_datetime => [
+            {
+                params => [ qw( year month day hour minute second time_zone ) ],
+                regex => qr/^(\d{4})-(\d{2})-(\d{2})[Tt\s](\d{2}):(\d{2}):(\d{2})(?:\.\d{1,3})?([Zz]|(?:[\+|\-](?:[01][0-9]|2[0-3]):[0-5][0-9]))$/,
+                postprocess => \&_postprocess_datetime,
+            },
+        ],
+    }
+);
+
+sub format_datetime {
+    my ($class, $dt) = @_;
+
+    my $date = $dt->strftime('%FT%T%z');
+    substr($date, -2, 0, ':'); # timezone "HHmm" => "HH:mm"
+
+    return $date;
+}
+
+sub _postprocess_datetime {
+    my %args = @_;
+    my $parsed = $args{parsed};
+
+    # system allows the 0th of the month
+    $parsed->{day} = '01' if $parsed->{day} eq '00';
+
+    $parsed->{time_zone} = 'UTC' if $parsed->{time_zone} =~ /^[Zz]$/;
+
+    return 1;
+}
+
+1;
diff --git a/Koha/DateTime/Format/SQL.pm b/Koha/DateTime/Format/SQL.pm
new file mode 100644
index 0000000000..feec20fac2
--- /dev/null
+++ b/Koha/DateTime/Format/SQL.pm
@@ -0,0 +1,25 @@
+package Koha::DateTime::Format::SQL;
+
+use Modern::Perl;
+
+use DateTime::Format::MySQL;
+
+use Koha::Config;
+
+our $timezone;
+
+sub parse_datetime {
+    my ($class, $date) = @_;
+
+    my $dt = DateTime::Format::MySQL->parse_datetime($date);
+
+    # No TZ for dates 'infinite' => see bug 13242
+    if ($dt->year < 9999) {
+        $timezone //= Koha::Config->get_instance->timezone;
+        $dt->set_time_zone($timezone);
+    }
+
+    return $dt;
+}
+
+1;
diff --git a/Koha/DateUtils.pm b/Koha/DateUtils.pm
index 86c8314b4f..6679843c0b 100644
--- a/Koha/DateUtils.pm
+++ b/Koha/DateUtils.pm
@@ -20,6 +20,7 @@ use Modern::Perl;
 use DateTime;
 use C4::Context;
 use Koha::Exceptions;
+use Koha::DateTime::Format::RFC3339;
 
 use vars qw(@ISA @EXPORT_OK);
 BEGIN {
@@ -72,6 +73,10 @@ sub dt_from_string {
         return $date_string->clone();
     }
 
+    if ($date_format eq 'rfc3339') {
+        return Koha::DateTime::Format::RFC3339->parse_datetime($date_string);
+    }
+
     my $regex;
 
     # The fallback format is sql/iso
@@ -113,28 +118,6 @@ sub dt_from_string {
             (?<year>\d{4})
         |xms;
     }
-    elsif ( $date_format eq 'rfc3339' ) {
-        $regex = qr/
-            (?<year>\d{4})
-            -
-            (?<month>\d{2})
-            -
-            (?<day>\d{2})
-            ([Tt\s])
-            (?<hour>\d{2})
-            :
-            (?<minute>\d{2})
-            :
-            (?<second>\d{2})
-            (\.\d{1,3})?(([Zz]$)|((?<offset>[\+|\-])(?<hours>[01][0-9]|2[0-3]):(?<minutes>[0-5][0-9])))
-        /xms;
-
-        # Default to UTC (when 'Z' is passed) for inbound timezone.
-        # The regex above succeeds for both 'z', 'Z' and '+/-' offset.
-        # We set tz as though Z was passed by default and then correct it later if an offset is detected
-        # by the presence fo the <offset> variable.
-        $tz = DateTime::TimeZone->new( name => 'UTC' );
-    }
     elsif ( $date_format eq 'iso' or $date_format eq 'sql' ) {
         # iso or sql format are yyyy-dd-mm[ hh:mm:ss]"
         $regex = $fallback_re;
@@ -164,7 +147,7 @@ sub dt_from_string {
                 )?
             )?
     }xms;
-    $regex .= $time_re unless ( $date_format eq 'rfc3339' );
+    $regex .= $time_re;
     $fallback_re .= $time_re;
 
     # Ensure we only accept date strings and not other characters.
@@ -310,8 +293,7 @@ sub output_pref {
     }
     elsif ( $pref =~ m/^rfc3339/ ) {
         if (!$dateonly) {
-            $date = $dt->strftime('%FT%T%z');
-            substr($date, -2, 0, ':'); # timezone "HHmm" => "HH:mm"
+            $date = Koha::DateTime::Format::RFC3339->format_datetime($dt);
         }
         else {
             $date = $dt->strftime("%Y-%m-%d");
diff --git a/Koha/Object.pm b/Koha/Object.pm
index 560dccaff2..944c060d60 100644
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -27,8 +27,9 @@ use Try::Tiny qw( catch try );
 use List::MoreUtils qw( any );
 
 use Koha::Database;
+use Koha::DateTime::Format::RFC3339;
+use Koha::DateTime::Format::SQL;
 use Koha::Exceptions::Object;
-use Koha::DateUtils qw( dt_from_string output_pref );
 use Koha::Object::Message;
 
 =head1 NAME
@@ -423,10 +424,8 @@ sub TO_JSON {
         elsif ( _datetime_column_type( $columns_info->{$col}->{data_type} ) ) {
             eval {
                 return unless $unblessed->{$col};
-                $unblessed->{$col} = output_pref({
-                    dateformat => 'rfc3339',
-                    dt         => dt_from_string($unblessed->{$col}, 'sql'),
-                });
+                my $dt = Koha::DateTime::Format::SQL->parse_datetime( $unblessed->{$col} );
+                $unblessed->{$col} = Koha::DateTime::Format::RFC3339->format_datetime($dt);
             };
         }
     }
@@ -832,19 +831,21 @@ sub attributes_from_api {
             $value = ( $value ) ? 1 : 0;
         }
         elsif ( _date_or_datetime_column_type( $columns_info->{$koha_field_name}->{data_type} ) ) {
-            try {
-                if ( $columns_info->{$koha_field_name}->{data_type} eq 'date' ) {
-                    $value = $dtf->format_date(dt_from_string($value, 'iso'))
-                        if defined $value;
-                }
-                else {
-                    $value = $dtf->format_datetime(dt_from_string($value, 'rfc3339'))
-                        if defined $value;
+            if (defined $value) {
+                try {
+                    if ( $columns_info->{$koha_field_name}->{data_type} eq 'date' ) {
+                        my $dt = DateTime::Format::MySQL->parse_date($value);
+                        $value = $dtf->format_date($dt);
+                    }
+                    else {
+                        my $dt = Koha::DateTime::Format::RFC3339->parse_datetime($value);
+                        $value = $dtf->format_datetime($dt);
+                    }
                 }
+                catch {
+                    Koha::Exceptions::BadParameter->throw( parameter => $key );
+                };
             }
-            catch {
-                Koha::Exceptions::BadParameter->throw( parameter => $key );
-            };
         }
 
         $params->{$koha_field_name} = $value;
diff --git a/t/DateUtils.t b/t/DateUtils.t
index 575e9c1358..b26be34c53 100755
--- a/t/DateUtils.t
+++ b/t/DateUtils.t
@@ -140,7 +140,7 @@ cmp_ok( $dt0->epoch(), 'eq', '1325455199', 'dt_from_string handles seconds with
 eval {
     $dt0 = dt_from_string( '2012-01-01T23:59:59.999Z+02:00', 'rfc3339' ); # Do not combine Z with +02 !
 };
-like( $@, qr/.*does not match the date format \(rfc3339\).*/, 'dt_from_string should die when passed a bad rfc3339 date string' );
+like( $@, qr/Invalid date format/, 'dt_from_string should die when passed a bad rfc3339 date string' );
 
 eval {
     $dt0 = dt_from_string('2021-11-03T10:16:59Z+00:00', 'iso'); # Z and +00 are the same, but should not be together
diff --git a/t/Koha/DateTime/Format/RFC3339.t b/t/Koha/DateTime/Format/RFC3339.t
new file mode 100755
index 0000000000..83d8c01192
--- /dev/null
+++ b/t/Koha/DateTime/Format/RFC3339.t
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+use Modern::Perl;
+use Test::More;
+use Test::Exception;
+
+BEGIN { use_ok('Koha::DateTime::Format::RFC3339'); }
+
+subtest 'UTC datetime' => sub {
+    plan tests => 7;
+
+    my $dt = Koha::DateTime::Format::RFC3339->parse_datetime('2024-01-02T10:11:12Z');
+
+    is($dt->year, 2024);
+    is($dt->month, 1);
+    is($dt->day, 2);
+    is($dt->hour, 10);
+    is($dt->minute, 11);
+    is($dt->second, 12);
+    ok($dt->time_zone->is_utc);
+};
+
+subtest 'with timezone' => sub {
+    plan tests => 7;
+
+    my $dt = Koha::DateTime::Format::RFC3339->parse_datetime('2024-01-02T10:11:12+01:30');
+
+    is($dt->year, 2024);
+    is($dt->month, 1);
+    is($dt->day, 2);
+    is($dt->hour, 10);
+    is($dt->minute, 11);
+    is($dt->second, 12);
+    is($dt->time_zone->name, '+0130');
+};
+
+subtest 'fractions of seconds are ignored' => sub {
+    plan tests => 8;
+
+    my $dt = Koha::DateTime::Format::RFC3339->parse_datetime('2024-01-02T10:11:12.34+01:30');
+
+    is($dt->year, 2024);
+    is($dt->month, 1);
+    is($dt->day, 2);
+    is($dt->hour, 10);
+    is($dt->minute, 11);
+    is($dt->second, 12);
+    is($dt->nanosecond, 0);
+    is($dt->time_zone->name, '+0130');
+};
+
+subtest 'invalid date throws an exception' => sub {
+    plan tests => 1;
+
+    throws_ok {
+        my $dt = Koha::DateTime::Format::RFC3339->parse_datetime('2024-01-02T10:11:12');
+    } qr/Invalid date format/;
+};
+
+done_testing;
diff --git a/t/db_dependent/Koha/Object.t b/t/db_dependent/Koha/Object.t
index 035d9cddef..92763c5699 100755
--- a/t/db_dependent/Koha/Object.t
+++ b/t/db_dependent/Koha/Object.t
@@ -213,7 +213,7 @@ subtest 'TO_JSON tests' => sub {
             (([Zz])|([\+|\-]([01][0-9]|2[0-3]):[0-5][0-9]))
         /xms;
     like( $updated_on, $rfc3999_regex, "Date-time $updated_on formatted correctly");
-    like( $lastseen, $rfc3999_regex, "Date-time $updated_on formatted correctly");
+    like( $lastseen, $rfc3999_regex, "Date-time $lastseen formatted correctly");
 
     # Test JSON doesn't receive strings
     my $order = $builder->build_object({ class => 'Koha::Acquisition::Orders' });
-- 
2.30.2