File Coverage

blib/lib/DateTimeX/Moment.pm

Criterion	Covered	Total	%
statement	455	523	87.0
branch	199	260	76.5
condition	52	91	57.1
subroutine	138	160	86.2
pod	0	110	0.0
total	844	1144	73.7

package DateTimeX::Moment;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.04";

use Time::Moment 0.38;
use DateTimeX::Moment::Duration;
use DateTime::Locale;
use DateTime::TimeZone;
use Scalar::Util qw/blessed/;
use Carp ();
use POSIX qw/floor/;
use Class::Inspector;

use overload (
    'fallback' => 1,
    '<=>'      => \&_compare_overload,
    'cmp'      => \&_string_compare_overload,
    '""'       => \&_stringify,
    '-'        => \&_subtract_overload,
    '+'        => \&_add_overload,
    'eq'       => \&_string_equals_overload,
    'ne'       => \&_string_not_equals_overload,
);

use Class::Accessor::Lite ro => [qw/time_zone locale formatter/];

BEGIN {
    local $@;
    if (eval { require Data::Util; 1 }) {
        *is_instance = \&Data::Util::is_instance;
    }
    else {
        *is_instance = sub { blessed($_[0]) && $_[0]->isa($_[1]) };
    }
}

my $_DEFAULT_LOCALE = DateTime::Locale->load('en_US');
my $_FLOATING_TIME_ZONE = DateTime::TimeZone->new(name => 'floating');
my $_UTC_TIME_ZONE = DateTime::TimeZone->new(name => 'UTC');
sub _default_locale { $_DEFAULT_LOCALE }
sub _default_formatter { undef }
sub _default_time_zone { $_FLOATING_TIME_ZONE }

sub _inflate_locale {
    my ($class, $locale) = @_;
    return $class->_default_locale unless defined $locale;
    return $locale if _isa_locale($locale);
    return DateTime::Locale->load($locale);
}

sub _inflate_formatter {
    my ($class, $formatter) = @_;
    return $class->_default_formatter unless defined $formatter;
    return $formatter if _isa_formatter($formatter);
    Carp::croak 'formatter should can format_datetime.';
}

sub _inflate_time_zone {
    my ($class, $time_zone) = @_;
    return $class->_default_time_zone unless defined $time_zone;
    return $time_zone if _isa_time_zone($time_zone);
    return DateTime::TimeZone->new(name => $time_zone);
}

sub isa {
    my ($invocant, $a) = @_;
    return !!1 if $a eq 'DateTime';
    return $invocant->SUPER::isa($a);
}

sub _moment_resolve_instant {
    my ($moment, $time_zone) = @_;
    if ($time_zone->is_floating) {
        return $moment->with_offset_same_local(0);
    }
    else {
        my $offset = $time_zone->offset_for_datetime($moment) / 60;
        return $moment->with_offset_same_instant($offset);
    }
}

sub _moment_resolve_local {
    my ($moment, $time_zone) = @_;
    if ($time_zone->is_floating) {
        return $moment->with_offset_same_local(0);
    }
    else {
        my $offset = $time_zone->offset_for_local_datetime($moment) / 60;
        return $moment->with_offset_same_local($offset);
    }
}

sub new {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    $args{locale} = delete $args{language} if exists $args{language};
    my $locale    = delete $args{locale}    || $class->_default_locale;
    my $formatter = delete $args{formatter} || $class->_default_formatter;
    my $time_zone = delete $args{time_zone} || $class->_default_time_zone;

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;

    my $self = bless {
        _moment   => Time::Moment->new(%args),
        locale    => $class->_inflate_locale($locale),
        formatter => $class->_inflate_formatter($formatter),
        time_zone => $class->_inflate_time_zone($time_zone),
    } => $class;
    return $self->_adjust_to_current_offset();
}

sub now {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    $args{locale} = delete $args{language} if exists $args{language};
    my $locale    = delete $args{locale}    || $class->_default_locale;
    my $formatter = delete $args{formatter} || $class->_default_formatter;
    my $time_zone = exists $args{time_zone} ? $class->_inflate_time_zone(delete $args{time_zone}) : $_UTC_TIME_ZONE;
    if (%args) {
        my $msg = 'Invalid args: '.join ',', keys %args;
        Carp::croak $msg;
    }

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;

    return bless {
        _moment   => _moment_resolve_instant(Time::Moment->now, $time_zone),
        locale    => $class->_inflate_locale($locale),
        formatter => $class->_inflate_formatter($formatter),
        time_zone => $time_zone,
    } => $class;
}

