How do I pretty print time duration in perl? The only thing I could come up with so far is my $interval = 1351521657387 - 1351515910623; # milliseconds my $duration = DateTime::Duration->new( seconds => POSIX::floor($interval/1000) , nanoseconds => 1000000 * ($interval % 1000), ); my $df = DateTime::Format::Duration->new( pattern => '%Y years, %m months, %e days, ' . '%H hours, %M minutes, %S seconds, %N nanoseconds', normalize => 1, ); print $df->format_duration($duration); which results in 0 years, 00 months, 0 days, 01 hours, 35 minutes, 46 seconds, 764000000 nanoseconds This is no good for me for the following reasons: I don't want to see " 0 years " (space waste) &c and I don't want to remove " %Y years " from the pattern (what if I do need years next time?) I know in advance that my precision is only milliseconds, I don't want to see the 6 zeros in the nanoseconds part. I care about prettiness/compactness/human readability much more than about precision/machine readability. I.e., I want to see something like " 1.2 years " or " 3.22 months " or " 7.88 days " or " 5.7 hours " or " 75.5 minutes " (or " 1.26 hours ", whatever looks better to you) or " 24.7 seconds " or " 133.7 milliseconds " &c (similar to how R prints difftime )

Reputation: 60054

Perl: how to pretty-print time difference (duration)

How do I pretty print time duration in perl?

The only thing I could come up with so far is

my $interval = 1351521657387 - 1351515910623; # milliseconds
my $duration = DateTime::Duration->new(
    seconds => POSIX::floor($interval/1000) ,
    nanoseconds  => 1000000 * ($interval % 1000),
);
my $df = DateTime::Format::Duration->new(
    pattern => '%Y years, %m months, %e days, ' .
               '%H hours, %M minutes, %S seconds, %N nanoseconds',
    normalize => 1,
);
print $df->format_duration($duration);

which results in

0 years, 00 months, 0 days, 01 hours, 35 minutes, 46 seconds, 764000000 nanoseconds

This is no good for me for the following reasons:

I don't want to see "0 years" (space waste) &c and I don't want to remove "%Y years" from the pattern (what if I do need years next time?)
I know in advance that my precision is only milliseconds, I don't want to see the 6 zeros in the nanoseconds part.
I care about prettiness/compactness/human readability much more than about precision/machine readability. I.e., I want to see something like "1.2 years" or "3.22 months" or "7.88 days" or "5.7 hours" or "75.5 minutes" (or "1.26 hours", whatever looks better to you) or "24.7 seconds" or "133.7 milliseconds" &c (similar to how R prints difftime)

Upvotes: 4

Answers (4)

U. Windl

Reputation: 4401

As I thought I had asked a similar question (additionally involving a reference point in time), but could not find it any more to answer it myself (maybe it got deleted), I'm hijacking this question to present my answer (2024-07-16). It's a bit like a toolkit, so you'll have to adapt it for your use case.

So here it comes as a self-testing module, hopefully correct (you might dislike the style, though):

#!/usr/bin/perl
# written for SLES12 SP5 and PERL 5.18 by U. Windl in 2024
require 5.018_000;
use warnings;
use strict;

my $verbosity = 0;                      # verbosity

use constant REF_TYPE_CODE      => 'CODE';      # ref type for code

# other constants
use constant SECS_PER_MIN               => 60;          # seconds per minute
use constant SECS_PER_HOUR              => 60 * SECS_PER_MIN;   # .. per hour
use constant SECS_PER_DAY               => 24 * SECS_PER_HOUR;  # .. per day
use constant SECS_PER_WEEK              =>  7 * SECS_PER_DAY;   # .. per week

use constant _SECS_PER_MONTH    => SECS_PER_DAY * 31;   # inexact!
use constant _SECS_PER_YEAR     => SECS_PER_DAY * 366;  # inexact!
use constant MINS_PER_HOUR      => 60;  # minutes per hour
use constant HOURS_PER_DAY      => 24;  # hours per day (no DST!)
use constant MONTHS_PER_YEAR    => 12;  # months per year

# days in given month
use constant DAYS_IN_MONTH      => [31, 28, 31, 30, 31, 30, 31,
                                    31, 30, 31, 30, 31];        # days in month

