Data-Tools/lib/Data/Tools/Time.pm
##############################################################################
#
# Data::Tools::Time perl module
# Copyright (c) 2013-2024 Vladi Belperchinov-Shabanski "Cade"
# <cade@noxrun.com> <cade@bis.bg> <cade@cpan.org>
# http://cade.noxrun.com/
#
# GPL
#
##############################################################################
package Data::Tools::Time;
use strict;
use Exporter;
use Carp;
use Data::Tools;
use Date::Calc qw(:all);
use Time::JulianDay;
our $VERSION = '1.45';
our @ISA = qw( Exporter );
our @EXPORT = qw(
unix_time_diff_in_words
unix_time_diff_in_words_short
unix_time_diff_in_words_relative
unix_time_diff_in_words_relative_short
julian_date_diff_in_words
julian_date_diff_in_words_relative
get_local_time_only
get_local_julian_day
get_local_year
get_year_month_days
julian_date_from_utime
julian_date_add_ymd
julian_date_to_ymd
julian_date_from_ymd
julian_date_from_md
julian_date_goto_first_dow
julian_date_goto_last_dow
julian_date_goto_first_dom
julian_date_goto_last_dom
julian_date_goto_first_doy
julian_date_goto_last_doy
julian_date_get_dow
julian_date_get_day
julian_date_get_month
julian_date_get_year
julian_date_month_days_ym
julian_date_month_days
julian_date_to_iso
julian_date_from_iso
utime_from_julian_date
utime_from_ymdhms
utime_to_ymdhms
utime_to_iso
utime_from_iso
utime_to_iso_ext
utime_from_iso_ext
utime_split_to_jdt
utime_split_to_utt
utime_join_jdt
utime_join_utt
utime_add_ymdhms
utime_add_ymd
utime_add_hms
utime_month_days
utime_goto_midnight
utime_goto_first_dow
utime_goto_last_dow
utime_goto_first_dom
utime_goto_last_dom
utime_goto_first_doy
utime_goto_last_doy
utime_get_dow
utime_get_moy
utime_get_woy
);
our %EXPORT_TAGS = (
'all' => \@EXPORT,
'none' => [],
);
##############################################################################
sub unix_time_diff_in_words
{
my $utd = abs( int( shift() ) ); # absolute difference in seconds
if( $utd < 1 )
{
return "now";
}
if( $utd < 60 ) # less than 1 minute
{
my $ss = str_countable( $utd, "second", "seconds" );
return "$utd $ss";
};
if( $utd < 60*60 ) # less than 1 hour
{
my $m = int( $utd / 60 );
my $ms = str_countable( $m, "minute", "minutes" );
return "$m $ms";
};
if( $utd < 2*24*60*60 ) # less than 2 days (48 hours)
{
my $h = int( $utd / ( 60 * 60 ) );
my $m = int( $utd % ( 60 * 60 ) / 60 );
my $hs = str_countable( $h, "hour", "hours" );
my $ms = str_countable( $m, "minute", "minutes" );
return "$h $hs, $m $ms";
};
if( $utd < 7*24*60*60 ) # less than 1 week (168 hours)
{
my $d = int( $utd / ( 24 * 60 * 60 ) );
my $h = int( $utd % ( 24 * 60 * 60 ) / ( 60 * 60 ) );
my $ds = str_countable( $d, "day", "days" );
my $hs = str_countable( $h, "hour", "hours" );
return "$d $ds, $h $hs";
};
if( $utd < 60*24*60*60 ) # less than 2 months
{
my $d = int( $utd / ( 24 * 60 * 60 ) );
my $ds = str_countable( $d, "day", "days" );
return "$d $ds";
};
if( 42 ) # more than 2 months
{
my $m = int( $utd / ( 30*24*60*60 ) ); # "month" is approximated to 30 days
my $ms = str_countable( $m, "month", "months" );
return "$m $ms";
}
}
sub unix_time_diff_in_words_short
{
my $utd = abs( int( shift() ) ); # absolute difference in seconds
if( $utd < 1 )
{
return "now";
}
if( $utd < 60 ) # less than 1 minute
{
my $ss = str_countable( $utd, "second", "seconds" );
return "$utd $ss";
};
if( $utd < 60*60 ) # less than 1 hour
{
my $m = int( $utd / 60 );
my $ms = str_countable( $m, "minute", "minutes" );
return "$m $ms";
};
if( $utd < 2*24*60*60 ) # less than 2 days (48 hours)
{
my $h = int( $utd / ( 60 * 60 ) );
my $hs = str_countable( $h, "hour", "hours" );
return "$h $hs";
};
if( $utd < 60*24*60*60 ) # less than 2 months
{
my $d = int( $utd / ( 24 * 60 * 60 ) );
my $ds = str_countable( $d, "day", "days" );
return "$d $ds";
};
if( 42 ) # more than 2 months
{
my $m = int( $utd / ( 30*24*60*60 ) ); # "month" is approximated to 30 days
my $ms = str_countable( $m, "month", "months" );
return "$m $ms";
}
}
sub __relative_str
{
my $utd = shift(); # relative difference in seconds
my $uts = shift(); # relative difference in words
if( $utd < 0 )
{
return "after $uts";
}
elsif( $utd > 0 )
{
return "before $uts";
}
else
{
return $uts;
}
}
sub unix_time_diff_in_words_relative
{
my $utd = int( shift() ); # relative difference in seconds
my $uts = unix_time_diff_in_words( $utd );
return __relative_str( $utd, $uts );
}
sub unix_time_diff_in_words_relative_short
{
my $utd = int( shift() ); # relative difference in seconds
my $uts = unix_time_diff_in_words_short( $utd );
return __relative_str( $utd, $uts );
}
##############################################################################
sub julian_date_diff_in_words
{
my $jdd = abs( int( shift() ) ); # absolute difference in days
if( $jdd < 90 )
{
my $d = int( $jdd );
my $ds = str_countable( $d, "day", "days" );
return "$d $ds";
}
if( 42 )
{
my $m = int( $jdd / 30 );
my $ms = str_countable( $m, "month", "months" );
return "$m $ms";
};
}
sub julian_date_diff_in_words_relative
{
my $jdd = int( shift() ); # relative difference in days
if( $jdd == 0 )
{
return "today";
}
if( $jdd == -1 )
{
return "tomorrow";
}
if( $jdd == +1 )
{
return "yesterday";
}
my $jds = julian_date_diff_in_words( $jdd );
if( $jdd < 0 )
{
return "in $jds";
}
elsif( $jdd > 0 )
{
return "before $jds";
}
else
{
return $jds;
}
}
##############################################################################
# returns time of the day (in the current day only)
sub get_local_time_only
{
my ( $s, $m, $h ) = localtime( shift() || time() );
return $h*60*60 + $m*60 + $s;
}
sub get_local_julian_day
{
return local_julian_day( time() );
}
sub get_local_year
{
my ( $y ) = inverse_julian_day( local_date() );
return $y;
}
sub get_year_month_days
{
return Days_in_Month( @_ );
}
sub julian_date_from_utime
{
return local_julian_day( shift() );
}
# return julian date, moved with positive or negative deltas ( y, m, d )
sub julian_date_add_ymd
{
my $wd = shift; # original/work date
my $dy = shift; # add delta year
my $dm = shift; # add delta month
my $dd = shift; # add delta day
my ( $y, $m, $d ) = inverse_julian_day( $wd );
( $y, $m, $d ) = Add_Delta_YMD( $y, $m, $d, $dy, $dm, $dd );
$wd = julian_day( $y, $m, $d );
return $wd;
}
# return ( year, month, day ) from julian date
sub julian_date_to_ymd
{
my $wd = shift; # original/work date
my ( $y, $m, $d ) = inverse_julian_day( $wd );
return ( $y, $m, $d );
}
# return julian date from ( year, month, day )
sub julian_date_from_ymd
{
my $y = shift; # set year
my $m = shift || 1; # set month
my $d = shift || 1; # set day
my $wd = julian_day( $y, $m, $d );
return $wd;
}
# return julian date from month and day only
# finds closest date which matches, regardless if it is in the future or past
sub julian_date_from_md
{
my $mon = shift;
my $day = shift || 1;
my $now = local_julian_day( time() );
my ( $cy ) = julian_date_to_ymd( $now );
my $cd = julian_date_from_ymd( $cy, $mon, $day );
return $cd if $now == $cd;
my $oy = $cy + ( $cd > $now ? -1 : +1 );
my $od = julian_date_from_ymd( $oy, $mon, $day );
return abs( $cd - $now ) < abs( $od - $now ) ? $cd : $od;
}
# return julian date, moved to the first day of its week (starting Mon=1 as in ISO8601)
sub julian_date_goto_first_dow
{
my $wd = shift; # original/work date
return $wd - ( julian_date_get_dow( $wd ) - 1 );
}
# return julian date, moved to the last day of its week (ending Sun=7 as in ISO8601)
sub julian_date_goto_last_dow
{
my $wd = shift; # original/work date
return $wd + 7 - julian_date_get_dow( $wd );
}
# return julian date, moved to the first day of its month
sub julian_date_goto_first_dom
{
my $wd = shift; # original/work date
my ( $y, $m, $d ) = julian_date_to_ymd( $wd );
return julian_date_from_ymd( $y, $m, 1 );
}
# return julian date, moved to the last day of its month
sub julian_date_goto_last_dom
{
my $wd = shift; # original/work date
my ( $y, $m, $d ) = julian_date_to_ymd( $wd );
return julian_date_from_ymd( $y, $m, Days_in_Month( $y, $m ) );
}
# return julian date, moved to the first day of its year
sub julian_date_goto_first_doy
{
my $wd = shift; # original/work date
my ( $y, $m, $d ) = julian_date_to_ymd( $wd );
return julian_date_from_ymd( $y, 1, 1 );
}
# return julian date, moved to the last day of its year
sub julian_date_goto_last_doy
{
my $wd = shift; # original/work date
my ( $y, $m, $d ) = julian_date_to_ymd( $wd );
return julian_date_from_ymd( $y, 12, 31 );
}
# return day of the month, 1 .. 31
sub julian_date_get_day
{
my $d = shift; # original date
my ( $y, $m, $d ) = julian_date_to_ymd( $d );
return $d;
}
# return month of the year, 1 .. 12
sub julian_date_get_month
{
my $d = shift; # original date
my ( $y, $m, $d ) = julian_date_to_ymd( $d );
return $m;
}
# return year of the given date
sub julian_date_get_year
{
my $d = shift; # original date
my ( $y, $m, $d ) = julian_date_to_ymd( $d );
return $y;
}
# return day of the week, for julian date -- 1 Mon .. 7 Sun
sub julian_date_get_dow
{
my $d = shift; # original date
my $dow = day_of_week( $d ); # this returns Sun=0 ... Sat=6, but...
return 7 if $dow == 0; # return Sun=7 as in ISO8601
return $dow; # return Mon=1 as in ISO8601
}
# return month days count for given ( year, month ) (not strictly julian_ namespace)
sub julian_date_month_days_ym
{
my $y = shift; # set year
my $m = shift; # set month
return Days_in_Month( $y, $m );
}
# return month days count for given julian date
sub julian_date_month_days
{
my $d = shift;
return Days_in_Month( ( julian_date_to_ymd( $d ) )[0,1] );
}
sub julian_date_to_iso
{
return join "-", julian_date_to_ymd( shift() );
}
##############################################################################
sub utime_from_julian_date
{
my ( $year, $month, $day ) = inverse_julian_day( shift() );
return Mktime( $year, $month, $day, 0, 0, 0 );
}
sub utime_from_ymdhms
{
my @args = ( @_, 0, 0, 0, );
return Mktime( @args[ 0 .. 5 ] );
}
# TODO: handle TZ
sub utime_to_ymdhms
{
return Localtime( shift() );
}
# NOTE: returns date/time string without timezone
# convert to basic format
sub utime_to_iso
{
return sprintf("%04d%02d%02dT%02d%02d%02d", utime_to_ymdhms( shift() ) );
}
# convert to extended format
sub utime_to_iso_ext
{
return sprintf("%04d-%02d-%02dT%02d:%02d:%02d", utime_to_ymdhms( shift() ) );
}
# converts basic iso format to utime
sub utime_from_iso
{
}
# converts extended iso format to utime
sub utime_from_iso_ext
{
}
# returns local julian day and time from unix time
sub utime_split_to_jdt
{
my ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Localtime(shift());
my $jd = julian_day( $year, $month, $day );
my $tt = $hour * 60 * 60 + $min * 60 + $sec;
return ( $jd, $tt );
}
# returns unix time of the 00:00 of the day given as utime and time from unix time
sub utime_split_to_utt
{
my ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Localtime(shift());
my $ut = Mktime( $year, $month, $day, 0, 0, 0 );
my $tt = $hour * 60 * 60 + $min * 60 + $sec;
return ( $ut, $tt );
}
# joins julian date and day time only into unix time
sub utime_join_jdt
{
my $jd = shift;
my $tt = shift;
return utime_from_julian_date( $jd ) + $tt;
}
# joins unix time of the day midnight and day time only into unix time
# mostly redundant but exists for completeness
sub utime_join_utt
{
return shift() + shift();
}
sub utime_add_ymdhms
{
my $tt = shift;
my ( $dy, $do, $dd, $dh, $dm, $ds ) = @_;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
( $year, $month, $day, $hour, $min, $sec ) =
Add_Delta_YMDHMS( $year, $month, $day, $hour, $min, $sec,
$dy, $do, $dd, $dh, $dm, $ds );
return Mktime( $year, $month, $day, $hour, $min, $sec );
}
sub utime_add_ymd
{
my $tt = shift;
my ( $dy, $do, $dd ) = @_;
return utime_add_ymdhms( $tt, $dy, $do, $dd, 0, 0, 0 );
}
sub utime_add_hms
{
my $tt = shift;
my ( $dh, $dm, $ds ) = @_;
return utime_add_ymdhms( $tt, 0, 0, 0, $dh, $dm, $ds );
}
sub utime_month_days
{
return get_year_month_days( ( utime_to_ymdhms( shift() ) )[ 0, 1 ] );
}
sub utime_goto_midnight
{
return ( utime_split_to_utt( shift() ) )[0];
}
# return unix time, moved to the midnight of the first day of its week (starting Mon=1 as in ISO8601)
sub utime_goto_first_dow
{
my $tt = shift;
return utime_goto_midnight( $tt - ( utime_get_dow( $tt ) - 1 ) * 24 * 3600 );
}
# return unix time, moved to the midnight of the last day of its week (ending Sun=7 as in ISO8601)
sub utime_goto_last_dow
{
my $tt = shift;
return utime_goto_midnight( $tt + ( 7 - utime_get_dow( $tt ) ) * 24 * 3600 );
}
sub utime_goto_first_dom
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
return Mktime( $year, $month, 1, 0, 0, 0 );
}
sub utime_goto_last_dom
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
return Mktime( $year, $month, Days_in_Month( $year, $month ), 0, 0, 0 );
}
sub utime_goto_first_doy
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
return Mktime( $year, 1, 1, 0, 0, 0 );
}
sub utime_goto_last_doy
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
return Mktime( $year, 12, 31, 0, 0, 0 );
}
sub utime_get_dow
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
return Day_of_Week( $year, $month, $day );
}
sub utime_get_moy
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
return $month;
}
sub utime_get_woy
{
my $tt = shift;
my ( $year, $month, $day, $hour, $min, $sec ) = Localtime( $tt );
my ( $week, $year ) = Week_of_Year( $year, $month, $day );
return wantarray ? ( $week, $year ) : $week;
}
##############################################################################
=pod
=head1 NAME
Data::Tools::Time provides set of basic functions for time processing.
=head1 SYNOPSIS
use Data::Tools::Time qw( :all ); # import all functions
use Data::Tools::Time; # the same as :all :)
use Data::Tools::Time qw( :none ); # do not import anything
# --------------------------------------------------------------------------
my $time_diff_str = unix_time_diff_in_words( $time1 - $time2 );
my $time_diff_str_rel = unix_time_diff_in_words_relative( $time1 - $time2 );
# --------------------------------------------------------------------------
my $date_diff_str = julian_date_diff_in_words( $date1 - $date2 );
my $date_diff_str_rel = julian_date_diff_in_words_relative( $date1 - $date2 );
# --------------------------------------------------------------------------
# return seconds after last midnight, i.e. current day time
my $seconds_in_the_current_day = get_local_time_only()
# returns current julian day
my $jd = get_local_julian_day()
# returns current year
my $year = get_local_year()
# gets current julian date, needs Time::JulianDay
my $jd = local_julian_day( time() );
# or
my $jd = get_local_julian_day();
# move current julian date to year ago, one month ahead and 2 days ahead
$jd = julian_date_add_ymd( $jd, -1, 1, 2 );
# get year, month and day from julian date
my ( $y, $m, $d ) = julian_date_to_ymd( $jd );
# get julian date from year, month and day
$jd = julian_date_from_ymd( $y, $m, $d );
# move julian date ($jd) to the first day of its current month
$jd = julian_date_goto_first_dom( $jd );
# move julian date ($jd) to the last day of its current month
$jd = julian_date_goto_last_dom( $jd );
# get day of week for given julian date ( 0 => Mon .. 6 => Sun )
my $dow = julian_date_get_dow( $jd );
print( ( qw( Mon Tue Wed Thu Fri Sat Sun ) )[ $dow ] . "\n" );
# get month days count for the given julian date's month
my $mdays = julian_date_month_days( $jd );
# get month days count for the given year and month
my $mdays = julian_date_month_days_ym( $y, $m );
=head1 FUNCTIONS
=head2 unix_time_diff_in_words( $unix_time_diff )
Returns human-friendly text for the given time difference (in seconds).
This function returns absolute difference text, for relative
(before/after/ago/in) see unix_time_diff_in_words_relative().
=head2 unix_time_diff_in_words_relative( $unix_time_diff )
Same as unix_time_diff_in_words() but returns relative text
(i.e. with before/after/ago/in)
=head2 julian_date_diff_in_words( $julian_date_diff );
Returns human-friendly text for the given date difference (in days).
This function returns absolute difference text, for relative
(before/after/ago/in) see julian_day_diff_in_words_relative().
=head2 julian_date_diff_in_words_relative( $julian_date_diff );
Same as julian_date_diff_in_words() but returns relative text
(i.e. with before/after/ago/in)
=head1 TODO
* support for language-dependent wording (before/ago)
* support for user-defined thresholds (48 hours, 2 months, etc.)
=head1 REQUIRED MODULES
Data::Tools::Time uses:
* Data::Tools (from the same package)
* Date::Calc
* Time::JulianDay
=head1 TEXT TRANSLATION NOTES
time/date difference wording functions does not have translation functions
and return only english text. This is intentional since the goal is to keep
the translation mess away but still allow simple (yet bit strange)
way to translate the result strings with regexp and language hash:
my $time_diff_str_rel = unix_time_diff_in_words_relative( $time1 - $time2 );
my %TRANS = (
'now' => 'sega',
'today' => 'dnes',
'tomorrow' => 'utre',
'yesterday' => 'vchera',
'in' => 'sled',
'before' => 'predi',
'year' => 'godina',
'years' => 'godini',
'month' => 'mesec',
'months' => 'meseca',
'day' => 'den',
'days' => 'dni',
'hour' => 'chas',
'hours' => 'chasa',
'minute' => 'minuta',
'minutes' => 'minuti',
'second' => 'sekunda',
'seconds' => 'sekundi',
);
$time_diff_str_rel =~ s/([a-z]+)/$TRANS{ lc $1 } || $1/ge;
I know this is no good for longer sentences but works fine in this case.
=head1 GITHUB REPOSITORY
git@github.com:cade-vs/perl-data-tools.git
git clone git://github.com/cade-vs/perl-data-tools.git
=head1 AUTHOR
Vladi Belperchinov-Shabanski "Cade"
<cade@noxrun.com> <cade@bis.bg> <cade@cpan.org>
http://cade.noxrun.com/
=cut
##############################################################################
1;