view release on metacpan or  search on metacpan

lib/CLI/Helpers.pm  view on Meta::CPAN

    foreach my $key (sort keys %desc) {
        $ref{++$id} = $key;
    }

    my $choice;
    until( defined $choice && exists $ref{$choice} ) {
        output({color=>'red',stderr=>1},"ERROR: invalid selection") if defined $choice;
        foreach my $id (sort { $a <=> $b } keys %ref) {
            printf "    %d. %s\n", $id, $desc{$ref{$id}};
        }
        print "\n";
        $choice = _get_input("Selection (1-$id): ");
    }
    return $ref{$choice};
}


sub pwprompt {
    my ($prompt, %args) = @_;
    $prompt ||= "Password: ";
    my @more_validate;
    if (my $validate = $args{validate}){
        @more_validate = %$validate;
    }
    return text_input($prompt,
        noecho     => 1,
        clear_line => 1,
        validate => { "password length can't be zero." => sub { defined && length },
                      @more_validate,
                    },
    );
}


sub prompt {
    my ($prompt) = shift;
    my %args = @_;

    return confirm($prompt)           if exists $args{yn};
    return menu($prompt, $args{menu}) if exists $args{menu};
    # Check for a password prompt
    if( lc($prompt) =~ /passw(or)?d/ ) {
        $args{noecho} = 1;
        $args{validate} ||= {};
        $args{validate}->{"password length can't be zero."} = sub { defined && length };
    }
    return text_input($prompt,%args);
}

sub _get_input {
    my ($prompt,$args) = @_;

    state $interactive = is_interactive();
    state $term;

    my $text = '';
    if( $interactive ) {
        # Initialize Term
        $term ||= Term::ReadLine->new($0);
        $args ||= {};
        print "\e[s" if $args->{clear_line}; # Save cursor position
        if( $args->{noecho} ) {
            # Disable all the Term ReadLine magic
            local $|=1;
            print $prompt;
            ReadMode('noecho');
            $text = ReadLine();
            ReadMode('restore');
            print "\n";
            chomp($text);
        }
        else {
            $text = $term->readline($prompt);
            $term->addhistory($text) if length $text && $text =~ /\S/;
        }
        print "\e[u\e[K" if $args->{clear_line}; # Return to saved position, erase line
    }
    else {
        # Read one line from STDIN
        $text = <>;
    }
    return $text;
}



# Return True
1;

__END__

=pod

=head1 NAME

CLI::Helpers - Subroutines for making simple command line scripts

=head1 VERSION

version 2.3

=head1 SYNOPSIS

This module provides a library of useful functions for constructing simple command
line interfaces.  It is able to extract information from the environment and your
~/.gitconfig to display data in a reasonable manner.

    use CLI::Helpers;

    ...
    output({color=>"green"}, "Hello, world!");
    debug({color=>"yellow"}, "Debug output!");

Using this module adds argument parsing using L<Getopt::Long> to your script.  It
enables pass-through, so you can still use your own argument parsing routines or
L<Getopt::Long> in your script.

=head1 EXPORT

This module exports the C<:all> group by default.