view release on metacpan or  search on metacpan

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

    # Optionen

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

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

    if ($automatic) {
        if (defined $default) {
            return $default;
        }
        else {
            $class->throw(
                'ASK-00001: Option -automatic without option -default',
            );
        }
    }

    if ($timeout && !defined $default) {
        $class->throw(
            'ASK-00002: Option -timeout without option -default',
        );
    }

    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 =~ /\((.+)\)/) {
                # (y)es,(a)bort
                $val = $1;
                $text = sprintf '%s(%s%s%s)%s',$`,$color,$val,$reset,$';
            }
            elsif ($val =~ /^(.*?)=(.*)/) {
                # y=yes,a=abort
                $val = $1;
                $text = sprintf '%s%s%s=%s',$color,$val,$reset,$2;
            }
            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 = Quiq::FileHandle->new('>','/dev/tty');
        }
        print $out $prompt;

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

        if ($timeout) {
            eval {
                local $SIG{ALRM} = sub {die "alarm\n"}; # \n erforderlich
                alarm $timeout;
                $answ = <$in>;
                alarm 0;
            };
            if ($@) {
                # Timeout abgelaufen

                if ($@ ne "alarm\n") {
                    # Unerwarteten Fehler weiterleiten
                    die;
                }
                say $answ = $default;
            }
        }
        else {
            $answ = <$in>;
        }

        if ($ttyIn) {
            $in->close;