package Input;
# $Id: Input.pm,v 1.6 2000/11/05 07:28:08 tom Exp $
################################################################

=head1 NAME

Input - 入力オブジェクトクラス

=head1 SYNOPSIS

=head1 DESCRIPTION

文字、ブール値、整数の入力を行う。
メールアドレス、パスなどの入力もできる。

=cut

use strict;
use vars qw(@EXPORT @ISA);
use Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(InputString InputPassword InputSelect
	     InputMailAddress InputYN InputPath InputInteger
	     InputSelect);

################################################################

=head2 InputString($prompt, $default);

文字列入力

=cut

sub InputString
{
    my ($prompt, $value) = @_;

    print "$prompt [$value]\n>";

    my $input = <>;
    $input =~ s/[\r\n]//g;

    return undef if $input eq 'undef';  # 'undef' と入力されたら undef
    return $value if $input =~ /^$/;    # 空リターンなら $value を返す
    return $input;
}

sub InputPassword($$)
{
    my ($prompt, $value) = @_;

    eval "require 'Term::ReadKey'";
    if ($@){
#	eval "system('stty -echo')";
	InputString($prompt, $value);
#	eval "system('stty echo')";
    } else {
	ReadMode('noecho');
	ReadLine(0);
    }
}

=head2 InputYN($prompt, $default);

ブール値を入力する

=cut

sub InputYN
{
    my ($prompt, $value) = @_;

    my $info = ($value) ? 'Yn' : 'yN';

    while (1){
	print "$prompt [$info]: ";
	my $input = <>;
	$input =~ s/[\r\n]//g;
	return $value unless $input;
	if ($input =~ /^y/i){
	    return 1;
	} elsif ($input =~ /^n/i){
	    return 0;
	} else {
	    print "input 'y' or 'n'. ($input)\n";
	}
    }
}

=head2 InputInteger($prompt, $default,   $min, $max);

整数値入力

=cut

sub InputInteger
{
    my ($prompt, $value, $min, $max) = @_;

    while (1){
	my $rtn = &InputString($prompt, $value);
	if ($rtn =~ /^\-?\d+$/){
	    if (defined $min && $min > $rtn){
		print "MUST BE GREATER THAN $min: $rtn.\n";
	    } elsif (defined $max && $max < $rtn){
		print "MUST BE LESS THAN $max: $rtn.\n";
	    } else {
		return $rtn;
	    }
	} else {
	    print "MUST BE INTEGER.\n";
	}
    }
}

=head2 InputSelect($prompt, $value, $options);

選択肢選択。

$value には初期値、
$options には選択肢配列へのリファレンスを渡す。

=cut

sub InputSelect
{
    my ($prompt, $value, $options) = @_;

    my $default_num = 1;
    for (@{$options}){
	if ($value eq $_){
	    last;
	}
	$default_num++;
    }
    print "$prompt [$default_num]\n";
    my $num = 1;
    for (@{$options}){
	print "$num: $_\n";
	$num++;
    }
    my $selected = InputInteger("", $default_num, 1, scalar(@{$options}));
    return $options->[$selected-1];
}
	

=head2 InputMailAddress($prompt, $default);

メールアドレスを入力する

=cut

sub InputMailAddress
{
    my ($prompt, $value) = @_;
    while (1){
	$value = &InputString($prompt, $value);
	if ($value =~ /^.*?\@.*$/){
	    last;
	} else {
	    print "invalid mail address: $value\n";
	}
    }
    return $value;
}

=head2 InputPath($prompt, $default, $be_absolute);

パスを入力する。
$be_absolute に真を渡すと絶対パスを要求する。
先頭の ~/ は $HOME に変換される。

=cut

sub InputPath
{
    my ($prompt, $value, $absolute) = @_;

    my $home = $ENV{'HOME'};
    $home =~ s!\\!/!g;
    
    while (1){
	my $rtn = &InputString($prompt, $value);

	# 行末 / の消去
	$value =~ s!/$!!;
	
	# '~' の変換
	if ($rtn =~ s/^~/$home/){
	    print "(*) convert to $rtn\n";
	}
	if ($rtn =~ s!\\!/!g){
	    print "(*) convert to $rtn\n";
	}
	# 絶対パスの検査
	if ($absolute){
	    if ($rtn &&
		$rtn !~ m!^/! &&
		$rtn !~ m!^[a-z]:!i){
		print "must be absolute path.\n";
	    } else {
		return $rtn;
	    }
	} else {
	    return $rtn;
	}
    }
}

1;

__END__
sub InputSelect_old
{
    my ($prompt, $array) = @_;

    # 表示
    print "$prompt\n";
    my $i = 1;
    for (@$array){
	printf("%d: %s\n", $i, $_);
	$i++;
    }
    $i--;
    # 入力
    my $d;
    while (1){
	$d = InputInteger("select (1-$i): ");
	last if $d >= 1 && $d <= $i;
    }
    return (wantarray) ? ($d, $$array[$d-1]) : $$array[$d-1];
}

    
