1#!/usr/bin/perl
2use strict;
3use warnings;
4use v5.10;
5
6use Getopt::Long qw[];
7use Time::Moment qw[];
8
9my $FirstDayOfWeek = 1; # Monday
10my $Moment         = Time::Moment->now
11                                 ->with_day_of_month(1)
12                                 ->at_midnight;
13
14Getopt::Long::GetOptions(
15    'y|year=i' => sub {
16        my ($name, $year) = @_;
17
18        ($year >= 1 && $year <= 9999)
19          or die qq/Option '$name' is out of the range [1, 9999]\n/;
20
21        $Moment = $Moment->with_year($year);
22    },
23    'm|month=i' => sub {
24        my ($name, $month) = @_;
25
26        ($month >= 1 && $month <= 12)
27          or die qq/Option '$name' is out of the range [1=January, 12=December]\n/;
28
29        $Moment = $Moment->with_month($month);
30    },
31    'f|first=i' => sub {
32        my ($name, $day) = @_;
33
34        ($day >= 1 && $day <= 7)
35          or die qq/Option '$name' is out of the range [1=Monday, 7=Sunday]\n/;
36
37        $FirstDayOfWeek = $day;
38    },
39) or do {
40    say "usage: $0 [-y year] [-m month] [-f day]";
41    say "    -y --year    the year [1, 9999]";
42    say "    -m --month   the month of the year [1=January, 12=December]";
43    say "    -f --first   the first day of the week [1=Monday, 7=Sunday]";
44    exit(1);
45};
46
47sub align {
48    @_ == 2 or die q/Usage: align(string, width)/;
49    my ($string, $width) = @_;
50    return sprintf "%*s", ($width + length $string) / 2, $string;
51}
52
53say align($Moment->strftime('%B %Y'), 20);
54say join ' ', map {
55    (qw[ Mo Tu We Th Fr Sa Su ])[ ($_ + $FirstDayOfWeek - 1) % 7 ]
56} (0..6);
57
58my $this_month = $Moment;
59my $next_month = $Moment->plus_months(1);
60my $date       = $Moment->minus_weeks($FirstDayOfWeek > $Moment->day_of_week)
61                        ->with_day_of_week($FirstDayOfWeek);
62
63while ($date->is_before($next_month)) {
64    my @week;
65    foreach my $day (1..7) {
66        if ($date->is_before($this_month)) {
67            push @week, '  ';
68        }
69        elsif ($date->is_before($next_month)) {
70            push @week, sprintf '%2d', $date->day_of_month;
71        }
72        $date = $date->plus_days(1);
73    }
74    say join ' ', @week;
75}
76