Full manual conversion of Epoch time to Date and Time - perl

I wrote this Perl script to convert date and time from files into epoch time.
The original date format is dd-mm-yyyy hh:MM:ss
The reason I do this is because I have to write these values to a database and only integer values are accepted by the columns.
use strict;
use warnings;
use Time::Local;
$datestring = '07-06-2019 21:13:00';
my ($dd, $mm, $yyyy, $hh, $min, $sec) = split /\W+/, $datestring;
my $epoch = timelocal($sec,$min,$hh,$dd,$mm-1,$yyyy-1900);
print("$epoch\n");
Which translates the date 07-06-2019 21:13:00 to 1559934780
The issue:
The values are now presented in a front-end which is unreadable by the user, the front-end does not have scripting utilities and I can only use numerous different calculation formulas which I can use to make it readable.
Is there a completely manual method, by simply using a calculator/calculation to translate epoch time back into user readable date and time?

The core Time::Piece can convert in both directions simply for your local time zone.
use strict;
use warnings;
use Time::Piece;
my $datestring = '07-06-2019 21:13:00';
my $time = localtime->strptime($datestring, '%d-%m-%Y %H:%M:%S');
my $epoch = $time->epoch;
...
my $time = localtime($epoch);
my $datestring = $time->strftime('%d-%m-%Y %H:%M:%S');
See any standard strftime or strptime man page for the format specifiers that are usually accepted - unfortunately the ones Time::Piece accepts are not documented.
Without access to Time::Piece, which is core since Perl 5.10, you can use the built in localtime function, it's just a little more complicated (like timelocal).
use strict;
use warnings;
my $epoch = 1559934780;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime $epoch;
my $date_string = sprintf '%02d-%02d-%04d %02d:%02d:%02d',
$mday, $mon+1, $year+1900, $hour, $min, $sec;

In very early versions of DateTime.pm you will find a sub _rd2greg that I wrote as jd2greg for Rich Bowen's earlier and long defunct Project Reefknot. That takes a number of days since the beginning of the year 1 and produces a year, month, and day. You can take an epoch time divided by 86400 (seconds in a day) floored and add 719163 (the days up to the year 1970) to pass to it.
Here jd2greg and the corresponding greg2jd:
=head2 jd2greg
($year, $month, $day) = jd2greg( $jd );
Convert number of days on or after Jan 1, 1 CE (Gregorian) to
gregorian year,month,day.
=cut
sub jd2greg {
use integer;
my $d = shift;
my $yadj = 0;
my ( $c, $y, $m );
# add 306 days to make relative to Mar 1, 0; also adjust $d to be within
# a range (1..2**28-1) where our calculations will work with 32bit ints
if ( $d > 2**28 - 307 ) {
# avoid overflow if $d close to maxint
$yadj = ( $d - 146097 + 306 ) / 146097 + 1;
$d -= $yadj * 146097 - 306;
} elsif ( ( $d += 306 ) <= 0 )
{
$yadj =
-( -$d / 146097 + 1 ); # avoid ambiguity in C division of negatives
$d -= $yadj * 146097;
}
$c =
( $d * 4 - 1 ) / 146097; # calc # of centuries $d is after 29 Feb of yr 0
$d -= $c * 146097 / 4; # (4 centuries = 146097 days)
$y = ( $d * 4 - 1 ) / 1461; # calc number of years into the century,
$d -= $y * 1461 / 4; # again March-based (4 yrs =~ 146[01] days)
$m =
( $d * 12 + 1093 ) / 367; # get the month (3..14 represent March through
$d -= ( $m * 367 - 1094 ) / 12; # February of following year)
$y += $c * 100 + $yadj * 400; # get the real year, which is off by
++$y, $m -= 12 if $m > 12; # one if month is January or February
return ( $y, $m, $d );
}
=head2 greg2jd
$jd = greg2jd( $year, $month, $day );
Convert gregorian year,month,day to days on or after Jan 1, 1 CE
(Gregorian). Normalization is performed (e.g. month of 28 means
April two years after given year) for month < 1 or > 12 or day < 1
or > last day of month.
=cut
sub greg2jd {
use integer;
my ( $y, $m, $d ) = #_;
my $adj;
# make month in range 3..14 (treat Jan & Feb as months 13..14 of prev year)
if ( $m <= 2 ) {
$y -= ( $adj = ( 14 - $m ) / 12 );
$m += 12 * $adj;
} elsif ( $m > 14 )
{
$y += ( $adj = ( $m - 3 ) / 12 );
$m -= 12 * $adj;
}
# make year positive (oh, for a use integer 'sane_div'!)
if ( $y < 0 ) {
$d -= 146097 * ( $adj = ( 399 - $y ) / 400 );
$y += 400 * $adj;
}
# add: day of month, days of previous 0-11 month period that began w/March,
# days of previous 0-399 year period that began w/March of a 400-multiple
# year), days of any 400-year periods before that, and 306 days to adjust
# from Mar 1, year 0-relative to Jan 1, year 1-relative (whew)
$d += ( $m * 367 - 1094 ) / 12 + $y % 100 * 1461 / 4 +
( $y / 100 * 36524 + $y / 400 ) - 306;
}