use constant DURATION_UNITS => [
    [_SECS_PER_YEAR, 'Y'],
    [_SECS_PER_MONTH, 'm'],
    [SECS_PER_WEEK, 'W'],
    [SECS_PER_DAY, 'D'],
    [0, 'T'],                           # special: time following
    [SECS_PER_HOUR, 'H'],
    [SECS_PER_MIN, 'M'],
    [1, 'S']
];

# conditionally print verbose message
sub verbose($@)
{
    my ($level, @args) = @_;
    my $fh = $level <= 0 ? \*STDERR : \*STDOUT;

    print $fh join(' ', "[$level]",
                   map {
                       my $r = ref($_);

                       (!$r || $r ne REF_TYPE_CODE) ? $_ : $_->();
                   }
                   @args), "\n"
        if ($verbosity >= $level);
}

sub days_in_month($$)
{
    my ($year, $mindex) = @_;

    $mindex += 12, --$year
        if ($mindex < 0);               # previous month of January is December
    return DAYS_IN_MONTH->[$mindex]
        if ($mindex != 1 ||
            !($year % 400 == 00 || ($year % 4 == 0 && $year % 100 != 0)));
    return 29;
}

# days in given year
sub days_in_year($)
{
    my $year = $_[0];

    return 365 - DAYS_IN_MONTH->[1] + days_in_month($year, 1);
}

use POSIX qw(floor fmod);