sub from_object {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    my $object = delete $args{object}
        or Carp::croak 'object is required.';

    $args{locale} = delete $args{language} if exists $args{language};
    my $locale    = delete $args{locale}    || $class->_default_locale;
    my $formatter = delete $args{formatter} || $class->_default_formatter;
    my $time_zone = $object->can('time_zone') ? $object->time_zone : $_FLOATING_TIME_ZONE;
    if (%args) {
        my $msg = 'Invalid args: '.join ',', keys %args;
        Carp::croak $msg;
    }

    if ($object->isa(__PACKAGE__)) {
        my $self = $object->clone;
        $self->set_locale($locale);
        $self->set_formatter($formatter) if $formatter;
        return $self;
    }

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;

    my $moment;
    if (_isa_moment_convertable($object)) {
        $moment = Time::Moment->from_object($object);
    }
    else {
        require DateTime; # fallback
        my $object = DateTime->from_object(object => $object);
        if ($object->time_zone->is_floating) {
            $time_zone = $object->time_zone;
            $object->set_time_zone($_UTC_TIME_ZONE);
        }
        $moment = Time::Moment->from_object($object);
    }

    return bless {
        _moment   => _moment_resolve_instant($moment, $time_zone),
        locale    => $class->_inflate_locale($locale),
        formatter => $class->_inflate_formatter($formatter),
        time_zone => $time_zone,
    } => $class;
}

sub from_epoch {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    Carp::croak 'epoch is required.' unless exists $args{epoch};

    my $epoch = delete $args{epoch};

    $args{locale} = delete $args{language} if exists $args{language};
    my $locale    = delete $args{locale}    || $class->_default_locale;
    my $formatter = delete $args{formatter} || $class->_default_formatter;
    my $time_zone = exists $args{time_zone} ? $class->_inflate_time_zone(delete $args{time_zone}) : $_UTC_TIME_ZONE;
    if (%args) {
        my $msg = 'Invalid args: '.join ',', keys %args;
        Carp::croak $msg;
    }

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;

    my $moment = do {
        local $SIG{__WARN__} = sub { die @_ };
        Time::Moment->from_epoch($epoch);
    };

    return bless {
        _moment   => _moment_resolve_instant($moment, $time_zone),
        locale    => $class->_inflate_locale($locale),
        formatter => $class->_inflate_formatter($formatter),
        time_zone => $time_zone,
    } => $class;
}

sub today { shift->now(@_)->truncate(to => 'day') }

sub last_day_of_month {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    for my $key (qw/year month/) {
        Carp::croak "Parameter: $key is required." unless defined $args{$key};
    }
    Carp::croak q{Parameter 'month' is out of the range [1, 12]} if 0 > $args{month} || $args{month} > 12;

    my ($year, $month) = @args{qw/year month/};
    my $day = _month_length($year, $month);

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    return $class->new(%args, day => $day);
}

my @_MONTH_LENGTH = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
sub _month_length {
    my ($year, $month) = @_;
    my $day = $_MONTH_LENGTH[$month-1];
    $day++ if $month == 2 && _is_leap_year($year);
    return $day;
}

sub _is_leap_year {
    my $year = shift;
    return 0 if $year % 4;
    return 1 if $year % 100;
    return 0 if $year % 400;
    return 1;
}

sub from_day_of_year {
    my $class = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
    for my $key (qw/year day_of_year/) {
        Carp::croak "Parameter: $key is required." unless defined $args{$key};
    }

    my $day_of_year = delete $args{day_of_year};

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    my $self = $class->new(%args);
    $self->{_moment} = $self->{_moment}->with_day_of_year($day_of_year);
    return $self->_adjust_to_current_offset();
}

