view release on metacpan or  search on metacpan

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

    has years       => ' Y :1     ' , max => 100;
    has rgb24       => '   !      ' ;
    has year_on_all => ' P        ' ;
    has year_on     => ' p =i     ' , min => 0, max => 12;
    has config      => '   =s%    ' , default => {};
    has weeknumber  => ' W :1     ' ;

    has '+center' => sub {
	$_->after = $_->before = $_[1];
    };

    has '+weeknumber' => sub {
	App::week::CalYear::Configure $_[0] => $_[1];
    };

    has '+rgb24' => sub {
	$Getopt::EX::Colormap::RGB24 = !!$_[1];
    };

    has '+config' => sub {
	App::week::CalYear::Configure $_[1] => $_[2];
    };

    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->initialize()
	->read_option()
	->argv()
	->deal_option()
	->prepare()
	->show();

    return 0;
}

sub initialize {
    my $app = shift;
    my $t = localtime;
    $app->year = $t->year + 1900;
    $app->mon  = $t->mon + 1;
    $app->mday = $t->mday;
    return $app;
}

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) {