# Duration as components skipping units larger than max_unit or units smaller
# than min_units.  For durations exceeding one month the anchor is used as a
# calendar reference point
sub duration_components($;$$$)
{
    my ($secs, $max_unit, $min_unit, $anchor) = @_;
    my $sign = $secs >= 0 ? '+' : '-';
    my @result = ($sign);
    my $me = 'duration_components';
    my $need_more = 1;                  # at least one unit must follow

    if (defined $min_unit) {            # convert name to number
        my $v;

        foreach (@{(DURATION_UNITS)}) {
            if ($_->[1] eq $min_unit) {
                $v = $_->[0];
                last;
            }
        }
        verbose(-1, "${me}:", 'unknown min_unit', $min_unit)
            unless (defined $v);
        $min_unit = $v;
    }
    $min_unit //= DURATION_UNITS->[-1]->[0];
    if (defined $max_unit) {            # convert name to number
        my $v;

        foreach (@{(DURATION_UNITS)}) {
            if ($_->[1] eq $max_unit) {
                $v = $_->[0];
                last;
            }
        }
        verbose(-1, "${me}:", 'unknown max_unit', $max_unit)
            unless (defined $v);
        $max_unit = $v;
    }
    $max_unit //= DURATION_UNITS->[0]->[0];
    verbose(-1, "${me}:",  'inconsistent max_unit', $max_unit, 'and min_unit',
            $min_unit)
        unless ($min_unit <= $max_unit);
    $secs = -$secs
        if ($secs < 0);
    if ($secs >= 4 * SECS_PER_WEEK) {   # special handling for months and more
        my (@tm0, @tm1);
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $is_dst);

        $anchor //= time();
        verbose(5, "${me}:", "anchor=$anchor", "#secs=$secs",
                sub () { scalar(localtime $anchor) });
        @tm0 = localtime($anchor);
        $sign = $sign eq '-' ? -1 : 1;  # convert to number
        $anchor += $sign * $secs;
        verbose(6, "${me}:", "anchor=$anchor",
                sub () { scalar(localtime $anchor) });
        @tm1 = localtime($anchor);
        # to preserve @tm1, put the difference in @tm0 ("a - b" is "-(b - a)")
        foreach (0 .. 7) {
            verbose(7, "${me}:", "\$tm0[$_]=$tm0[$_]", "\$tm1[$_]=$tm1[$_]");
            $tm0[$_] -= $tm1[$_];
            $tm0[$_] *= -$sign;
            verbose(7, "${me}:", "\$tm0[$_]=$tm0[$_]");
        }
        ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $is_dst) = @tm0;
        # handle "carry ripple"
        verbose(6, "${me}:",
                "($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$is_dst)",
                "#secs=$secs");
        if ($sec < 0) {
            $sec += SECS_PER_MIN, --$min;
            verbose(7, "${me}:", "#sec=$sec", "#min=$min");
        }
        if ($min < 0) {
            $min += MINS_PER_HOUR, --$hour;
            verbose(7, "${me}:", "#min=$min", "#hour=$hour");
        }
        if ($hour < 0) {                # DST specialties 23h/25h ignored
            $hour += HOURS_PER_DAY, --$mday;
            verbose(7, "${me}:", "#hour=$hour", "#mday=$mday");
        }
        if ($mday < 0) {
            $tm0[4] -= $sign;           # one month less
            $mday += days_in_month(1900 + $tm1[5], $tm1[4]), --$mon;
            verbose(7, "${me}:", "#mday=$mday", "mon=$mon",
                    "year=$tm1[5]", "mon=$tm1[4]");
        }
        if ($mon < 0) {
            $mon += MONTHS_PER_YEAR, --$year;
            verbose(7, "${me}:", "#mon=$mon", "#year=$year");
        }
        verbose(5, "${me}:",
                "($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$is_dst)",
                "secs=$secs");
        verbose(-1, "${me}: year underflow:",
                "($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$is_dst)")
            if ($year < 0);
        if ($year > 0) {
            if ($max_unit >= _SECS_PER_YEAR) {
                my $m = $tm1[4];                # remember month

                push(@result, [$year, 'Y']);
                while ($year-- > 0) {
                    my $days;

                    --$tm1[5]           # previous year
                        if ($sign > 0);
                    $days = days_in_year(1900 + $tm1[5]);
                    $secs -= SECS_PER_DAY * $days;
                    verbose(7, "${me}:",
                            "#year=$year", "#days=$days", "#secs=$secs",
                            "year=$tm1[5]");
                    ++$tm1[5]           # next year
                        if ($sign < 0);
                }
                if ($min_unit >= _SECS_PER_YEAR) {
                    my $n = floor(1000 * $secs / _SECS_PER_YEAR) / 1000;

                    verbose(6, "${me}:", 'adding', $n, 'for min_unit=Y');
                    $result[-1]->[0] += $n;     # add remainder
                    $mon = $secs = 0;   # force stop
                }
            } else {
                $mon += 12 * $year;
                verbose(7, "${me}:", "#mon=$mon", 'added', $year, 'years');
            }
        }
         if ($mon > 0 && $max_unit >= _SECS_PER_MONTH) {
            push(@result, [$mon, 'M']);
            while ($mon > 0) {
                if ($tm0[3] != 0) {     # mday difference
                    my $days;

                    --$mon;
                    $tm1[4] -= $sign;   # previous month
                    if ($tm1[4] < 0 || $tm1[4] > 11) {
                        $tm1[4] %= 12;
                        $tm1[5] -= $sign;       # one year less
                    }
                    $days = days_in_month(1900 + $tm1[5], $tm1[4]);
                    $secs -= SECS_PER_DAY * $days;
                    verbose(7, "${me}:", "#mon=$mon", "#days=$days",
                            "#secs=$secs", "year=$tm1[5]", "mon=$tm1[4]");
                } else {
                    $secs = $tm0[0] + SECS_PER_MIN * $tm0[1] +
                        SECS_PER_HOUR * $tm0[2];
                    verbose(7, "${me}:", "#secs=$secs", 'from',
                            "$tm0[2]H", "$tm0[1]M", "$tm0[0]S");
                    last;
                }
            }
            if ($min_unit >= _SECS_PER_MONTH) {
                my $n = floor(1000 * $secs / _SECS_PER_MONTH) / 1000;

                verbose(6, "${me}:", 'adding', $n, 'for min_unit=m');
                $result[-1]->[0] += $n; # add remainder
                $secs = 0;      # force stop
            }
        }
        verbose(5, "${me}:", "year=$tm1[5]", "mon=$tm1[4]", "#secs=$secs");
        $need_more = 0
            if ($secs == 0);
        $max_unit = SECS_PER_WEEK
            if ($max_unit > SECS_PER_WEEK);     # skip years and months
        $min_unit = SECS_PER_WEEK
            if ($min_unit > SECS_PER_WEEK);     # skip years and months
    }
    foreach (@{(DURATION_UNITS)}) {
        my ($duration, $unit) = @$_;

        if ($duration <= $max_unit) {
            my $last_unit = ($duration == $min_unit);

            if ($duration == 0) {       # handle special time separator
                push(@result, ['', $unit])
                    if ($need_more);    # only if something will follow
            } elsif ($secs >= $duration || $last_unit) {
                unless ($last_unit) {
                    my $n = floor($secs / $duration);

                    push(@result, [$n, $unit]);
                    $secs = fmod($secs, $duration);
                    $need_more = 0
                        if ($secs == 0);
                } elsif ($secs > 0 || $need_more) {
                    my $n = floor(1000 * $secs / $duration) / 1000;

                    push(@result, [$n, $unit]);
                    $secs = 0;
                    last;
                }
            } # else omit zero units
        }
    }
    verbose(-1, "${me}:",  'failed', $secs, 'for max_unit', $max_unit,
            'and min_unit', $min_unit)
        unless ($#result > 0 && $secs == 0);
    return @result;
}