sub _adjust_to_current_offset {
    my $self = shift;
    return $self if $self->{time_zone}->is_floating;

    my $offset = $self->{time_zone}->offset_for_local_datetime($self->{_moment}) / 60;
    $self->{_moment} = $self->{_moment}->with_offset_same_local($offset);

    return $self;
}

sub clone { bless { %{$_[0]} }, ref $_[0] }

sub year { shift->{_moment}->year }
sub year_0 { shift->{_moment}->year - 1 }
sub month_0 { shift->{_moment}->month - 1 }
sub month { shift->{_moment}->month }
sub day_of_week { shift->{_moment}->day_of_week }
sub day_of_week_0 { shift->{_moment}->day_of_week - 1 }
sub day_of_month { shift->{_moment}->day_of_month }
sub day_of_month_0 { shift->{_moment}->day_of_month - 1 }
sub day_of_quarter { shift->{_moment}->day_of_quarter }
sub day_of_quarter_0 { shift->{_moment}->day_of_quarter - 1 }
sub day_of_year { shift->{_moment}->day_of_year }
sub day_of_year_0 { shift->{_moment}->day_of_year - 1 }
sub quarter { shift->{_moment}->quarter }
sub quarter_0 { shift->{_moment}->quarter - 1 }
sub weekday_of_month { int((shift->{_moment}->day_of_month - 1) / 7) + 1 }
sub hour { shift->{_moment}->hour }
sub hour_1 { shift->{_moment}->hour || 24 }
sub hour_12 { shift->hour_12_0 || 12 }
sub hour_12_0 { shift->{_moment}->hour % 12 }
sub minute { shift->{_moment}->minute }
sub second { shift->{_moment}->second }

sub fractional_second {
    my $moment = shift->{_moment};
    return $moment->second + $moment->nanosecond / 1_000_000_000;
}

sub nanosecond { shift->{_moment}->nanosecond }
sub millisecond { shift->{_moment}->millisecond }
sub microsecond { shift->{_moment}->microsecond }

sub is_leap_year { _is_leap_year(shift->{_moment}->year) }
sub leap_seconds { 0 } ## XXX: time moment doesn't have a leap seconds. So always leap seconds are zero.

sub week_number { shift->{_moment}->week }
sub week_year { Carp::croak 'not yet implemented' }

# ISO says that the first week of a year is the first week containing
# a Thursday. Extending that says that the first week of the month is
# the first week containing a Thursday. ICU agrees.
sub week_of_month {
    my $self = shift;
    my $thu  = $self->day + 4 - $self->day_of_week;
    return int(($thu + 6) / 7);
}

sub offset { $_[0]->{time_zone}->offset_for_datetime($_[0]) }

sub ymd {
    my $moment = shift->{_moment};
    my $separator = defined $_[0] ? shift : '-';
    return sprintf '%04d%s%02d%s%02d',
        $moment->year, $separator,
        $moment->month, $separator,
        $moment->day_of_month;
}

sub mdy {
    my $moment = shift->{_moment};
    my $separator = defined $_[0] ? shift : '-';
    return sprintf '%02d%s%02d%s%04d',
        $moment->month, $separator,
        $moment->day_of_month, $separator,
        $moment->year;
}

sub dmy {
    my $moment = shift->{_moment};
    my $separator = defined $_[0] ? shift : '-';
    return sprintf '%02d%s%02d%s%04d',
        $moment->day_of_month, $separator,
        $moment->month, $separator,
        $moment->year;
}

sub hms {
    my $moment = shift->{_moment};
    my $separator = defined $_[0] ? shift : ':';
    return sprintf '%02d%s%02d%s%02d',
        $moment->hour, $separator,
        $moment->minute, $separator,
        $moment->second;
}

sub iso8601 { $_[0]->ymd('-').'T'.$_[0]->hms(':') }

# NOTE: no nanoseconds, no leap seconds
sub utc_rd_values   { $_[0]->{_moment}->utc_rd_values }
sub local_rd_values { $_[0]->{_moment}->local_rd_values }
sub utc_rd_as_seconds   { $_[0]->{_moment}->utc_rd_as_seconds }
sub local_rd_as_seconds { $_[0]->{_moment}->local_rd_as_seconds }
sub utc_year { shift->{_moment}->utc_year }

## NOTE: Time::Moment supports date in anno Domini omly.
sub ce_year { shift->{_moment}->year }
sub era_name { $_[0]->{locale}->era_wide->[1] }
sub era_abbr { $_[0]->{locale}->era_abbreviated->[1] }
sub christian_era { 'AD' }
sub secular_era   { 'CE' }
sub year_with_era           { ( abs $_[0]->ce_year ) . $_[0]->era_abbr }
sub year_with_christian_era { ( abs $_[0]->ce_year ) . $_[0]->christian_era }
sub year_with_secular_era   { ( abs $_[0]->ce_year ) . $_[0]->secular_era }

sub month_name { $_[0]->{locale}->month_format_wide->[ $_[0]->month_0() ] }
sub month_abbr { $_[0]->{locale}->month_format_abbreviated->[ $_[0]->month_0() ] }
sub day_name   { $_[0]->{locale}->day_format_wide->[ $_[0]->day_of_week_0() ] }
sub day_abbr   { $_[0]->{locale}->day_format_abbreviated->[ $_[0]->day_of_week_0() ] }
sub am_or_pm   { $_[0]->{locale}->am_pm_abbreviated->[ $_[0]->{_moment}->hour < 12 ? 0 : 1 ] }
sub quarter_name { $_[0]->{locale}->quarter_format_wide->[ $_[0]->quarter_0() ] }
sub quarter_abbr { $_[0]->{locale}->quarter_format_abbreviated->[ $_[0]->quarter_0() ] }

sub local_day_of_week {
    my $self = shift;
    return 1 + ($self->{_moment}->day_of_week - $self->{locale}->first_day_of_week) % 7;
}

sub mjd { $_[0]->{_moment}->mjd }
sub jd { $_[0]->{_moment}->jd }
sub rd { $_[0]->{_moment}->rd }

sub epoch { shift->{_moment}->epoch }

sub hires_epoch {
    my $moment = shift->{_moment};
    return $moment->epoch + $moment->nanosecond / 1_000_000_000;
}

sub is_finite   { 1 }
sub is_infinite { 0 }

sub _mod_and_keep_sign {
    my ($lhs, $rhs) = @_;
    my $sign = $lhs < 0 ? -1 : 1;
    return $sign * ($lhs % $rhs);
}

sub _delta_days {
    my ($lhs, $rhs) = @_;
    return $lhs->day_of_month - $rhs->day_of_month if $lhs->day_of_month >= $rhs->day_of_month;
    return $lhs->day_of_month + (_month_length($rhs->year, $rhs->month) - $rhs->day_of_month);
}

sub subtract_datetime {
    my ($lhs, $rhs) = @_;
    my $class = ref $lhs;

    # normalize
    $rhs = $class->from_object(object => $rhs) unless $rhs->isa($class);
    $rhs = $rhs->clone->set_time_zone($lhs->time_zone) unless $lhs->time_zone->name eq $rhs->time_zone->name;

    my ($lhs_moment, $rhs_moment) = map { $_->{_moment} } ($lhs, $rhs);

    my $sign = $lhs_moment < $rhs_moment ? -1 : 1;
    ($lhs_moment, $rhs_moment) = ($rhs_moment, $lhs_moment) if $sign == -1;

    my $months      = $rhs_moment->delta_months($lhs_moment);
    my $days        = _delta_days($lhs_moment, $rhs_moment);
    my $minutes     = 60 * ($lhs_moment->hour - $rhs_moment->hour) + ($lhs_moment->minute - $rhs_moment->minute);
    my $seconds     = $lhs_moment->second - $rhs_moment->second;
    my $nanoseconds = $lhs_moment->nanosecond - $rhs_moment->nanosecond;

    if ($nanoseconds < 0) {
        $nanoseconds += 1_000_000_000;
        $seconds--;
    }
    if ($seconds < 0) {
        $seconds += 60;
        $minutes--;
    }
    if ($minutes < 0) {
        $minutes += 24 * 60;
        $days--;
    }
    if ($days < 0) {
        my $max_days = _month_length($rhs->year, $rhs_moment->month);
        $days += $max_days;
        $months--;
    }

    return DateTimeX::Moment::Duration->new(
        months      => $sign * $months,
        days        => $sign * $days,
        minutes     => $sign * $minutes,
        seconds     => $sign * $seconds,
        nanoseconds => $sign * $nanoseconds,
    );
}

