Perl : Getting last Friday of the month - perl

Question

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;
}

Answer 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.

Answer 2

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.

Answer 3

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);
}

Answer 4

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";