# duration in ISO 8601 format
sub ISO_duration($;$$$)
{
    my ($secs, $max_unit, $min_unit, $anchor) = @_;
    my @result = duration_components($secs, $max_unit, $min_unit, $anchor);
    my $result = shift(@result) eq '+' ? 'P' : '-P';

    $result .= join('', map { @$_ } @result);
    return $result;
}

my @tests;
BEGIN {
    @tests = (
        [0, 'PT0S'],
        [1, 'PT1S'],
        [-1, '-PT1S'],
        [SECS_PER_MIN, 'PT1M'],
        [SECS_PER_HOUR, 'PT1H'],
        [SECS_PER_DAY, 'P1D'],
        [SECS_PER_WEEK, 'P1W'],
        [SECS_PER_MIN + 1, 'PT1M1S'],
        [SECS_PER_HOUR + SECS_PER_MIN + 1, 'PT1H1M1S'],
        [SECS_PER_DAY + SECS_PER_HOUR + SECS_PER_MIN + 1, 'P1DT1H1M1S'],
        [SECS_PER_WEEK+ SECS_PER_DAY + SECS_PER_HOUR + SECS_PER_MIN + 1,
         'P1W1DT1H1M1S'],
        [SECS_PER_MIN, 'PT60S', 'S'],
        [SECS_PER_HOUR, 'PT60M', 'M'],
        [SECS_PER_HOUR + 1, 'PT60M1S', 'M'],
        [SECS_PER_HOUR + 1, 'PT60.016M', 'M', 'M'],
        [SECS_PER_DAY, 'PT24H', 'H'],
        [SECS_PER_WEEK, 'P7D', 'D'],
        # 946681200 = Sat Jan  1 00:00:00 2000 (CEST)
        [SECS_PER_DAY * 31, 'P1M', undef, undef, 946681200],
        [SECS_PER_DAY * -31, '-P1M', undef, undef, 946681200],
        [SECS_PER_DAY * (365 * 3 + 1), 'P3Y', undef, undef, 946681200],
        [SECS_PER_DAY * (-365 * 3), '-P3Y', undef, undef, 946681200],
        [SECS_PER_DAY * (days_in_month(2000, 0) + days_in_month(2000, 1) +
                         days_in_month(2000, 2) + days_in_month(2000, 3) +
                         days_in_month(2000, 4) + days_in_month(2000, 5) +
                         days_in_month(2000, 6) + days_in_month(2000, 7) +
                         days_in_month(2000, 8) + days_in_month(2000, 9) +
                         days_in_month(2000, 10) + days_in_month(2000, 11) +
                         days_in_month(2001, 0)) +
         SECS_PER_WEEK + SECS_PER_DAY + SECS_PER_HOUR + SECS_PER_MIN + 1,
         'P1Y1M1W1DT1H1M1S', undef, undef, 946681200],
        [34995661, 'P1Y1M1W1DT1H1M1S', 'Y', undef, 946681200],  # as above
        [34995661, 'P13M1W1DT1H1M1S', 'm', undef, 946681200],   # as above
        [34995661, 'P57W6DT1H1M1S', 'W', undef, 946681200],     # as above
        [34995661, 'P405DT1H1M1S', 'D', undef, 946681200],      # as above
        [34995661, 'PT9721H1M1S', 'H', undef, 946681200],       # as above
        [34995661, 'PT583261M1S', 'M', undef, 946681200],       # as above
        [34995661, 'PT34995661S', 'S', undef, 946681200],       # as above
        [34995661, 'P1.106Y', 'Y', 'Y', 946681200],     # as above
        [34995661, 'P1Y1.259M', 'Y', 'm', 946681200],   # as above
        [34995661, 'P1Y1M1.148W', 'Y', 'W', 946681200], # as above
        [34995661, 'P1Y1M1W1.042D', 'Y', 'D', 946681200],       # as above
        [34995661, 'P1Y1M1W1DT1.016H', 'Y', 'H', 946681200],    # as above
        [34995661, 'P1Y1M1W1DT1H1.016M', 'Y', 'M', 946681200],  # as above
        [34995661, 'P1Y1M1W1DT1H1M1S', 'Y', 'S', 946681200],    # as above
        [34995661, 'P57W6DT1.016H', 'W', 'H', 946681200],       # as above
        [-(SECS_PER_DAY * (days_in_month(1999, 11) + days_in_month(1999, 10) +
                           days_in_month(1999, 9) + days_in_month(1999, 8) +
                           days_in_month(1999, 7) + days_in_month(1999, 6) +
                           days_in_month(1999, 5) + days_in_month(1999, 4) +
                           days_in_month(1999, 3) + days_in_month(1999, 2) +
                           days_in_month(1999, 1) + days_in_month(1999, 0) +
                           days_in_month(1998, 11)) +
           SECS_PER_WEEK + SECS_PER_DAY + SECS_PER_HOUR + SECS_PER_MIN + 1),
         '-P1Y1M1W1DT1H1M1S', undef, undef, 946681200],
        # 951865200 = Wed Mar  1 00:00:00 2000 (CEST)
        [SECS_PER_DAY * 31, 'P1MT1H', undef, undef, 951865200], # DST switch!
        # 1234567890 = Sat Feb 14 00:31:30 2009 (CEST)
        [SECS_PER_DAY * 14, 'P2W', undef, undef, 1234567890],
        [SECS_PER_DAY * 28, 'P1M', undef, undef, 1234567890],
        [SECS_PER_DAY * -28, '-P4W', undef, undef, 1234567890],
        [SECS_PER_DAY * -31, '-P1M', undef, undef, 1234567890],
        [SECS_PER_DAY * -31 - 30, '-P1MT30S', undef, undef, 1234567890],
        [SECS_PER_DAY * -31 - 30, '-P1MT0.5M', undef, 'M', 1234567890],
        [SECS_PER_DAY * 365, 'P1Y', undef, undef, 1234567890],
        [SECS_PER_DAY * 365, 'P12M', 'm', undef, 1234567890],
        [SECS_PER_DAY * -365, '-P11M4W', undef, undef, 1234567890],
        [SECS_PER_DAY * 3650 + SECS_PER_HOUR * 6 + SECS_PER_MIN * 6 + 15,
         'P9Y11M3W5DT6H6M15S', undef, undef, 1234567890],
        [SECS_PER_DAY * 3650 + SECS_PER_HOUR * 6 + SECS_PER_MIN * 6,
         'P9Y11M3W5DT6.1H', undef, 'H', 1234567890],
        [SECS_PER_DAY * 3650 + SECS_PER_HOUR * 6, 'P9Y11M3W5.25D',
         undef, 'D', 1234567890],
        [SECS_PER_DAY * 365 + SECS_PER_HOUR * 6, 'P12M0.25D',
         'm', 'D', 1234567890],
        [SECS_PER_DAY * 364 + SECS_PER_HOUR * 6, 'P52W0.25D',
         'W', 'D', 1234567890],
        [SECS_PER_DAY * 367.5, 'P52.5W', 'W', 'W', 1234567890],
        [-79682500, '-P2Y6M1W3DT6H1M40S', undef, undef, 1721050231],
    );
}

