view release on metacpan or  search on metacpan

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

    has '+help' => sub {
	pod2usage
	    -verbose  => 99,
	    -sections => [ qw(SYNOPSIS VERSION) ];
    };

    has '+version' => sub {
	print "Version: $VERSION\n";
	exit;
    };

    has "<>" => sub {
	my $obj = $_;
	local $_ = $_[0];
	if (/^-+([0-9]+)$/) {
	    $obj->months = $1;
	} elsif (/^-/) {
	    die "$_: Option error\n";
	} else {
	    push @{$obj->ARGV}, $_;
	}
    };

} no Getopt::EX::Hashed;

sub color {
    (+shift)->CM->color(@_);
}

sub usage {
    pod2usage(-verbose => 0, -exitval => "NOEXIT");
    print "Version: $VERSION\n";
    exit 2;
}

sub run {
    my $app = shift;
    local @ARGV = decode_argv @_;

    $app->read_option()
	->argv()
	->deal_option()
	->prepare()
	->show();

    return 0;
}

sub read_option {
    my $app = shift;
    use Getopt::EX::Long qw(:DEFAULT Configure ExConfigure);
    ExConfigure BASECLASS => [ "App::week", "Getopt::EX", "" ];
    Configure qw(bundling no_getopt_compat no_ignore_case pass_through);
    $app->getopt || usage;
    return $app;
}

sub argv {
    my $app = shift;
    for (@{$app->ARGV}) {
	call \&guess_date,
	    for  => $app,
	    with => [ qw(year mon mday show_year) ];
    }
    return $app;
}

sub deal_option {
    my $app = shift;

    # load --colormap option
    my %colormap = %DEFAULT_COLORMAP;
    $app->COLORMAP(\%colormap);
    $app->CM(Getopt::EX::Colormap->new(HASH => \%colormap)
	     ->load_params(@{$app->colormap}));

    # --colordump
    if ($app->colordump) {
	print $app->CM->colormap(
	    name   => '--changeme',
	    option => '--colormap');
	exit;
    }

    # -p, -P
    $app->year_on //= $app->mon if $app->mday;
    if ($app->year_on_all) {
	App::week::CalYear::Configure show_year => [ 1..12 ];
    }
    elsif (defined(my $m = $app->year_on)) {
	if ($m < 0 or 12 < $m) {
	    die "$m: Month must be within 0 to 12\n";
	}
	App::week::CalYear::Configure
	    show_year => { $app->year => $m, '*' => 1 };
    } else {
	App::week::CalYear::Configure show_year => 1;
    }

    # -y, -Y
    $app->years //= 1 if $app->show_year;

    return $app;
}

sub prepare {
    my $app = shift;
    call \&_prepare,
	for  => $app,
	with => [ qw(years months before after year mon column) ];
    return $app;
}

sub _prepare {
    my @args = \(
	my($years, $months, $before, $after, $year, $mon, $column) = @_
    );

    use integer;
    if ($months == 1) {
	$before = $after = 0;