view release on metacpan or  search on metacpan

eg/scal  view on Meta::CPAN

if ( my $code = Term::ANSIColor->can( 'colorvalid' ) ) {
    $code->( $opt{color_today} )
	or die "Invalid color '$opt{color_today}'\n";
}

my ( $column_width, $weekday_name, $day_text ) = $opt{j} ?
    ( 3, \&__weekday_abbr, sub {
	    my ( $year, $day_of_year ) = @_;
	    return $day_of_year;
	} ) :
    ( 2, \&__weekday_narrow, sub {
	    my ( $year, $day_of_year ) = @_;
	    my ( $m, $d ) = __day_of_year_to_date( $year, $day_of_year );
	    return $m ? $d : __holiday_narrow( $d );
	} );

my $column_format = "%${column_width}s";
my $month_width = $column_width * 7 + 6;

my ( $current_sy, $today ) = do {
    my ( $y, $yd ) = ( localtime )[ 5, 7 ];
    $yd += 1;	# Conversion to RD uses 1-based day of year
    $y += 1900;
    __rata_die_to_year_day(
	__year_day_to_rata_die( $y, $yd ) + GREGORIAN_RATA_DIE_TO_SHIRE );
};
my ( $current_sm, $sd ) = __day_of_year_to_date( $current_sy, $today );
$current_sm ||= ( 1, 6, 6, 6, 6, 12 )[$sd];

my ( $year, $month ) = reverse @ARGV;

$year ||= $current_sy;
$month ||= $current_sm;
$year == $current_sy
    or $today = 0;

if ( $opt{y} ) {
    my $number = $opt{j} ? 2 : 3;
    my $max = 12 / $number;
    foreach my $inx ( 1 .. $max ) {
	foreach ( period( $year, $inx, $number ) ) {
	    s/ \s* \z /\n/smx;
	    print;
	}
	$inx == $max
	    or print "\n";
    }
} else {
    foreach ( month( $year, $month, \%opt ) ) {
	s/ \s* \z /\n/smx;
	print;
    }
}

sub get_home {
    defined $ENV{HOME}
	and return $ENV{HOME};
    my $home;
    local $@ = undef;
    eval {
	$home = ( getpwuid $< )[7];
	1;
    } and return $home;
    foreach my $env ( qw{ USERPROFILE SYS$LOGIN } ) {
	defined $ENV{$env}
	    and return $ENV{$env};
    }
    return;
}

# Highlight the given $text if -color is asserted and the $day_of_year
# is equal to global variable $today.
sub highlight {
    my ( $text, $day_of_year ) = @_;
    $opt{color}
	and $day_of_year == $today
	or return $text;
    return colored( $text, $opt{color_today} );
}

# Make the calendar for one month. The arguments are Shire Year and
# Shire month number (1-12). The return is an array of lines.
sub month {
    my ( $year, $month ) = @_;
    my @rslt;

    {	# Title
	my $name = join ' ', __month_name( $month ), $year;
	my $space = ' ' x int( ( $month_width - length $name ) / 2 );
	push @rslt, sprintf "%-${month_width}s", "$space$name";
    }

    push @rslt, join ' ', map { $weekday_name->( $_ ) } 1 .. 7;

    my $start = __date_to_day_of_year( $year, $month, 1 );

    my $moh = $month % 6;	# Month of half, sort of.
    1 == $moh
	and --$start;
    my $finish = __date_to_day_of_year( $year, $month, 30 );
    0 == $moh
	and ++$finish;
    my @week;

    push @week, ( ' ' x $column_width ) x (
	__day_of_week( __day_of_year_to_date( $year, $start ) ) - 1 );

    foreach my $day_of_year ( $start .. $finish ) {
	my $d = $day_text->( $year, $day_of_year );
	push @week, highlight( sprintf( $column_format, $d ), $day_of_year );
	@week % 7
	    and next;
	push @rslt, join ' ', @week;
	@week = ();
    }

    if ( @week ) {
	push @week, ( ' ' x $column_width ) x ( 7 - @week );
	push @rslt, join ' ', map { sprintf $column_format, $_ } @week;
    }