$verbosity = 5;
use Test::More tests => scalar(@tests);
foreach (@tests) {
    my ($in, $out, $max, $min, $anchor) = @$_;

    is(ISO_duration($in, $max, $min, $anchor), $out);
}
done_testing();

In a real application you can create strings like 1 year, 9 months, 2 weeks, and 2.958 days ago from the resulting array (for non-English languages getting the plural and grammar right can be tricky, e.g. "vor 8 Jahren, 4 Monaten, 3 Wochen und 4.47 Tagen" vs. "... wird 2 Jahre, 8 Monate und 4 Wochen gültig sein").

If you don't want the minimum and maximum durations, you can simplify the algorithm significantly.

If you find any bugs, feel free to report.

Upvotes: -1

sds

Reputation: 60054

Here is what I ended up using:

sub difftime2string ($) {
  my ($x) = @_;
  ($x < 0) and return "-" . difftime2string(-$x);
  ($x < 1) and return sprintf("%.2fms",$x*1000);
  ($x < 100) and return sprintf("%.2fsec",$x);
  ($x < 6000) and return sprintf("%.2fmin",$x/60);
  ($x < 108000) and return sprintf("%.2fhrs",$x/3600);
  ($x < 400*24*3600) and return sprintf("%.2fdays",$x/(24*3600));
  return sprintf("%.2f years",$x/(365.25*24*3600));
}