Related

Perl : Getting last Friday of the month

I am trying to get the last Friday of the month. I found out the awesome awk script that could to do this job. I try to port it perl but facing some issues. Any insight would be a great help. I can't use any perl modules apart from the inbuilt one, thats why I have to go through building this stuff.
Thanks for your help.
AWK script :
BEGIN {
split("31,28,31,30,31,30,31,31,30,31,30,31",daynum_array,",") # days per month in non leap year
year = ARGV[1]
if (year % 400 == 0 || (year % 4 == 0 && year % 100 != 0)) {
daynum_array[2] = 29
}
y = year - 1
k = 44 + y + int(y/4) + int(6*(y/100)) + int(y/400)
for (m=1; m<=12; m++) {
k += daynum_array[m]
d = daynum_array[m] - (k%7)
printf("%04d-%02d-%02d\n",year,m,d)
}
exit(0)
}
My Perl script :
my #time = localtime;
my ($month, $year) = #time[4, 5];
$year += 1900;
#months = qw( 31 28 31 30 31 30 31 31 30 31 30 31 );
$months[1] = check_leap_year($year) ? 29 : 28;
$y = $year - 1;
$k = 44 + $y + int($y / 4) + int(6 * ($y / 100)) + int($y / 400);
$k += $months[$month];
$d = $months[$month] - ($k % 7);
$month += 1;
printf "%04d-%02d-%02d\n", $year, $month, $d;
sub check_leap_year {
my $year = shift;
return 0 if $year % 4;
return 1 if $year % 100;
return 0 if $year % 400;
return 1;
}
There's a few ways to do this. Using Time::Piece isn't the simplest, it isn't designed for date math, but you don't have to install additional software.
use v5.10;
use strict;
use warnings;
use Time::Piece;
sub get_last_dow_in_month {
my($year, $month, $dow) = #_;
# Get a Time::Piece object at the last day of the month.
my $first_of_the_month = Time::Piece->strptime("$year $month", "%Y %m");
my $last_day = $first_of_the_month->month_last_day;
my $last_of_the_month = Time::Piece->strptime("$year $month $last_day", "%Y %m %d");
# Figure out how many days you need to go back.
my $days_offset = -(($last_of_the_month->day_of_week + (7 - $dow)) % 7);
return $last_of_the_month->mday + $days_offset;
}
say get_last_dow_in_month(2014, 3, 5);
If you need to do more date processing, DateTime is the most comprehensive.
Modules are made to be used. Calc last friday of month on PerlMonks contains some examples.
E.g.
$ perl -MDate::Manip -E 'say UnixDate(ParseDate("last Friday in March 2015"),"Last Friday of the month is %B %E, %Y.")
Last Friday of the month is March 27th, 2015.
Rather than working around the technical limitation, you need to work around the social limitation that is hampering the technical side of your job.
If you are constrained by using core modules only, this is the way to compute it:
use strict;
use warnings;
use Time::Local qw[];
# Computes the last day in the given month which occurs on the given
# day of the week. Returns the day of the month [22, 31].
# 1 <= $month <= 12
# 0 <= $dow <= 6 (0=Sunday)
sub last_dow_in_month {
my ($year, $month, $dow) = #_;
$year += int($month / 12);
$month %= 12;
my $time = Time::Local::timegm(0, 0, 0, 1, $month, $year) - 86400;
my ($mday, $wday) = (gmtime($time))[3,6];
return $mday - ($wday - $dow) % 7;
}
my $year = 2015;
foreach my $month (1..12) {
printf "%.4d-%.2d-%.2d\n",
$year, $month, last_dow_in_month($year, $month, 5);
}
Output:
2015-01-30
2015-02-27
2015-03-27
2015-04-24
2015-05-29
2015-06-26
2015-07-31
2015-08-28
2015-09-25
2015-10-30
2015-11-27
2015-12-25
Using DateTime the code becomes more readable:
use DateTime;
# Computes the last day in the given month which occurs on the given
# day of the week. Returns the day of the month [22, 31].
# 1 <= $month <= 12
# 1 <= $dow <= 7 (1=Monday)
sub last_dow_in_month {
my ($year, $month, $dow) = #_;
my $dt = DateTime->last_day_of_month(year => $year, month => $month);
$dt->subtract(days => ($dt->day_of_week - $dow) % 7);
return $dt->day_of_month;
}
If performance is of essence, Time::Moment can be used to compute it:
use Time::Moment qw[];
# Computes the last day in the given month which occurs on the given
# day of the week. Returns the day of the month [22, 31].
# 1 <= $month <= 12
# 1 <= $dow <= 7 (1=Monday)
sub last_dow_in_month {
my ($year, $month, $dow) = #_;
my $tm = Time::Moment->new(year => $year, month => $month)
->plus_months(1)
->minus_days(1);
return $tm->minus_days(($tm->day_of_week - $dow) % 7)
->day_of_month;
}
A correct implementation of your intended algorithm:
# Computes the last friday in the given month. Returns the day of the
# month [22, 31].
# 1 <= $month <= 12
sub last_friday_in_month {
my ($year, $month) = #_;
my $days = (
[0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365],
[0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366],
)[($year % 4) == 0 && ($year % 100 != 0 || $year % 400 == 0)];
my $y = $year - 1;
my $k = 44 + $y + int($y/4) + int(6 * ($y/100)) + int($y/400);
$k += $days->[$month];
return $days->[$month] - $days->[$month - 1] - ($k % 7);
}
This is just for variety. As #Schwern notes, "cal is a clever hack, but it's a crutch that lets the OP avoid learning to use a good date library. Calendaring is hard, use a library."
Assuming you have cal on your system
#!/usr/bin/env perl
use strict;
use warnings;
local $ENV{LC_ALL} = 'C';
my #cal = `cal`;
my $last_friday;
for (my $i = $#cal; $i >= 0; $i -= 1) {
my #dates = split ' ', $cal[$i];
next unless #dates > 5;
$last_friday = $dates[5];
last;
}
print "$last_friday\n";
Or, more succinctly, but somewhat less efficiently:
#!/usr/bin/env perl
use strict;
use warnings;
local $ENV{LC_ALL} = 'C';
my ($last_friday) = grep defined, map +(split)[5], reverse `cal`;
print "$last_friday\n";
Or, even,
#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw( first );
local $ENV{LC_ALL} = 'C';
my $last_friday = first { defined } map +(split)[5], reverse `cal`;
print "$last_friday\n";

