view release on metacpan or  search on metacpan

eg/scal  view on Meta::CPAN

#!/usr/bin/env perl

use 5.006002;

use strict;
use warnings;

use Date::Tolkien::Shire::Data qw{ :all };
use Getopt::Long 2.25;
use Pod::Usage;
use Term::ANSIColor qw{ colored };

our $VERSION = '0.011';

my %opt = (
    color	=> -t STDOUT,
    color_today	=> 'underline',
);

if ( defined( my $home = get_home() ) ) {
    my $path = "$home/.scalrc";
    local $! = undef;
    if ( open my $fh, '<', $path ) {
	my @config;
	local $_ = undef;	# while (<>) ... does not localize $_.
	while ( <$fh> ) {
	    s/ \s+ \z //smx;
	    m/ \A \s* (?: \z | [#] ) /smx
		and next;
	    s/ \A \s+ //smx;
	    push @config, $_;
	}
	close $fh;
	splice @ARGV, 0, 0, @config;
    }
}

GetOptions( \%opt,
    qw{ accented! color! color_today|color-today=s events! j! y! },
    help => sub { pod2usage( { -verbose => 2 } ) },
) and @ARGV <= ( $opt{y} ? 1 : 2 ) or pod2usage( { -verbose => 0 } );

my $on_date;
if ( $opt{events} ) {
    if ( $opt{accented} ) {
	$] lt '5.008'
	    and die "-accented requires at least Perl 5.8\n";
	$on_date = __PACKAGE__->can( '__on_date_accented' );
	eval q<binmode STDOUT, ':encoding(utf-8)'>;
    } else {
	$on_date = __PACKAGE__->can( '__on_date' );
    }
} else {
    $on_date = sub { return };
}

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;