Upvotes: 2

David W.

Reputation: 107080

I want to see something like "1.2 years" or "3.22 months" or "7.88 days"

You could use the constants in Time::Seconds:

use Time::Seconds;
use feature qw(say);
...

$time_seconds = $interval / 1000;
if ( $time_seconds > ONE_YEAR ) {
    printf "The interval is %.2f years\n", $time_seconds / ONE_YEAR;
}
else {
if ( $time_seconds > ONE_DAY ) {
    printf "The interval is %.2f days\n", $time_seconds / ONE_DAY;
}
else { 
if ( $time_seconds > ONE_HOUR ) {
    printf "The interval is %.2f hours\n", $time_seconds / ONE_HOUR;
}
else {
    say "The interval is $time_seconds seconds";
}

A switch can also be used, but it's still marked as experimental;

use feature qw(switch say);
use Time::Seconds;

...
my $time_seconds = $interval / 1000;

for ( $time_seconds ) {
    when ( $time_seconds > ONE_YEAR ) {
        printf "The interval is %.2f years\n", $time_seconds / ONE_YEAR;
    }
    when ( $time_seconds > ONE_DAY ) {
        printf "The interval is %.2f days\n", $time_seconds / ONE_DAY;
    }
    when ( $time_seconds > ONE_HOUR ) {
        printf "The interval is %.2f hours\n", $time_seconds / ONE_HOUR;
    }
    default { say "The interval is $time_seconds seconds"; }
}

There may even be a way of combining everything into an array in order to have a single Time statement. (Untested, but you get the idea):

 my @times = (
    [ INTERVAL => ONE_YEAR, VALUE => "years" ],
    [ INTERVAL => ONE_DAY,  VALUE => "days"  ],
    [ INTERVAL => ONE_HOUR, VALUE => "hours" ],
);

for my $interval ( @times ) {
    if ( $time_seconds > $interval->{INTERVAL} ) {
       printf "The interval is %.2f %s\n"
          , $time_seconds / $interval->{INTERVAL}, $interval->{VALUE};
    }
}

Not too crazy about that. You're better off simply making a pretty_time subroutine to hide the code.

say pretty_time( $interval );

Upvotes: 0

titanofold

Reputation: 2960

You could build the pattern dynamically depending on the whether or not certain values are "true".

...
push @pattern, '%Y years' if $duration->year;
push @pattern, '%m months' if $duration->month;
...
my $df = DateTime::Format::Duration->new(
    pattern => join(', ', @pattern),
    normalize => 1,
);
print $df->format_duration($duration);

Upvotes: 4

Perl: how to pretty-print time difference (duration)

Answers (4)

Related Questions