Performance Enhancements Redux

Changes

@@ -2,6 +2,11 @@ Revision history for Date-Utility
 
 {{$NEXT}}
 
+1.12      2024-06-14 08:30:42+02:00 Africa/Maputo
+	Remove dependency on Tie::Hash::LRU
+	Switch dependency from Moose to Moo
+	Improve datatime parsing performance
+
 1.11      2022-10-17 14:32:15+00:00 UTC
     - Replace Try::Tiny with Syntax::Keyword::Try
 

Makefile.PL

@@ -1,4 +1,4 @@
-# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.024.
+# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.032.
 use strict;
 use warnings;
 
@@ -8,7 +8,7 @@ use ExtUtils::MakeMaker 7.64;
 
 my %WriteMakefileArgs = (
   "ABSTRACT" => "A class that represents a datetime in various format",
-  "AUTHOR" => "DERIV <DERIV\@cpan.org>",
+  "AUTHOR" => "deriv.com <DERIV\@cpan.org>",
   "CONFIGURE_REQUIRES" => {
     "ExtUtils::MakeMaker" => "7.64"
   },
@@ -20,14 +20,15 @@ my %WriteMakefileArgs = (
     "Carp" => 0,
     "DateTime" => 0,
     "DateTime::TimeZone" => 0,
+    "Moo" => 0,
     "Moose" => 0,
     "POSIX" => 0,
     "Scalar::Util" => 0,
     "Syntax::Keyword::Try" => 0,
-    "Tie::Hash::LRU" => 0,
     "Time::Duration::Concise::Localize" => "2.5",
     "Time::Local" => 0,
     "Time::Piece" => 0,
+    "constant" => 0,
     "feature" => 0,
     "strict" => 0,
     "warnings" => 0
@@ -45,7 +46,7 @@ my %WriteMakefileArgs = (
     "Test::NoWarnings" => 0,
     "charnames" => 0
   },
-  "VERSION" => "1.12",
+  "VERSION" => "1.13",
   "test" => {
     "TESTS" => "t/*.t"
   }
@@ -60,6 +61,7 @@ my %FallbackPrereqs = (
   "File::Spec" => 0,
   "IO::Handle" => 0,
   "IPC::Open3" => 0,
+  "Moo" => 0,
   "Moose" => 0,
   "POSIX" => 0,
   "Scalar::Util" => 0,
@@ -70,11 +72,11 @@ my %FallbackPrereqs = (
   "Test::More" => "0.98",
   "Test::Most" => "0.22",
   "Test::NoWarnings" => 0,
-  "Tie::Hash::LRU" => 0,
   "Time::Duration::Concise::Localize" => "2.5",
   "Time::Local" => 0,
   "Time::Piece" => 0,
   "charnames" => 0,
+  "constant" => 0,
   "feature" => 0,
   "strict" => 0,
   "warnings" => 0

README.md

@@ -329,11 +329,10 @@ Returns a valid [Date::Utility](https://metacpan.org/pod/Date%3A%3AUtility) obje
 
 # DEPENDENCIES
 
-- [Moose](https://metacpan.org/pod/Moose)
+- [Moo](https://metacpan.org/pod/Moo)
 - [DateTime](https://metacpan.org/pod/DateTime)
 - [POSIX](https://metacpan.org/pod/POSIX)
 - [Scalar::Util](https://metacpan.org/pod/Scalar%3A%3AUtil)
-- [Tie::Hash::LRU](https://metacpan.org/pod/Tie%3A%3AHash%3A%3ALRU)
 - [Time::Local](https://metacpan.org/pod/Time%3A%3ALocal)
 - [Syntax::Keyword::Try](https://metacpan.org/pod/Syntax%3A%3AKeyword%3A%3ATry)
 

cpanfile

@@ -3,7 +3,6 @@ requires 'DateTime';
 requires 'Moose';
 requires 'POSIX';
 requires 'Scalar::Util';
-requires 'Tie::Hash::LRU';
 requires 'Time::Duration::Concise::Localize', '2.5';
 requires 'Time::Local';
 requires 'Time::Piece';

dist.ini

@@ -1,8 +1,8 @@
 name    = Date-Utility
-author  = binary.com <BINARY@cpan.org>
+author  = deriv.com <DERIV@cpan.org>
 license = Perl_5
-copyright_holder = Binary Services Ltd
-copyright_year   = 2022
+copyright_holder = Deriv Services Ltd.
+copyright_year   = 2024
 
 [@Author::DERIV]
 allow_dirty = lib/Date/Utility.pm

lib/Date/Utility.pm

@@ -11,7 +11,7 @@ Date::Utility - A class that represents a datetime in various format
 
 =cut
 
-our $VERSION = '1.12';
+our $VERSION = '1.13';
 
 =head1 SYNOPSIS
 
@@ -35,22 +35,17 @@ A class that represents a datetime in various format
 
 =cut
 
-use Moose;
+use Moo;
 use Carp         qw( confess croak );
 use POSIX        qw( floor );
 use Scalar::Util qw(looks_like_number);
-use Tie::Hash::LRU;
-use Time::Local qw(timegm);
+use Time::Local  qw(timegm);
 use Syntax::Keyword::Try;
 use Time::Duration::Concise::Localize;
 use POSIX qw(floor);
 
-my %popular;
-my $lru = tie %popular, 'Tie::Hash::LRU', 300;
-
 has epoch => (
     is       => 'ro',
-    isa      => 'Int',
     required => 1,
 );
 
@@ -98,8 +93,7 @@ has [qw(
         is_a_weekday
     )
 ] => (
-    is         => 'ro',
-    lazy_build => 1,
+    is => 'lazy',
 );
 
 sub _build__gmtime_attrs {
@@ -407,51 +401,34 @@ sub _build_is_a_weekday {
     return ($self->is_a_weekend) ? 0 : 1;
 }
 
-my $EPOCH_RE = qr/^-?[0-9]{1,13}$/;
-
 =head2 new
 
 Returns a Date::Utility object.
 
 =cut
 
-## no critic (ProhibitNewMethod)
-sub new {
-    my ($self, $params_ref) = @_;
-    my $new_params = {};
-
-    if (not defined $params_ref) {
-        $new_params->{epoch} = time;
-    } elsif (ref $params_ref eq 'Date::Utility') {
-        return $params_ref;
-    } elsif (ref $params_ref eq 'HASH') {
-        if (not($params_ref->{'datetime'} or $params_ref->{epoch})) {
-            confess 'Must pass either datetime or epoch to the Date object constructor';
-        } elsif ($params_ref->{'datetime'} and $params_ref->{epoch}) {
-            confess 'Must pass only one of datetime or epoch to the Date object constructor';
-        } elsif ($params_ref->{epoch}) {
-            #strip other potential parameters
-            $new_params->{epoch} = $params_ref->{epoch};
-
-        } else {
-            #strip other potential parameters
-            $new_params = _parse_datetime_param($params_ref->{'datetime'});
-        }
-    } elsif ($params_ref =~ $EPOCH_RE) {
-        $new_params->{epoch} = $params_ref;
-    } else {
-        $new_params = _parse_datetime_param($params_ref);
-    }
-
-    my $obj = $popular{$new_params->{epoch}};
+use constant EPOCH_RE         => qr/^-?[0-9]{1,13}$/o;
+use constant EPOCH_MAYBE_FRAC => qr/^-?[0-9]{1,13}(?:\.[0-9]+)?$/o;
 
-    if (not $obj) {
-        $obj = $self->_new($new_params);
-        $popular{$new_params->{epoch}} = $obj;
-    }
+sub BUILDARGS {
+    my ($class, $params_ref) = @_;
 
-    return $obj;
+    # Bare `->new`
+    return +{epoch => time} unless $params_ref;
+    # Provided epoch
+    # We cannot handle fractional seconds, so truncated if necessary
+    return +{epoch => int($params_ref)} if ($params_ref =~ EPOCH_MAYBE_FRAC);
+    # Specified with hashref
+    if (ref $params_ref eq 'HASH') {
+        my $in_epoch = $params_ref->{epoch};
+        my $in_dt    = $params_ref->{datetime};
 
+        confess 'Must pass exactly one of datetime or epoch to the hashref Date object constructor' unless $in_dt xor $in_epoch;
+        #strip other potential parameters
+        return ($in_epoch) ? +{epoch => $in_epoch} : _parse_datetime_param($in_dt);
+    }
+    return +{epoch => $params_ref->epoch} if ref $params_ref eq $class;
+    return _parse_datetime_param($params_ref);
 }
 
 =head2 _parse_datetime_param
@@ -462,16 +439,17 @@ dd-mmm-yy ddhddGMT, dd-mmm-yy, dd-mmm-yyyy, dd-Mmm-yy hh:mm:ssGMT, YYYY-MM-DD, Y
 
 =cut
 
-my $mon_re             = qr/j(?:an|u[nl])|feb|ma[ry]|a(?:pr|ug)|sep|oct|nov|dec/i;
-my $sub_second         = qr/^[0-9]+\.[0-9]+$/;
-my $date_only          = qr/^([0-3]?[0-9])-($mon_re)-([0-9]{2}|[0-9]{4})$/;
-my $time_only_tz       = qr/([0-2]?[0-9])[h:]([0-5][0-9])(?::)?([0-5][0-9])?(?:GMT)?/;
-my $date_with_time     = qr /^([0-3]?[0-9])-($mon_re)-([0-9]{2}) $time_only_tz$/;
-my $numeric_date_regex = qr/([12][0-9]{3})-?([01]?[0-9])-?([0-3]?[0-9])/;
-my $numeric_date_only  = qr/^$numeric_date_regex$/;
-my $fully_specced      = qr/^([12][0-9]{3})-?([01]?[0-9])-?([0-3]?[0-9])(?:T|\s)?([0-2]?[0-9]):?([0-5]?[0-9]):?([0-5]?[0-9])(\.[0-9]+)?(?:Z)?$/;
-my $numeric_date_only_dd_mm_yyyy = qr/^([0-3]?[0-9])-([01]?[0-9])-([12][0-9]{3})$/;
-my $datetime_yyyymmdd_hhmmss_TZ  = qr/^$numeric_date_regex $time_only_tz$/;
+# The below are for debugging interest, since `use constant` is a source pragma
+# my $mon_re             = qr/j(?:an|u[nl])|feb|ma[ry]|a(?:pr|ug)|sep|oct|nov|dec/i;
+# my $time_only_tz       = qr/([0-2]?[0-9])[h:]([0-5][0-9])(?::)?([0-5][0-9])?(?:GMT)?/;
+# my $numeric_date_regex = qr/([12][0-9]{3})-?([01]?[0-9])-?([0-3]?[0-9])/;
+use constant TEXT_DATE_ONLY => qr/^([0-3]?[0-9])-(j(?:an|u[nl])|feb|ma[ry]|a(?:pr|ug)|sep|oct|nov|dec)-([0-9]{2}|[0-9]{4})$/io;
+use constant TEXT_DATE_TIME =>
+    qr /^([0-3]?[0-9])-(j(?:an|u[nl])|feb|ma[ry]|a(?:pr|ug)|sep|oct|nov|dec)-([0-9]{2}) ([0-2]?[0-9])[h:]([0-5][0-9])(?::)?([0-5][0-9])?(?:GMT)?/io;
+use constant NUMERIC_DATE_ONLY => qr/^([12][0-9]{3})-?([01]?[0-9])-?([0-3]?[0-9])$/o;
+use constant NUMERIC_DATE_REV  => qr/^([0-3]?[0-9])-([01]?[0-9])-([12][0-9]{3})$/o;
+use constant NUMERIC_DATE_TIME => qr/^([12][0-9]{3})-?([01]?[0-9])-?([0-3]?[0-9]) ([0-2]?[0-9])[h:]([0-5][0-9])(?::)?([0-5][0-9])?(?:GMT)?$/o;
+use constant FULLY_SPECCED => qr/^([12][0-9]{3})-?([01]?[0-9])-?([0-3]?[0-9])(?:T|\s)?([0-2]?[0-9]):?([0-5]?[0-9]):?([0-5]?[0-9])(\.[0-9]+)?(?:Z)?$/o;
 
 sub _parse_datetime_param {
     my $datetime = shift;
@@ -483,14 +461,19 @@ sub _parse_datetime_param {
     # The ordering of these regexes is an attempt to match early
     # to avoid extra comparisons.  If our mix of supplied datetimes changes
     # it might be worth revisiting this.
-    if ($datetime =~ $sub_second) {
-        # We have an epoch with sub second precision which we can't handle
-        return {epoch => int($datetime)};
-    } elsif ($datetime =~ $date_only) {
+    if ($datetime =~ TEXT_DATE_ONLY) {
         $day   = $1;
         $month = month_abbrev_to_number($2);
         $year  = $3;
-    } elsif ($datetime =~ $date_with_time) {
+    } elsif ($datetime =~ NUMERIC_DATE_ONLY) {
+        $day   = $3;
+        $month = $2;
+        $year  = $1;
+    } elsif ($datetime =~ NUMERIC_DATE_REV) {
+        $day   = $1;
+        $month = $2;
+        $year  = $3;
+    } elsif ($datetime =~ TEXT_DATE_TIME) {
         $day    = $1;
         $month  = month_abbrev_to_number($2);
         $year   = $3;
@@ -499,31 +482,21 @@ sub _parse_datetime_param {
         if (defined $6) {
             $second = $6;
         }
-    } elsif ($datetime =~ $numeric_date_only) {
-        $day   = $3;
-        $month = $2;
-        $year  = $1;
-    } elsif ($datetime =~ $numeric_date_only_dd_mm_yyyy) {
-        $day   = $1;
-        $month = $2;
-        $year  = $3;
-    } elsif ($datetime =~ $fully_specced) {
+    } elsif ($datetime =~ FULLY_SPECCED) {
         $day    = $3;
         $month  = $2;
         $year   = $1;
         $hour   = $4;
         $minute = $5;
         $second = $6;
-    } elsif ($datetime =~ $datetime_yyyymmdd_hhmmss_TZ) {
+    } elsif ($datetime =~ NUMERIC_DATE_TIME) {
         $year   = $1;
         $month  = $2;
         $day    = $3;
         $hour   = $4;
         $minute = $5;
         $second = $6;
-    }
-    # Type constraints mean we can't ever end up in here.
-    else {
+    } else {
         confess "Invalid datetime format: $datetime";
     }
 
@@ -1075,7 +1048,7 @@ Check if a given datetime is an epoch timestemp, i.e. an integer of under 14 dig
 =cut
 
 sub is_epoch_timestamp {
-    return (shift // '') =~ $EPOCH_RE;
+    return (shift // '') =~ EPOCH_RE;
 }
 
 =head2 is_ddmmmyy
@@ -1301,29 +1274,21 @@ sub create_trimmed_date {
 
 *_create_trimmed_date = \&create_trimmed_date;
 
-no Moose;
-
-__PACKAGE__->meta->make_immutable(
-    constructor_name    => '_new',
-    replace_constructor => 1
-);
 1;
 __END__
 
 =head1 DEPENDENCIES
 
 =over 4
 
-=item L<Moose>
+=item L<Moo>
 
 =item L<DateTime>
 
 =item L<POSIX>
 
 =item L<Scalar::Util>
 
-=item L<Tie::Hash::LRU>
-
 =item L<Time::Local>
 
 =item L<Syntax::Keyword::Try>

t/constructor.t

@@ -7,9 +7,9 @@ require Test::NoWarnings;
 use Date::Utility;
 use charnames qw(:full);
 
-throws_ok { Date::Utility->new({}) } qr/Must pass either datetime or epoch/, 'empty parameters, no object';
+throws_ok { Date::Utility->new({}) } qr/Must pass exactly one of datetime or epoch/, 'empty parameters, no object';
 # Faily stuff
-throws_ok { Date::Utility->new({datetime => 'fake', epoch => 1}) } qr/Must pass only one of datetime or epoch/, 'both epoch and datetime';
+throws_ok { Date::Utility->new({datetime => 'fake', epoch => 1}) } qr/Must pass exactly one of datetime or epoch/, 'both epoch and datetime';
 throws_ok { Date::Utility->new(datetime => 'fake', epoch => 1); } qr/Invalid datetime format/, 'params not in a hash ref';
 throws_ok { Date::Utility->new({datetime => '991111'}); } qr/Invalid datetime format/,
     'numeric string as supplied date time is neither 8 nor 14 chars long';