new_year.pl

#!/usr/bin/env perl

use strict;
use DateTime;
use utf8;
use open qw/:std :utf8/;

print_month(2011, $_) for 1 .. 12;

exit 0;

sub print_month {
    my ($year, $month) = @_;

    my @monthes = qw/Январь Февраль Март Апрель Май Июнь Июль Август Сентябрь Октябрь Ноябрь Декабрь/;

    my $first_day = new DateTime(year => $year, month => $month, day => 1);
    my $last_day = last_day_of_month DateTime(year => $year, month => $month);
    my $wd = $first_day->day_of_week - 1;

    print $month . ". " . $monthes[$month - 1] . "\n";
    print "$_\t" for qw /Пн Вт Ср Чт Пт Сб Вс/;
    print "\n", "-" x 56, "\n";
    print "\t" x $wd;

    for my $day (1 .. $last_day->day) {
        my $number = $month == 1 ? roman($day) : cnv($day, $month);
        print $number, "\t";

        $wd++;
        if ($wd > 6) {
            $wd = 0;
            print "\n";
        }
    }

    print "\n" if $wd;
    print "\n";
}

sub cnv {
    use integer;
    my ($number, $base) = @_;

    my @alphabet = (0 .. 9, 'A' .. 'F');
    my @result = ();

    while ($number) {
        unshift @result, $alphabet[$number % $base];
        $number /= $base;
    }

    return join "", @result;
}

sub roman {
    my ($number) = @_;

    return {qw/
        1 I 2 II 3 III 4 IV 5 V 6 VI 7 VII 8 VIII 9 IX 10 X
        11 XI 12 XII 13 XIII 14 XIV 15 XV 16 XVI 17 XVII 18 XVIII 19 XIX 20 XX
        21 XXI 22 XXII 23 XXIII 24 XXIV 25 XXV 26 XXVI 27 XXVII 28 XXVIII 29 XXIX 30 XXX
        31 XXXI
    /}->{$number};
}