view release on metacpan or  search on metacpan

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

    print $rule x $obj->frame_height;
}

sub h_line {
    my $obj = shift;
    my $frame = $obj->color(FRAME => $obj->frame);
    print join($frame, '', @_, '') . "\n";
}

sub cell {
    my $obj = shift;
    my($y, $m, $d) = @_;

    while ($m > 12) { $y += 1; $m -= 12 }
    while ($m <= 0) { $y -= 1; $m += 12 }

    my @cal = @{$calyear[$y][$m]};

    # XXX this is not the best place to initialize...
    $obj->cell_width //= length $cal[2];

    my %label;
    @label{qw(month week days)} = $d
	? qw(THISMONTH THISWEEK THISDAYS)
	: qw(    MONTH     WEEK     DAYS);

    $cal[0] = $obj->color($label{month}, $cal[0]);
    $cal[1] = $obj->color($label{week},
			  state $week = $obj->week_line($cal[1]));
    my $day_re = $d ? qr/^(?: [ \d]{2}){0,6} \K(${\(sprintf '%2d', $d)})\b/ : undef;
    for (@cal[ 2 .. $#cal ]) {
	s/$day_re/$obj->color("THISDAY", $1)/e if $day_re;
	$_ = $obj->color($label{days}, $_);
    }

    return \@cal;
}

sub week_line {
    my $obj = shift;
    my $week = shift;
    my @week = split_week $week;
    for (0..7) {
	if (my $color = $obj->COLORMAP->{$DOW_LABELS[$_]}) {
	    my $i = $_ * 2 + 1;
	    $i > $#week and last;
	    $week[$i] = $obj->color($color, $week[$i]);
	}
    }
    join '', @week;
}

1;

__END__

=encoding utf-8

=head1 NAME

week - colorful calendar command for ANSI terminal

=head1 SYNOPSIS

B<week> [ -MI<module> ] [ option ] [ date ]

=head1 VERSION

Version 1.0303

=head1 DESCRIPTION

Yet another calendar command.  Read the script's manual for detail.

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 2018- Kazumasa Utashiro.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut