Date: Thu, 05 Jul 2001 08:42:01 -0500
From: Michael Carman <mjcarman@home.com>
Subject: Re: Text based menuing system in Perl with submenus???
Message-Id: <3B446EA9.5C1D234@home.com>

David Mohorn wrote:
> 
> Does anyone have any sample code of a text base menu system in
> Perl that is flexible and easy to maintain?  I could have nested
> menus, meaning: menu 1 could have an option to menu 2.  Menu 2
> could have an option for menu 3.  As users back out from menu 3,
> it should return to menu 2, then back to menu 1.

I don't know what the Curses module provides as I've never used it, but
it may be helpful for you. If not, here's a chunk of code I wrote a
while back when I was trying to do something similar and got tired of
writing a bunch of code for each menu. It won't handle the state machine
stuff, you'll have to do that yourself, but it should make it easy to
create multiple menus.

#!/usr/local/bin/perl5 -w
use strict;

# EXAMPLE:
my %menu_hash = (
    E => 'Echo',
    C => 'Charlie',
    A => 'Alpha',
    D => 'Delta',
    B => 'Bravo',
    F => 'Foxtrot');
    
my $choice = Pick_From_Menu(numeric_keys   => 0, 
                            sort_by_values => 1,
                            max_display    => 4,
                            prompt         => 'Whatcha want?',
                            menu           => \%menu_hash);
print "You chose $choice.\n";

sub Clear_Screen {
    if ($^O =~ /MSWin/) {
        system('cls');   # Win* platforms
    }
    else {
        system('clear'); # Guess that it's a *nix platform
    }
}

#-----------------------------------------------------------------------
# Subroutine : Pick_From_Menu(%)
# Purpose    : Generic and flexible subroutine for creating a menu
#              using a hash as the menu items.
# Notes      : Call with named aggregate notation. Aside from 'menu', 
#              all arguments are optional. 'menu' must be given a hash
#              reference, not a hash!
#-----------------------------------------------------------------------
sub Pick_From_Menu {
    my %args = ( 
        # Default parameter values
        confirm        => 0, # 0 -> Return on first valid response
                             # 1 -> Confirm selection before returning
        max_errors     => 3, # N -> Give up after N invalid choices
        clear_on_err   => 1, # 0 -> Just keep streaming down the screen
                             # 1 -> Clear screen on error/next page
        sort_by_values => 0, # 0 -> Display items sorted by hash keys
                             # 1 -> Display items sorted by hash values
        numeric_keys   => 1, # 0 -> Sort keys numerically
                             # 1 -> Sort keys alphabetically
        max_display    => 0, # 0 -> Display the full menu
                             # N -> Display menu N items at a time
        return_key     => 0, # 0 -> Returns hash value
                             # 1 -> Returns hash key
        prompt         => 'Please make a selection:',
        menu           => undef,
        @_);
    my @list;
    my $count;
    my $response;
    my $returnval;
    my ($first_item, $last_item);
    my $select_prompt;
    
    die ('No menu to pick from') unless ref($args{menu}) eq 'HASH';

    if ($args{sort_by_values}) {
        @list = sort {$args{menu}->{$a} cmp $args{menu}->{$b}} 
                     keys %{$args{menu}};
    }
    elsif ($args{numeric_keys}) {
        @list = sort {$a <=> $b} keys %{$args{menu}};
    }
    else {
        @list = sort {$a cmp $b} keys %{$args{menu}};
    }

    # If the caller didn't specify a maximum number of menu items to
    # display at a time, default to the number of items in the menu.
    $args{max_display} ||= @list;

    #-------------------------------------------------
    # Initializes limits on menu items to be displayed
    #-------------------------------------------------
    my $Init_Disp_Limits = sub {
        $first_item = 0;
        if ($args{max_display} < @list) {
            $last_item = $args{max_display} - 1;
            $select_prompt = 'Selection (ENTER for more): ';
        }
        else {
            $last_item = $#list;
            $select_prompt = 'Selection: ';
        }
    };

    $Init_Disp_Limits->();

    for ($count = 0; $count < $args{max_errors}; $count++) {

        printf ("%s\n", $args{prompt});
        foreach ($first_item .. $last_item) {
            printf ("%3s - %s\n", $list[$_], $args{menu}->{$list[$_]});
        }
        print "\n";
        
        print $select_prompt;
        $response = <STDIN>;
        chomp $response;

        if ($response =~ /^\s*$/) {
            if ($last_item >= $#list) {
                $Init_Disp_Limits->();
            }
            else {
                $first_item = $last_item + 1;
                if ($#list > $last_item + $args{max_display}) {
                    $last_item += $args{max_display};
                }
                else {
                    $last_item = $#list;
                }
            }
            Clear_Screen() if $args{clear_on_err};
            redo;
        }
        
        if (defined $args{menu}->{$response}) {
            $returnval = ($args{return_key}) 
                ? $response
                : $args{menu}->{$response};
            if ($args{confirm}) {
                print "Selection = $response\n";
                print 'Is this correct? [Y]/N : ';
                my $confirm = <STDIN>;
                if ($confirm =~ /^(y|\n)/i) {
                    return ($returnval);
                }
                else {
                    $Init_Disp_Limits->();
                    $count = 0;
                    Clear_Screen() if ($args{clear_on_err});
                    redo;
                }
            }
            else {
                return ($returnval);
            }
        }
        else {
            Clear_Screen() if ($args{clear_on_err});
            print "Your response '$response' is not valid.\n\n";
            $Init_Disp_Limits->();
        }
    }
    print "Too many invalid attempts. Exiting.\n";
    exit;
} # END Pick_From_Menu()