File Coverage

blib/lib/Rope/Cmd.pm

Criterion	Covered	Total	%
statement	79	83	95.1
branch	10	12	83.3
condition	3	6	50.0
subroutine	18	20	90.0
pod	0	6	0.0
total	110	127	86.6

package Rope::Cmd;

use 5.006;
use strict;
use warnings;
use Term::ANSI::Sprintf qw/sprintf/;
use 5.006; use strict; use warnings; use Rope;
our $VERSION = '0.08';
our (%PRO, %OPTIONS);

BEGIN {
	%PRO = (
		keyword => sub {
			no strict;
			my ($caller, $meth, $cb) = @_;
			*{"${caller}::${meth}"} = sub { $cb->($caller, @_) };
		}
	);
}

sub import {
	my ($pkg, @export) = @_;

	my $caller = caller();

	@export = qw/option title abstract colors/ unless @export;

	$PRO{keyword}($caller, $_, \&{$_}) for @export;

	my $extend = 'Rope::Cmd';
	my $isa = '@' . $caller . '::ISA';
	eval "push $isa, '$extend'";
}

sub option {
	my ($pkg, $name, %options) = @_;
	! exists $options{$_} && do { $options{$_} = 1 } for qw/enumerable configurable/;
	$OPTIONS{$pkg}{options}{$name} = \%options;
}

sub options {
	my ($pkg) = @_;
	return $OPTIONS{$pkg}{options};
}

sub title {
	my ($pkg, $str) = @_;
	$OPTIONS{$pkg}{title} = $str;
}

sub abstract {
	my ($pkg, $str) = @_;
	$OPTIONS{$pkg}{abstract} = $str;
}

sub colors {
	my ($pkg, %colors) = @_;
	$OPTIONS{$pkg}{colors} = \%colors;
}

sub run {
	my ($pkg, @params) = @_;
	my $self = Rope->new({ name => $pkg, use => [qw/Rope::Autoload/], properties => {
		%{ $OPTIONS{$pkg}{options} },
		print_color => {
			writeable => 1,
			value => sub {
				my ($self, $color, $text) = @_;
				print sprintf('%' . $color, $text);
			}
		}
	}});
	my %map;
	my ($options, $max) = ($OPTIONS{$pkg}{options}, 0);
	for my $o (sort keys %{$options}) {
		my $cur = length $o;
		$map{$o} = $o;
		if ($options->{$o}{option_alias}) {
			$map{$options->{$o}{option_alias}} = $o;
			$cur += length($options->{$o}{option_alias}) + 1;
		}
		$max = $cur if ($cur > $max);
	}

	my $colors = $self->_default_colors($OPTIONS{$pkg}{colors});

	if (scalar @params == 1 && $params[0] =~ m/^(h|help)$/) {
		print sprintf('%' . $colors->{title}, $OPTIONS{$pkg}{title} . "\n\n");
		print sprintf('%' . $colors->{abstract}, $OPTIONS{$pkg}{abstract} . "\n\n");
		print sprintf('%' . $colors->{options_title}, "Options" . "\n\n");
		for my $o (sort keys %{$options}) {
			print sprintf(
				"%$colors->{options}  %$colors->{options_description}\n",
				pack("A${max}", ($options->{$o}{option_alias} ? sprintf("%s|", $options->{$o}{option_alias}) : "") . $o),
				$options->{$o}{description}
			);
		}
		return;
	}

	for my $param (@params) {
		my ($key, $value) = split("\=", $param, 2);
		$self->{$map{$key}} = $value;
	}

	$self->callback();

	return $self;
}

sub _default_colors {
	my ($self, $colors) = @_;
	for (qw/title abstract options_title options options_description/) {
		$colors->{$_} = 's' unless $colors->{$_};
	}
	return $colors;
}

1;

__END__;