view release on metacpan or  search on metacpan

lib/Prty/Terminal.pm  view on Meta::CPAN

    my $val = Prty::Terminal->askUser($prompt,-ttyIn=>1);

=cut

# -----------------------------------------------------------------------------

sub askUser {
    my $class = shift;
    my $prompt = shift;
    # @_: @opt

    # Optionen

    my $automatic = 0;
    my $color = '';
    my $default = undef;
    my $in = *STDIN;
    my $out = *STDOUT;
    my $timer = undef;
    my $ttyIn = 0;
    my $ttyOut = 0;
    my $values = undef;

    if (@_) {
        Prty::Option->extract(\@_,
            -automatic=>\$automatic,
            -color=>\$color,
            -default=>\$default,
            -inHandle=>\$in,
            -outHandle=>\$out,
            -timer=>\$timer,
            -ttyIn=>\$ttyIn,
            -ttyOut=>\$ttyOut,
            -values=>\$values,
        );
    }

    if ($automatic) {
        if (defined $default) {
            return $default;
        }
        else {
            $class->throw(
                q~ASK-00001: Im Automatikmodus ist Defaultwert erforderlich~,
            );
        }
    }

    my $reset = '';
    if ($color) {
        $color = $class->ansiEsc($color);
        $reset = $class->ansiEsc('reset');
    }    

    # Prompt generieren: "$prompt [$val1,$val2,...] ($def)"

    $prompt = sprintf '%s%s%s',$color,$prompt,$reset;

    my (@values,$valuesText);
    if ($values) {
        for my $val (split m|[/,]|,$values) {
            my $text = $val;
            if ($val =~ /\((.+)\)/) {
                $val = $1;
                $text = sprintf '%s(%s%s%s)%s',$`,$color,$val,$reset,$';
            }
            push @values,$val;

            $valuesText .= ',' if $valuesText;
            $valuesText .= $text;
        }
    }

    $prompt .= " [$valuesText]" if defined $valuesText;
    $prompt .= " ($default)" if defined $default;
    $prompt .= " " if $valuesText || defined $default;

    # Eingabe lesen und prüfen (falls -values)

    my $t0 = Time::HiRes::gettimeofday;

    my $answ;
    while (1) {
        if ($ttyOut) {
            $out = Prty::FileHandle->new('>','/dev/tty');
        }
        print $out $prompt;

        if ($ttyIn) {
            $in = Prty::FileHandle->new('<','/dev/tty');
        }
        $answ = <$in>;
        if ($ttyIn) {
            $in->close;
        }

        if (defined $answ) {
            # Wert bereinigen

            $answ =~ s/^\s+//;
            $answ =~ s/\s+$//;
            $answ = $default if $answ eq '' && defined $default;
        }
        else { # eof
            print $out "\n";
        }
        if ($ttyOut) {
            $out->close;
        }

        if (@values) {
           next if !defined $answ; # kein Ausstieg mit ^D
           next if !grep { $_ eq $answ } @values;
        }
        last; # Ausstieg
    }

    if ($timer) {
        $$timer += Time::HiRes::gettimeofday-$t0;
    }