sub subtract_datetime_absolute {
    my ($lhs, $rhs) = @_;
    my $class = ref $lhs;

    # normalize
    $rhs = $class->from_object(object => $rhs) unless $rhs->isa($class);
    $rhs = $rhs->clone->set_time_zone($lhs->time_zone) unless $lhs->time_zone eq $rhs->time_zone;

    my ($lhs_moment, $rhs_moment) = map { $_->{_moment} } ($lhs, $rhs);
    my $sign = $lhs_moment < $rhs_moment ? -1 : 1;
    ($lhs_moment, $rhs_moment) = ($rhs_moment, $lhs_moment) if $sign == -1;

    my $seconds     = $rhs_moment->delta_seconds($lhs_moment);
    my $nanoseconds = $rhs_moment->delta_nanoseconds($lhs_moment) % 1_000_000_000;

    return DateTimeX::Moment::Duration->new(
        seconds     => $sign * $seconds,
        nanoseconds => $sign * $nanoseconds,
    );
}

sub _stringify {
    my $self = shift;
    return $self->iso8601 unless defined $self->{formatter};
    return $self->{formatter}->format_datetime($self);
}

sub _compare_overload {
    my ($lhs, $rhs, $flip) = @_;
    return undef unless defined $rhs;
    return $flip ? -$lhs->compare($rhs) : $lhs->compare($rhs);
}

sub _string_compare_overload {
    my ($lhs, $rhs, $flip) = @_;
    return undef unless defined $rhs;
    goto \&_compare_overload if _isa_datetime_compareble($rhs);

    # One is a DateTimeX::Moment object, one isn't. Just stringify and compare.
    my $sign = $flip ? -1 : 1;
    return $sign * ("$lhs" cmp "$rhs");
}

sub _string_not_equals_overload { !_string_equals_overload(@_) }
sub _string_equals_overload {
    my ($class, $lhs, $rhs) = ref $_[0] ? (ref $_[0], @_) : @_;
    return undef unless defined $rhs;
    return !$class->compare($lhs, $rhs) if _isa_datetime_compareble($rhs);
    return "$lhs" eq "$rhs";
}

sub _add_overload {
    my ($dt, $dur, $flip) = @_;
    ($dur, $dt) = ($dt, $dur) if $flip;

    unless (_isa_duration($dur)) {
        my $class = ref $dt;
        Carp::croak("Cannot add $dur to a $class object ($dt).\n"
                    . ' Only a DateTime::Duration object can '
                    . " be added to a $class object.");
    }

    return $dt->clone->add_duration($dur);
}

sub _subtract_overload {
    my ($date1, $date2, $flip) = @_;
    ($date2, $date1) = ($date1, $date2) if $flip;

    if (_isa_duration($date2)) {
        my $new = $date1->clone;
        $new->add_duration($date2->inverse);
        return $new;
    }
    elsif (_isa_datetime($date2)) {
        return $date1->subtract_datetime($date2);
    }

    my $class = ref $date1;
    Carp::croak(
        "Cannot subtract $date2 from a $class object ($date1).\n"
        . ' Only a DateTime::Duration or DateTimeX::Moment object can '
        . " be subtracted from a $class object." );
}

sub compare { shift->_compare(@_, 0) }
sub compare_ignore_floating { shift->_compare(@_, 1) }

