File Coverage

blib/lib/Term/Menu.pm

Criterion	Covered	Total	%
statement	37	96	38.5
branch	1	28	3.5
condition	0	17	0.0
subroutine	5	10	50.0
pod	0	6	0.0
total	43	157	27.3

package Term::Menu;

use 5.000;
use strict;
use warnings;
use Carp;

our $VERSION = '0.10';

sub new {
	my $invocant = shift;
	my $class = ref($invocant) || $invocant;
	my $self = {
		delim 		=> ") ",
		spaces		=> 7,
		beforetext 	=> "Please choose one of the following options.",
		aftertext	=> "Please enter a letter or number corresponding to the option you want to choose: ",
		nooptiontext	=> "That's not one of the available options.",
		moreoptions	=> " or ",
		tries		=> 0,
		toomanytries	=> "You've tried too many times.",
		hidekeys	=> 0,
		@_,
		lastval 	=> undef,
		tried		=> 0,
		};

	bless $self, $class;
	return $self;
}

sub setcfg {
	my $self = shift;
	croak("Error: setcfg is an instance method!") if(!ref $self);
	%$self = (%$self, @_);
}

sub menu {
	my $self = shift;

	# Create a default self if we didn't get one
	$self = Term::Menu->new() if(!defined($self) or !ref($self));

	# Options by name
	my %options = @_;

	# Options in order
	my $i = 0;
	my @options = grep { ++$i % 2 } @_;

	my $delim = $self->{delim}; # The delimiter between keys and label

	my @lines;	# The lines of the options that need to be printed
	my %keyvals;	# A hash that holds what keys should return what values.
	my $maxoptlen = 0; # Max length of keys that correspond to this value.

	foreach(@options) {
		my $value = $_;
		my @keys  = @{$options{$_}};
		my $label = shift @keys;
		my $options = join ($self->{moreoptions}, @keys);
		$keyvals{$_} = $value foreach(@keys);
		push @lines, [($self->{hidekeys} ? "" : $options.$delim).$label."\n", length($options)];
			#Length of options included to get the
			#number of spaces that need to be included.
		$maxoptlen = length($options) if(length($options) > $maxoptlen and !$self->{hidekeys});
	}
	my $spaces = $self->{spaces};
	$spaces = $maxoptlen if($maxoptlen > $spaces);
	print $self->{beforetext},"\n" if defined $self->{beforetext};
	foreach (@lines) {
		my ($line, $len) = @$_;
		my $nspace = $spaces - $len;
		print " " x $nspace, $line;
	}
	while(1) {
		print $self->{aftertext} if defined $self->{aftertext};
		my $answ = ;
		chomp $answ;
		foreach(keys %keyvals) {
			if($answ eq $_) {
				$self->{lastval} = $keyvals{$_};
				return $keyvals{$_};
			}
		}
		print $self->{nooptiontext},"\n" if defined $self->{nooptiontext};
		$self->{tried} ||= 0;
		$self->{tried}++;
		if($self->{tried} >= $self->{tries} and $self->{tries} != 0) {
			last;
		}
	}
	if($self->{tried} >= $self->{tries} and $self->{tries} != 0) {
		print $self->{toomanytries},"\n" if defined $self->{toomanytries};
		$self->{tried} = 0;
		$self->{lastval} = undef;
		return undef;
	}
}

sub question {
	my ($self, $question) = @_;
	print $question;
	my $answer = ;
	$self->{lastval} = $answer;
	return $answer;
}

sub lastval {
	my $self = shift;
	croak("Error: lastval is an instance method") if(!ref($self));
	return $self->{lastval};
}

sub table {
	my ($pkg, $heads, $contents) = @_;

	# We first get a list of columns and their sizes.
	# We only print as many columns as there are things in $heads.
	my $column_sizes = [];
	for(my $i = 0; $i < @$heads; ++$i) {
		# Max size of this column...
		my $size = length($heads->[$i]);
		foreach my $row (@$contents) {
			$size = length($row->[$i])
				if(length($row->[$i]) > $size);
		}
		$column_sizes->[$i] = $size;
	}

	# Now we start printing.
	# Line 1, 3 and n: delimiters
	my $delimline = "+";
	foreach(@$column_sizes) {
		$delimline .= ("-" x $_) . "+";
	}
	$delimline .= "\n";
	print $delimline;

	# Line 2: column names
	my $nameline = "|";
	for(my $i = 0; $i < @$heads; ++$i) {
		# Name of the head, plus as many spaces as needed.
		$nameline .= $heads->[$i] . (" " x ($column_sizes->[$i] - length($heads->[$i]))) . "|";
	}
	$nameline .= "\n";
	print $nameline;

	print $delimline;

	foreach my $content (@$contents) {
		my $contentline = "|";
		for(my $i = 0; $i < @$heads; ++$i) {
			$contentline .= $content->[$i] . (" " x ($column_sizes->[$i] - length($content->[$i]))) . "|";
		}
		$contentline .= "\n";
		print $contentline;
	}
	print $delimline;
}

1;
__END__