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