sub _compare {
    my ($class, $lhs, $rhs, $consistent) = ref $_[0] ? (__PACKAGE__, @_) : @_;
    return undef unless defined $rhs;

    if (!_isa_datetime_compareble($lhs) || !_isa_datetime_compareble($rhs)) {
        Carp::croak("A DateTimeX::Moment object can only be compared to another DateTimeX::Moment object ($lhs, $rhs).");
    }

    if (!$consistent && $lhs->can('time_zone') && $rhs->can('time_zone')) {
        my $is_floating1 = $lhs->time_zone->is_floating;
        my $is_floating2 = $rhs->time_zone->is_floating;

        if ($is_floating1 && !$is_floating2) {
            $lhs = $lhs->clone->set_time_zone($rhs->time_zone);
        }
        elsif ($is_floating2 && !$is_floating1) {
            $rhs = $rhs->clone->set_time_zone($lhs->time_zone);
        }
    }

    if ($lhs->isa(__PACKAGE__) && $rhs->isa(__PACKAGE__)) {
        return $lhs->{_moment}->compare($rhs->{_moment});
    }

    my @lhs_components = $lhs->utc_rd_values;
    my @rhs_components = $rhs->utc_rd_values;

    for my $i (0 .. 2) {
        return $lhs_components[$i] <=> $rhs_components[$i] if $lhs_components[$i] != $rhs_components[$i];
    }

    return 0;
}

sub set {
    my $self = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    my $src = $self->{_moment};

    my %params;
    for my $unit (qw/year month day hour minute second nanosecond/) {
        my $key = $unit eq 'day' ? 'day_of_month' : $unit;
        $params{$unit} = exists $args{$unit} ? delete $args{$unit} : $src->$key();
    }
    if (%args) {
        my $msg = 'Invalid args: '.join ',', keys %args;
        Carp::croak $msg;
    }

    $self->{_moment} = Time::Moment->new(%params);

    return $self->_adjust_to_current_offset();
}

sub set_year       { $_[0]->set(year       => $_[1]) }
sub set_month      { $_[0]->set(month      => $_[1]) }
sub set_day        { $_[0]->set(day        => $_[1]) }
sub set_hour       { $_[0]->set(hour       => $_[1]) }
sub set_minute     { $_[0]->set(minute     => $_[1]) }
sub set_second     { $_[0]->set(second     => $_[1]) }
sub set_nanosecond { $_[0]->set(nanosecond => $_[1]) }

sub add      { shift->_calc_date(plus  => @_) }
sub subtract { shift->_calc_date(minus => @_) }

sub _calc_date {
    my $self = shift;
    my $type = shift;
    return $self->_calc_duration($type => @_) if @_ == 1 && _isa_duration($_[0]);

    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    my $moment = $self->{_moment};

    {
        if (exists $args{years} && exists $args{months}) {
            my $factor = ($type eq 'plus') ? 12 : -12;
            $args{months} += delete($args{years}) * $factor;
        }

        my $result = $moment;
        for my $unit (qw/weeks days months years/) {
            next unless exists $args{$unit};
            my $method = $type.'_'.$unit;
            $result = $result->$method(delete $args{$unit});
        }

        if (!$moment->is_equal($result)) {
            $moment = _moment_resolve_local($result, $self->{time_zone});
        }
    }

    {
        my $result = $moment;
        for my $unit (qw/nanoseconds seconds minutes hours/) {
            next unless exists $args{$unit};
            my $method = $type.'_'.$unit;
            $result = $result->$method(delete $args{$unit});
        }

        if (!$moment->is_equal($result)) {
            $moment = _moment_resolve_instant($result, $self->{time_zone});
        }
    }

    if (%args) {
        my $msg = 'Invalid args: '.join ',', keys %args;
        Carp::croak $msg;
    }

    $self->{_moment} = $moment;
    return $self;
}

sub delta_md {
    my ($lhs, $rhs) = reverse sort { $a <=> $b } @_;
    return $lhs->clone->truncate(to => 'day')->subtract_datetime($rhs->clone->truncate(to => 'day'));
}

sub delta_ms {
    my ($lhs, $rhs) = reverse sort { $a <=> $b } @_;
    my $days = floor($lhs->{_moment}->jd - $rhs->{_moment}->jd);
    my $duration = $lhs->subtract_datetime($rhs);
    return DateTimeX::Moment::Duration->new(
        hours   => $duration->hours + ($days * 24),
        minutes => $duration->minutes,
        seconds => $duration->seconds,
    );
}

sub delta_years        { shift->_delta(years        => @_) }
sub delta_months       { shift->_delta(months       => @_) }
sub delta_weeks        { shift->_delta(weeks        => @_) }
sub delta_days         { shift->_delta(days         => @_) }
sub delta_hours        { shift->_delta(hours        => @_) }
sub delta_minutes      { shift->_delta(minutes      => @_) }
sub delta_seconds      { shift->_delta(seconds      => @_) }
sub delta_milliseconds { shift->_delta(milliseconds => @_) }
sub delta_microseconds { shift->_delta(microseconds => @_) }
sub delta_nanoseconds  { shift->_delta(nanoseconds  => @_) }