List of days between start and end dates

Im trying to get each individual date between a start and an end date in Perl. I had initially done it for 7 days using the code below :
use Time::ParseDate;
my $newdate;
my $newtime;
my #dates = ();
my $newtime->[0] = parsedate($start_datetime);
my $newdate->[0] = strftime("%Y-%m-%d",localtime($newtime->[0]));
push(#dates, $newdate->[0]);
my $newtime->[1] = parsedate($newdate->[0]) + (1 * 24 * 60 * 60);
my $newdate->[1] = strftime("%Y-%m-%d",localtime($newtime->[1]));
push(#dates, $newdate->[1]);
my $newtime->[2] = parsedate($newdate->[1]) + (1 * 24 * 60 * 60);
my $newdate->[2] = strftime("%Y-%m-%d",localtime($newtime->[2]));
push(#dates, $newdate->[2]);
my $newtime->[3] = parsedate($newdate->[2]) + (1 * 24 * 60 * 60);
my $newdate->[3] = strftime("%Y-%m-%d",localtime($newtime->[3]));
push(#dates, $newdate->[3]);
my $newtime->[4] = parsedate($newdate->[3]) + (1 * 24 * 60 * 60);
my $newdate->[4] = strftime("%Y-%m-%d",localtime($newtime->[4]));
push(#dates, $newdate->[4]);
my $newtime->[5] = parsedate($newdate->[4]) + (1 * 24 * 60 * 60);
my $newdate->[5] = strftime("%Y-%m-%d",localtime($newtime->[5]));
push(#dates, $newdate->[5]);
my $newtime->[6] = parsedate($newdate->[5]) + (1 * 24 * 60 * 60);
my $newdate->[6] = strftime("%Y-%m-%d",localtime($newtime->[6]));
push(#dates, $newdate->[6]);
my $newtime->[7] = parsedate($newdate->[6]) + (1 * 24 * 60 * 60);
my $newdate->[7] = strftime("%Y-%m-%d",localtime($newtime->[7]));
push(#dates, $newdate->[7]);
but realized that it should be able to work for any number of days.
so I tried the loop below but it didnt quite work for me
my $newdate;
my $newtime;
my #dates = ();
my $start_date = substr($start_datetime, 0, 10) ;
$start_date =~ s/-//gi;
my $end_date = substr($end_datetime, 0, 10) ;
$end_date =~ s/-//gi;
my $days = yyyymmdd_to_rata_die($end_date) - yyyymmdd_to_rata_die($start_date);
my $newtime->[0] = parsedate($xml->{action_content}->{start_date});
my $newdate->[0] = strftime("%Y-%m-%d",localtime($newtime->[0]));
push(#dates, $newdate->[0]);
for(my $x=1;$x<$days;$x++)
{
my $newtime->[$x] = parsedate($newdate->[$x-1]) + (1 * 24 * 60 * 60);
my $newdate->[$x] = strftime("%Y-%m-%d",localtime($newtime->[$x]));
push(#dates, $newdate->[$x]);
}
I got the function below from a question here on Stackoverflow
sub yyyymmdd_to_rata_die
{
use integer;
my ( $y, $m, $d ) = $_[0] =~ /\A([0-9]{4})([0-9]{2})([0-9]{2})\z/
or return;
my $adj;
if ( $m <= 2 )
{
$y -= ( $adj = ( 14 - $m ) / 12 );
$m += 12 * $adj;
}
elsif ( $m > 14 )
{
$y += ( $adj = ( $m - 3 ) / 12 );
$m -= 12 * $adj;
}
$d += ( $m * 367 - 1094 ) / 12 + $y % 100 * 1461 / 4 + ( $y / 100 * 36524 + $y / 400 ) - 306;
}
any assistance will be greatly apreciated
EDIT:
$start_datetime = "2014-09-01 00:00:00";
$end_datetime = "2014-09-07 23:59:59";
I need all the days in between the start and end date ie.
2014-09-01
2014-09-02
2014-09-03
2014-09-04
2014-09-05
2014-09-06
2014-09-07
I recommend that you use the Time::Piece module. It shouldn't need installing as it has been a core module since version 10 of Perl 5.
It would look like this
use strict;
use warnings;
use Time::Piece;
print days_between('2014-01-01', '2014-12-01'), "\n";
sub days_between {
my ($start, $end) = map Time::Piece->strptime($_, '%Y-%m-%d'), #_;
($end - $start)->days;
}
output
334
Update
I apologize. I misunderstood your requirements and thought you wanted the number of days between the two dates. This program prints a list of all the dates between and including the two limits. If called in scalar context it will provide the number of days in the list, as before.
use strict;
use warnings;
use Time::Piece;
use Time::Seconds qw/ ONE_DAY /;
printf "%d days:\n", scalar days_from_to('2014-09-01 00:00:00', '2014-09-07 23:59:59');
print "$_\n" for days_from_to('2014-09-01 00:00:00', '2014-09-07 23:59:59');
sub days_from_to {
my #limits = map /(\d\d\d\d-\d\d-\d\d)/, #_;
#limits = map Time::Piece->strptime($_, '%Y-%m-%d'), #limits;
my #dates = ( $limits[0] );
push #dates, $dates[-1] + ONE_DAY while $dates[-1] < $limits[-1];
map $_->ymd, #dates;
}
output
7 days:
2014-09-01
2014-09-02
2014-09-03
2014-09-04
2014-09-05
2014-09-06
2014-09-07
Update
If a more critical regex is required that will reject strings like 0123-45-67 then you can use this
my $date_re = qr/(?:
(?: (?:19|20)[0-9][0-9] ) -
(?:
(?: 0?[469] | 11 ) -
(?: 0?[1-9] | [12][0-9] | 30 )
|
(?: 0?[13578] | 1[02] ) -
(?: 0?[1-9] | [12][0-9] | 3[01] )
|
(?: 0?2 ) -
(?: 0?[1-9] | [12][0-9] )
)
)/x;
which will accept dates between 1900 and 2099, and makes sure that the day of the month is valid for that month. The only proviso is that it will allow 29 February in any year.
Or you may prefer to use Regexp::Common::time like this
use Regexp::Common qw/ time /;
my $date_re = $RE{time}{strftime}{-pat => '%Y-%m-%d'};
but this has the same issue with 29 February.
The subroutine will look like this
sub days_from_to {
my #limits = map /($date_re)/, #_;
#limits = map Time::Piece->strptime($_, '%Y-%m-%d'), #limits;
my #dates = ( $limits[0] );
push #dates, $dates[-1] + ONE_DAY while $dates[-1] < $limits[-1];
map $_->ymd, #dates;
}
You can make your life a lot easier by using something like Time::Piece;
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Time::Piece;
use Time::Seconds;
my $fmt = '%Y-%m-%d';
my $start_date = '2014-09-08';
my $days = 30;
my #dates;
my $date = Time::Piece->strptime($start_date, $fmt);
foreach (1 .. $days) {
push #dates, $date;
$date += ONE_DAY;
}
say $_ for #dates;
Update: Looks like Borodin's answer uses a very similar approach and deals with the inputs and required outputs that you have added to your question.

Subtract months from given date

I have a date in the future, from which I have to subtract 3 months at a time until the current date is reached.
The reached date after subtracting the months must be closest to the current date, but has to be in the future.
The day of the month is always the 23rd
i.e.:
future date = 2015/01/23
current date = 2014/06/05
result = 2014/07/23
I'm running Solaris, so don't have access to GNU date.
I tried to do this in Perl, but unfortunately I can only use the Time::Local module:
#!/bin/ksh
m_date="2019/05/23"
m_year=$(echo $m_date|cut -d/ -f1)
m_month=$(echo $m_date|cut -d/ -f2)
m_day=$(echo $m_date|cut -d/ -f3)
export m_year m_month m_day
perl -MTime::Local -le '
$time = timelocal(localtime);
$i = 3;
while (timelocal(0, 0, 0, $ENV{'m_day'}, $ENV{'m_month'} - $i, $ENV{'m_year'}) > $time) {
print scalar(localtime(timelocal(0, 0, 0, $ENV{'m_day'}, $ENV{'m_month'} - $i, $ENV{'m_year'})));
$i += 3;
}
'
This only works for months within one year. Is there any other way I can do this?
It is simple enough to just split the date strings and do the arithmetic on the fields.
use strict;
use warnings;
use 5.010;
my $future = '2015/01/23';
my $current = do {
my #current = localtime;
$current[3] += 1;
$current[5] += 1900;
sprintf '%04d/%02d/%02d', #current[5,4,3];
};
my $result;
for (my $test = $future; $test gt $current; ) {
$result = $test;
my #test = split /\//, $test;
if (($test[1] -= 3) < 1) {
--$test[0];
$test[1] += 12;
}
$test = sprintf '%04d/%02d/%02d', #test;
}
say $result;
output
2014/07/23
Alternatively you could just do the division to calculate how many whole quarters to subtract, like this
use strict;
use warnings;
use 5.010;
my $future = '2015/01/23';
my #current = (localtime)[5,4,3];
$current[1] += 1;
$current[0] += 1900;
my #future = split /\//, $future;
my $months = ($future[0] - $current[0]) * 12 + $future[1] - $current[1];
$months -= 1 if $current[2] >= 23;
my #result = #current;
$result[2] = 23;
$result[1] += $months % 3;
$result[0] += int(($result[1] - 1) / 12);
$result[1] = ($result[1] - 1) % 12 + 1;
my $result = sprintf '%04d/%02d/%02d', #result;
say $result;
The output is identical to that of the previous code
This is your script changed so it should work across multiple years,
perl -MTime::Local -le'
sub nextm {
$ENV{m_year}--, $ENV{m_month} +=12 if ($ENV{m_month} -= 3) <1;
timelocal(0, 0, 0, $ENV{m_day}, $ENV{m_month}, $ENV{m_year});
}
my $time = timelocal(localtime);
while ((my $c=nextm()) > $time) {
print scalar localtime($c);
}
'
Try something like:
#!/usr/bin/perl -w
# just convert the real date that you have to epoch
my $torig = 1558569600;
my $tnow = time;
# 3 months in seconds to use the epoch everywhere
my $estep = 3 * 30 * 24 * 3600;
while(($torig - $estep) > $tnow){
$torig -= $estep;
}
print $torig,"\n";
print scalar localtime($torig),"\n";
The only problem here is that a months is an approximation, if you need the very same day but minus 3 months, you could use DateCalc
I ended up scripting it all in KSH instead of perl, thanks to Borodin's logic.
#!/bin/ksh
set -A c_date $(date '+%Y %m %d')
IFS=/ d="2019/05/23"
set -A m_date $d
[[ ${c_date[2]} -gt ${m_date[2]} ]] && ((c_date[1]+=1))
c_date[2]=${m_date[2]}
c_date[1]=$(( (((${m_date[0]} - ${c_date[0]}) * 12) + (${m_date[1]} - ${c_date[1]})) % 3 + ${c_date[1]} ))
if [[ ${c_date[1]} -gt 12 ]] ; then
((c_date[0]+=1))
((c_date[1]-=12))
fi
echo ${c_date[#]}

How do I find out what the date some weeks ago was?

I was trying to determine a good way to calculate a previous date based on how many weeks I would want to go back. Today is 7/19/2011, so if I wanted to go back 5 weeks what would be the best way to determine what that date would be?
DateTime::Duration is your friend there:
use strict;
use warnings;
use 5.010;
use DateTime;
my $now = DateTime->now(time_zone => 'local');
my $five_weeks = DateTime::Duration->new(weeks => 5);
my $five_weeks_ago = $now - $five_weeks;
say "Five weeks ago now it was $five_weeks_ago";
Notice that it lets you specify the duration in the units of the problem.
Perl has this marvelous thing called regexes that can solve almost any problem.
use strict;
use warnings;
my $date = shift || '7/19/2011';
my $days_ago = shift || 7*5;
$date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)\z##{[sprintf"%.2d",$1]}/#{[sprintf"%.2d",$2]}/$3/$days_ago#;
until ( $date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)/0\z##{[$1+0]}/#{[$2+0]}/$3# ) {
$date =~ s#([0-9]+)/([0-9]+)/([0-9]+)/([0-9]+)##{[$2==1?sprintf"%.2d",$1-1||12:$1]}/#{[sprintf"%.2d",$2-1||31]}/#{[$1==1 && $2==1?$3-1:$3]}/#{[$4-1]}#;
$date =~ s#([0-9]+)\z##{[$1+1]}# unless $date =~ m#^(?:0[1-9]|1[012])/(?:0[1-9]|1[0-9]|2[0-8]|(?<!0[2469]/|11/)31|(?<!02/)30|(?<!02/(?=...(?:..(?:[02468][1235679]|[13579][01345789])|(?:[02468][1235679]|[13579][01345789])00)))29)/#;
}
print $date, "\n";
(Please don't do it this way.)
I like Date::Calc
use strict;
use warnings;
use Date::Calc qw/Add_Delta_Days Today/;
my $offset_weeks = -5;
my $offset_days = $offset_weeks * 7;
# Year, Month, Day
my #delta_date = Add_Delta_Days(
Today( [ localtime ] ),
$offset_days
);
printf "%2d/%2d/%4d\n", #delta_date[1,2,0];
It is designed to catch common gotchas such as leap year.
Best or easiest? I have always found strftime's date normalization to be handy for this sort of thing:
#!/usr/bin/perl
use strict;
use warnings;
use POSIX qw/strftime/;
my #date = localtime;
print strftime "today is %Y-%m-%d\n", #date;
$date[3] -= 5 * 7;
print strftime "five weeks ago was %Y-%m-%d\n", #date;
Which solution is best depends partly on what you want to do with the date when you are done. Here is a benchmark with implementations of various methods:
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark;
use Date::Manip qw/UnixDate/;
use Date::Simple qw/today/;
use Date::Calc qw/Add_Delta_Days Today/;
use DateTime;
use POSIX qw/strftime/;
use Class::Date;
my %subs = (
cd => sub {
(Class::Date::now - [0, 0, 5 * 7])->strftime("%Y-%m-%d");
},
dc => sub {
sprintf "%d-%02s-%02d", Add_Delta_Days Today, -5 * 7;
},
dm => sub {
UnixDate("5 weeks ago", "%Y-%m-%d");
},
ds => sub {
(today() - 5 * 7)->strftime("%Y-%m-%d");
},
dt => sub {
my $now = DateTime->from_epoch(epoch => time, time_zone => "local");
my $five_weeks = DateTime::Duration->new(weeks => 5);
($now - $five_weeks)->ymd('-');
},
p => sub {
my #date = localtime;
$date[3] -= 5 * 7;
strftime "%Y-%m-%d", #date;
},
y => sub {
my ($d, $m, $y) = (localtime)[3..5];
my $date = join "/", $m+1, $d, $y+1900;
my $days_ago = 7*5;
$date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)\z##{[sprintf"%.2d",$1]}/#{[sprintf"%.2d",$2]}/$3/$days_ago#;
until ( $date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)/0\z##{[$1+0]}/#{[$2+0]}/$3# ) {
$date =~ s#([0-9]+)/([0-9]+)/([0-9]+)/([0-9]+)##{[$2==1?sprintf"%.2d",$1-1||12:$1]}/#{[sprintf"%.2d",$2-1||31]}/#{[$1==1 && $2==1?$3-1:$3]}/#{[$4-1]}#;
$date =~ s#([0-9]+)\z##{[$1+1]}# unless $date =~ m#^(?:0[1-9]|1[012])/(?:0[1-9]|1[0-9]|2[0-8]|(?<!0[2469]/|11/)31|(?<!02/)30|(?<!02/(?=...(?:..(?:[02468][1235679]|[13579][01345789])|(?:[02468][1235679]|[13579][01345789])00)))29)/#;
}
return $date;
},
);
print "$_: ", $subs{$_}(), "\n" for keys %subs;
Benchmark::cmpthese -1, \%subs;
And here are the results. The strftime method seems to be the fastest, but it is also has the least features.
y: 6/14/2011
dm: 2011-06-14
p: 2011-06-14
dc: 2011-06-14
cd: 2011-06-14
dt: 2011-06-15
ds: 2011-06-14
Rate dt dm y ds cd dc p
dt 1345/s -- -5% -28% -77% -82% -96% -98%
dm 1408/s 5% -- -24% -75% -81% -96% -98%
y 1862/s 38% 32% -- -68% -75% -95% -97%
ds 5743/s 327% 308% 208% -- -24% -84% -90%
cd 7529/s 460% 435% 304% 31% -- -78% -87%
dc 34909/s 2495% 2378% 1775% 508% 364% -- -39%
p 56775/s 4121% 3931% 2949% 889% 654% 63% --
Better than a benchmark is a test of how they handle DST (this test would have caught the error in the assumption about what DateTime->now returns).
#!/usr/bin/perl
use strict;
use warnings;
use Time::Mock;
use Date::Manip qw/UnixDate/;
use Date::Simple qw/today/;
use Date::Calc qw/Add_Delta_Days Today/;
use DateTime;
use POSIX qw/strftime mktime/;
use Class::Date;
sub target {
my #date = localtime;
$date[3] -= 5 * 7;
strftime "%Y-%m-%d", #date;
}
my %subs = (
cd => sub {
(Class::Date::now - [0, 0, 5 * 7])->strftime("%Y-%m-%d");
},
dc => sub { sprintf "%d-%02s-%02d", Add_Delta_Days Today, -5 * 7;
},
dm => sub {
UnixDate("5 weeks ago", "%Y-%m-%d");
},
ds => sub {
(today() - 5 * 7)->strftime("%Y-%m-%d");
},
dt => sub {
my $now = DateTime->from_epoch( epoch => time, time_zone => 'local' );
my $five_weeks = DateTime::Duration->new(weeks => 5);
($now - $five_weeks)->ymd('-');
},
y => sub {
my ($d, $m, $y) = (localtime)[3..5];
my $date = join "/", $m+1, $d, $y+1900;
my $days_ago = 7*5;
$date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)\z##{[sprintf"%.2d",$1]}/#{[sprintf"%.2d",$2]}/$3/$days_ago#;
until ( $date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)/0\z##{[$1+0]}/#{[$2+0]}/$3# ) {
$date =~ s#([0-9]+)/([0-9]+)/([0-9]+)/([0-9]+)##{[$2==1?sprintf"%.2d",$1-1||12:$1]}/#{[sprintf"%.2d",$2-1||31]}/#{[$1==1 && $2==1?$3-1:$3]}/#{[$4-1]}#;
$date =~ s#([0-9]+)\z##{[$1+1]}# unless $date =~ m#^(?:0[1-9]|1[012])/(?:0[1-9]|1[0-9]|2[0-8]|(?<!0[2469]/|11/)31|(?<!02/)30|(?<!02/(?=...(?:..(?:[02468][1235679]|[13579][01345789])|(?:[02468][1235679]|[13579][01345789])00)))29)/#;
}
return join "-", map { sprintf "%02d", $_ }
(split "/", $date)[2,0,1];
},
);
my $time = mktime 0, 0, 0, 13, 2, 111; #2011-03-13 00:00:00, DST in US
for my $offset (map { $_ * 60 * 60 } 1 .. 24) {
print strftime "%Y-%m-%d %H:%M:%S\n", (localtime $time + $offset);
Time::Mock->set($time + $offset);
my $target = target;
for my $sub (sort keys %subs) {
my $result = $subs{$sub}();
if ($result ne $target) {
print "$sub disagrees: ",
"time $time target $target result $result\n";
}
}
}
Using Time::Piece:
use Time::Piece;
use Time::Seconds qw(ONE_DAY);
my $weeks_back = 5;
my $date_str = '7/19/2011';
my $dt = Time::Piece->strptime($date_str, '%m/%d/%Y');
# Avoid DST issues
$dt -= ONE_DAY() * ( 7 * $weeks_back - 0.5 )
my $past_str = $dt->strftime('%m/%d/%Y');
print "$past_str\n";
Too much code for such a simple question! All you need is two simple lines:
my $five_weeks_ago = time - (5*7)*24*60*60;
print scalar localtime($five_weeks_ago), "\n";
My solution is accurate for both DST and leap years.
Here is the way to get the date of 5 weeks back:
$ uname
HP-UX
$ date
Wed Nov 11 09:42:05 CST 2015
$ perl -e 'my ($d,$m,$y) = (localtime(time-60*60*24*(5*7)))[3,4,5]; printf("%d/%d/%d\n", $m+1, $d, $y+1900);'
10/7/2015
say POSIX::strftime(
'%m/%d/%Y' # format string -> mm/dd/YYYY
, 0 # no seconds
, 0 # no minutes
, 0 # no hours
, 19 - ( 5 * 7 ) # current day - numweeks * 7
, 7 - 1 # month - 1
, 2011 - 1900 # YYYY year - 1900
);
Yes, the day comes out to be 19 - 35 = -16, and yes it works.
If date is available as unix timestamp, it can be done with simple arithmetic:
use POSIX qw/strftime/;
say strftime('%Y-%m-%d', localtime(time - 5 * 7 * 86400));

How can I get this week's dates in Perl?

I have the following loop to calculate the dates of the current week and print them out. It works, but I am swimming in the amount of date/time possibilities in Perl and want to get your opinion on whether there is a better way. Here's the code I've written:
#!/usr/bin/env perl
use warnings;
use strict;
use DateTime;
# Calculate numeric value of today and the
# target day (Monday = 1, Sunday = 7); the
# target, in this case, is Monday, since that's
# when I want the week to start
my $today_dt = DateTime->now;
my $today = $today_dt->day_of_week;
my $target = 1;
# Create DateTime copies to act as the "bookends"
# for the date range
my ($start, $end) = ($today_dt->clone(), $today_dt->clone());
if ($today == $target)
{
# If today is the target, "start" is already set;
# we simply need to set the end date
$end->add( days => 6 );
}
else
{
# Otherwise, we calculate the Monday preceeding today
# and the Sunday following today
my $delta = ($target - $today + 7) % 7;
$start->add( days => $delta - 7 );
$end->add( days => $delta - 1 );
}
# I clone the DateTime object again because, for some reason,
# I'm wary of using $start directly...
my $cur_date = $start->clone();
while ($cur_date <= $end)
{
my $date_ymd = $cur_date->ymd;
print "$date_ymd\n";
$cur_date->add( days => 1 );
}
As mentioned, this works, but is it the quickest or most efficient? I'm guessing that quickness and efficiency may not necessarily go together, but your feedback is very appreciated.
A slightly improved version of friedo's answer ...
my $start_of_week =
DateTime->today()
->truncate( to => 'week' );
for ( 0..6 ) {
print $start_of_week->clone()->add( days => $_ );
}
However, this assumes that Monday is the first day of the week. For Sunday, start with ...
my $start_of_week =
DateTime->today()
->truncate( to => 'week' )
->subtract( days => 1 );
Either way, it's better to use the truncate method than re-implement it, as friedo did ;)
You can use the DateTime object to get the current day of the week as a number ( 1-7 ). Then just use that to find the current week's Monday. For example:
my $today = DateTime->now;
my $start = $today->clone;
# move $start to Monday
$start->subtract( days => ( $today->wday - 1 ) ); # Monday gives 1, so on monday we
# subtract zero.
my $end = $start->clone->add( days => 7 );
The above is untested but the idea should work.
Would this work:
use strict;
use warnings;
use POSIX qw<strftime>;
my ( $day, $pmon, $pyear, $wday ) = ( localtime )[3..6];
$day -= $wday - 1; # Get monday
for my $d ( map { $day + $_ } 0..6 ) {
print strftime( '%A, %B %d, %Y', ( 0 ) x 3, $d, $pmon, $pyear ), "\n";
}
I'm printing them only as an illustration. You could store them as timestamps, like this:
use POSIX qw<mktime>;
my #week = map { mktime(( 0 ) x 3, $day + $_, $pmon, $pyear ) } 0..6;
This should work:
use POSIX; # for strftime
my $time = time ();
my $seconds = 24*60*60;
my #time = gmtime ();
$time = $time - $time[6] * $seconds;
for my $wday (0..6) {
$time += $seconds;
my #wday = gmtime ($time);
print strftime ("%A %d %B %Y\n", #wday);
}
Gives me:
$ ./week.pl
Monday 24 May 2010
Tuesday 25 May 2010
Wednesday 26 May 2010
Thursday 27 May 2010
Friday 28 May 2010
Saturday 29 May 2010
Sunday 30 May 2010
If you want to get weeks starting on Sunday, change $time[6] to ($time[6] + 1).
This assumes you want the GMT weeks. Change gmtime to localtime to get local time zone weeks.