view release on metacpan or  search on metacpan

lib/App/calx.pm  view on Meta::CPAN

            schema => ['bool', default => 1],
        },
        highlight_today => {
            schema => [bool => default => 1],
        },
        time_zone => {
            schema => 'str*',
        },
        dates => {
            schema => ['array*', of=>'hash*'],
        },
        caldates_modules => {
            schema => ['array*', of=>'perl::calendar::dates::modname*'],
            cmdline_aliases => {c=>{}},
        },
    },
    "x.perinci.sub.wrapper.disable_validate_args" => 1,
    result_naked => 1,
};
sub gen_monthly_calendar {
    my %args = @_;
    my $m = $args{month};
    my $y = $args{year};

    my @lines;
    my $tz = $args{time_zone} // $ENV{TZ} // "UTC";
    my $dt  = DateTime->new(year=>$y, month=>$m, day=>1, time_zone=>$tz);
    my $dtl = DateTime->last_day_of_month(year=>$y, month=>$m, time_zone=>$tz);
    my $dt_today = DateTime->today(time_zone=>$tz);

    my $hol = [];
    if ($args{dates} && @{ $args{dates} }) {
        $hol = $args{dates};
    } else {
        for my $mod0 (@{ $args{caldates_modules} // [] }) {
            my $mod = $mod0; $mod =~ s!/!::!g;
            $mod = "Calendar::Dates::$mod" unless $mod =~ /\ACalendar::Dates::/;
            (my $mod_pm = "$mod.pm") =~ s!::!/!g;
            require $mod_pm;
            my $res; eval { $res = $mod->get_entries($y, $m) }; next if $@;
            for (@$res) { $_->{module} = $mod0 }
            push @$hol, @$res;
        }
    }
    $hol = [sort {$a->{date} cmp $b->{date}} @$hol];

    # XXX use locale
    if ($args{show_year_in_title} // 1) {
        push @lines, _center(21, sprintf("%s %d", $month_names->[$m-1], $y));
    } else {
        push @lines, _center(21, sprintf("%s", $month_names->[$m-1]));
    }

    push @lines, "Mo Tu We Th Fr Sa Su"; # XXX use locale, option to start on Sunday

    my $dow = $dt->day_of_week;
    $dt->subtract(days => $dow-1);
    for my $i (1..$dow-1) {
        push @lines, "" if $i == 1;
        if ($args{show_prev_month_days} // 1) {
            $lines[-1] .= sprintf("%s%2d \e[0m", ansifg("404040"), $dt->day);
        } else {
            $lines[-1] .= "   ";
        }
        $dt->add(days => 1);
    }
    for (1..$dtl->day) {
        if ($dt->day_of_week == 1) {
            push @lines, "";
        }
        my $col = "808080";
        my $reverse;
        if (($args{highlight_today}//1) && DateTime->compare($dt, $dt_today) == 0) {
            $reverse++;
        } else {
            for (@$hol) {
                if ($dt->day == $_->{day}) {
                    #my $is_holiday = $_->{is_holiday} ||
                    #    (grep {$_ eq 'holiday'} @{ $_->{tags} // [] });
                    $col = assign_rgb_light_color($_->{module} // "dates");
                    $reverse++ if $args{dates};
                }
            }
        }
        $lines[-1] .= sprintf("%s%s%2d \e[0m", $reverse ? "\e[7m" : "", ansifg($col), $dt->day);
        $dt->add(days => 1);
    }
    if ($args{show_next_month_days} // 1) {
        $dow = $dt->day_of_week - 1; $dow = 7 if $dow == 0;
        for my $i ($dow+1..7) {
            $lines[-1] .= sprintf("%s%2d \e[0m", ansifg("404040"), $dt->day);
            $dt->add(days => 1);
        }
    }

    return [\@lines, $hol];
}

$SPEC{gen_calendar} = {
    v => 1.1,
    summary => 'Generate one or more monthly calendars in 3-column format',
    args => {
        months => {
            schema => ['int*', min=>1, max=>12, default=>1],
        },
        year => {
            schema => ['int*'],
        },
        month => {
            summary => 'The first month',
            schema => ['int*'],
            description => <<'_',

Not required if months=12 (generate whole year from month 1 to 12).

_
        },
        highlight_today => {
            schema => [bool => default => 1],
        },
        time_zone => {
            schema => 'str*',
        },

        dates => {
            schema => ['array*', of=>'hash*'],
        },
        caldates_modules => {
            schema => ['array*', of=>['perl::calendar::dates::modname*']],
        },

    },
    "x.perinci.sub.wrapper.disable_validate_args" => 1,
    args_rels => {
        choose_one => [qw/dates caldates_modules/],
        req_one => [qw/year dates/],
    },
};
sub gen_calendar {
    my %args = @_;
    my $dates = $args{dates};

    my @lines;
    my $tz = $args{time_zone} // $ENV{TZ} // "UTC";

    my @years;
    my ($start_month, $end_month);
    if ($dates && @$dates) {
        my ($min_date, $max_date);
        for (@$dates) {
            $min_date = $_->{date} if !defined($min_date) || $_->{date} lt $min_date;