sub _delta {
    my ($self, $unit, $another) = @_;
    my $lhs = $self->{_moment};
    my $rhs = $another->isa(__PACKAGE__) ? $another->{_moment} : Time::Moment->from_object($another);
       $rhs = Time::Moment->from_object($rhs) unless _isa_moment($rhs);

    my $method = "delta_$unit";
    my $diff = $lhs > $rhs ? $rhs->$method($lhs) : $lhs->$method($rhs);

    # normalize
    if ($unit eq 'milliseconds') {
        $unit = 'nanoseconds';
        $diff *= 1_000_000;
    }
    elsif ($unit eq 'microseconds') {
        $unit = 'nanoseconds';
        $diff *= 1_000;
    }

    return DateTimeX::Moment::Duration->new($unit => $diff);
}

# strftime
{
    my %CUSTOM_HANDLER = (
        a => sub { $_[0]->day_abbr },
        A => sub { $_[0]->day_name },
        b => sub { $_[0]->month_abbr },
        B => sub { $_[0]->month_name },
        c => sub { $_[0]->format_cldr($_[0]->{locale}->datetime_format_default()) },
        p => sub { $_[0]->am_or_pm },
        P => sub { lc $_[0]->am_or_pm },
        r => sub { $_[0]->strftime('%I:%M:%S %p') },
        x => sub { $_[0]->format_cldr($_[0]->{locale}->date_format_default()) },
        X => sub { $_[0]->format_cldr($_[0]->{locale}->time_format_default()) },
        Z => sub { $_[0]->{time_zone}->short_name_for_datetime($_[0]) },
    );

    my $CUSTOM_HANDLER_REGEXP = '(?:(?<=[^%])((?:%%)*)|\A)%(['.(join '', keys %CUSTOM_HANDLER).'])';

    sub strftime {
        my ($self, @formats) = @_;
        my $moment = $self->{_moment};

        my @ret;
        for my $format (@formats) {
            # XXX: follow locale/time_zone
            $format =~ s/$CUSTOM_HANDLER_REGEXP/($1||'').$CUSTOM_HANDLER{$2}->($self)/omsge;
            $format =~ s/(?:(?<=[^%])((?:%%)*)|\A)%\{(\w+)\}/($1||'').($self->can($2) ? $self->$2 : "%{$2}")/omsge;

            my $ret = $moment->strftime($format);
            return $ret unless wantarray;

            push @ret => $ret;
        }

        return @ret;
    }
}

sub format_cldr {
    my $self = shift;

    # fallback
    require DateTime;
    return DateTime->from_object(
        object => $self,
        locale => $self->{locale},
    )->format_cldr(@_);
}

sub set_time_zone {
    my ($self, $time_zone) = @_;
    Carp::croak 'required time_zone' if @_ != 2;

    $time_zone = $self->_inflate_time_zone($time_zone);
    return $self if $time_zone == $self->{time_zone};
    return $self if $time_zone->name eq $self->{time_zone}->name;

    $self->{_moment} = do {
        if ($self->{time_zone}->is_floating) {
            _moment_resolve_local($self->{_moment}, $time_zone)
        }
        else {
            _moment_resolve_instant($self->{_moment}, $time_zone);
        }
    };
    $self->{time_zone} = $time_zone;
    return $self;
}

sub is_dst { $_[0]->{time_zone}->is_dst_for_datetime($_[0]) }

sub time_zone_long_name  { $_[0]->{time_zone}->name }
sub time_zone_short_name { $_[0]->{time_zone}->short_name_for_datetime($_[0]) }

sub truncate :method {
    my $self = shift;
    my %args = (@_ == 1 && ref $_[0] eq 'HASH') ? %{$_[0]} : @_;

    my $to = delete $args{to}
        or Carp::croak "Parameter: to is required.";
    if (%args) {
        my $msg = 'Invalid args: '.join ',', keys %args;
        Carp::croak $msg;
    }

    if ($to eq 'week' || $to eq 'local_week') {
        my $first_day_of_week = $to eq 'local_week' ? $self->{locale}->first_day_of_week : 1;
        my $day_diff = ($self->{_moment}->day_of_week - $first_day_of_week) % 7;
        $self->subtract(days => $day_diff) if $day_diff;
        eval {
            $self->truncate(to => 'day');
        };
        if ($@) {
            $self->add(days => $day_diff); # rollback
            die $@;
        }
        return $self;
    }

    my %param;
    $param{nanosecond} = 0; goto DO_TRUNCATE if $to eq 'second';
    $param{second}     = 0; goto DO_TRUNCATE if $to eq 'minute';
    $param{minute}     = 0; goto DO_TRUNCATE if $to eq 'hour';
    $param{hour}       = 0; goto DO_TRUNCATE if $to eq 'day';
    $param{day}        = 1; goto DO_TRUNCATE if $to eq 'month';
    $param{month}      = 1; goto DO_TRUNCATE if $to eq 'year';

    Carp::croak "The 'to' parameter '$to' is unsupported.";

 DO_TRUNCATE:
    return $self->set(%param);
}

my %CALC_DURATION_METHOD = (plus => 'add_duration', minus => 'subtract_duration');
sub _calc_duration {
    my ($self, $type, $duration) = @_;
    my $method = $CALC_DURATION_METHOD{$type};
    return $self->$method($duration);
}

sub subtract_duration { $_[0]->add_duration($_[1]->inverse) }
sub add_duration {
    my ($self, $duration) = @_;
    Carp::croak 'required duration object' unless _isa_duration($duration);

    # simple optimization
    return $self if $duration->is_zero;

    if (!$duration->is_limit_mode) {
        Carp::croak 'DateTimeX::Moment supports limit mode only.';
    }

    return $self->add($duration->deltas);
}

sub set_locale {
    my ($self, $locale) = @_;
    Carp::croak 'required locale' if @_ != 2;
    $self->{locale} = $self->_inflate_locale($locale);
    return $self;
}

sub set_formatter {
    my ($self, $formatter) = @_;
    $self->{formatter} = $self->_inflate_formatter($formatter);
    return $self;
}

# internal utilities
sub _isa_locale { is_instance($_[0] => 'DateTime::Locale::FromData') || is_instance($_[0] => 'DateTime::Locale::Base') }
sub _isa_formatter { _isa_invocant($_[0]) && $_[0]->can('format_datetime') }
sub _isa_time_zone { is_instance($_[0] => 'DateTime::TimeZone') }
sub _isa_datetime { is_instance($_[0] => 'DateTime') }
sub _isa_datetime_compareble { blessed($_[0]) && $_[0]->can('utc_rd_values') }
sub _isa_duration { is_instance($_[0] => 'DateTime::Duration') }
sub _isa_moment { is_instance($_[0] => 'Time::Moment') }
sub _isa_moment_convertable { blessed($_[0]) && $_[0]->can('__as_Time_Moment') }
sub _isa_invocant { blessed $_[0] || Class::Inspector->loaded("$_[0]") }

# define aliases
{
    my %aliases = (
        month            => [qw/mon/],
        day_of_month     => [qw/day mday/],
        day_of_month_0   => [qw/day_0 mday_0/],
        day_of_week      => [qw/wday dow/],
        day_of_week_0    => [qw/wday_0 dow_0/],
        day_of_quarter   => [qw/doq/],
        day_of_quarter_0 => [qw/doq_0/],
        day_of_year      => [qw/doy/],
        day_of_year_0    => [qw/doy_0/],
        ymd              => [qw/date/],
        hms              => [qw/time/],
        iso8601          => [qw/datetime/],
        minute           => [qw/min/],
        second           => [qw/sec/],
        locale           => [qw/language/],
        era_abbr         => [qw/era/],
    );

    for my $src (keys %aliases) {
        my $code = do {
            no strict qw/refs/;
            \&{$src};
        };

        for my $dst (@{ $aliases{$src} }) {
            no strict qw/refs/;
            *{$dst} = $code;
        }
    }
}

1;
__END__