Simple text menu

[del]

Here simple function (in a program demonstrating an example use) to present a menu of choices, and call code based on the selection. No modules are required for this quick and dirty menu. Menus can be dynamically generated if you like.

N.B. Anyone considering the use of this snippet will most likely benefit from the code offered in the replies.

#!/usr/bin/perl -w

# a simple text-based menu system

use strict;

my ($menu1, $menu2);
# Sample menus are defined below.  Each menu is an anonymous 
# array. The first element is the title of the menu.  The following 
# elements  are anonymous arrays containing a description of the
# menu item (it will be printed) and a reference to a routine to call 
# should that item be selected.

# The following is a shortcut that can be used in other menus.
my $quit_menu_item = [ "Quit", sub{exit;} ];

$menu1 = [
         "Title of First Menu",
         [ "Do Something (first)", \&ds1 ],
         [ "Second Menu", sub{ &menu( $menu2 )} ],
         [ "Quit", sub {exit;} ], # We could have used our shortcut.
     ];

$menu2 = [
         "Title of Second Menu",
         [ "Do Something (second)", \&ds2 ],
         [ "First Menu", sub{ &menu( $menu1 )} ],
         $quit_menu_item, # This is our shortcut.
     ];

##### The menu routine itself. #####
sub menu {
    my $m = shift;
    my $choice;
    while (1) {
    print "$m->[0]:\n";
    print map { "\t$_. $m->[$_][0]\n" } (1..$#$m);
    print "> ";
    chomp ($choice = <>);
    last if ( ($choice > 0) && ($choice <= $#$m ));
    print "You chose '$choice'.  That is not a valid option.\n\n";
    }
    &{$m->[$choice][1]};
}

# Do something 1
sub ds1 {
    print "\nIn ds1\n\n";
    &menu($menu1);
}

# Do something 2
sub ds2 {
    print "\nIn ds2\n\n";
    &menu($menu2);
}

## TEST
&menu($menu1);

[Aristotle]

Along the lines of Juerd's code, but with implicit recursion and much less array index math (which I hate with a passion):

sub menu {
    my ($title, @option) = @{ shift };
    my (@name, @action);

    ($name[@name], $action[@action]) = splice @option, 0, 2
        while @option;

    while(1) {
        print "\n$title\n";
        print map "$_. $name[$_ - 1]\n", 1 .. @name;
        print '> ';

        chomp (my $choice = readline *STDIN);
        if ($choice and $choice > 0 and $choice <= @action) {
            my $do_action = $action[$choice];

            return unless defined $do_action;
            $do_action->() if 'CODE' eq ref $action;
            $menu($action) if 'ARRAY' eq ref $action;

            require Carp;
            Carp::croak "I don't know what to do with $action";
        } else {
            print "Invalid choice: $choice\n"
        }
    }
}

Now you can still very similarly say

#!/usr/bin/perl -w
use strict;

sub foo { print "FOO!\n" }
sub bar { print "BAR!\n" }

sub menu { ... }

my ($mainmenu, $submenu);

$submenu = [
    'Submenu',
    'Bar',                  => \&bar,
    'Back to previous menu' => undef,
];

$mainmenu = [
    'Main menu',
    'Foo'        => \&foo,
    'Submenu...' => $submenu,
    'Exit'       => undef,
];

menu($mainmenu);

but you can also much more concisely say

menu([
    'Main menu',
    'Foo'        => \&foo,
    'Submenu...' => [
        'Submenu',
        'Bar',                  => \&bar,
        'Back to previous menu' => undef,
    ],
    'Exit'       => undef,
]);

Makeshifts last the longest.

[Mutector]

I think the subroutine is not entirely correct. Without te Carp which I don't have on my system I came up with this working version:

sub menu { 
  my ($title, @option) = @{shift(@_)}; 
  my (@name, @action); 
 
  ($name[@name], $action[@action]) = splice @option, 0, 2 
     while @option; 
 
    while(1) { 
      print "\n$title\n"; 
      print map "$_. $name[$_ - 1]\n", 1 .. @name; 
      print '> '; 
 
      chomp (my $choice = readline *STDIN); 
      if ($choice and $choice > 0 and $choice <= @action) { 
        my $do_action = $action[$choice-1]; 
 
        return unless defined $do_action; 
        $do_action->() if 'CODE' eq ref $action[$choice-1]; 
        menu($action[$choice-1]) if 'ARRAY' eq ref $action[$choice-1];
+ 
      } else { 
          print "Invalid choice: $choice\n" 
      } 
  } 
}

[jdporter]

Carp which I don't have on my system

Are you sure? What happens when you type:

    perl -MCarp -e0

Carp is standard. If you don't have it, your perl installation is seriously b0rken.

[Juerd]

Based on your code, but made recursive, and with less array references:

#!/usr/bin/perl -w
use strict;

sub foo { print "FOO!\n" }
sub bar { print "BAR!\n" }

sub menu {
    my ($menu) = @_;
    for (;;) {
        print "\n$menu->[0]\n";
        print map "$_. $menu->[$_ * 2 - 1]\n", 1 .. $#$menu / 2;
        print '> ';
        chomp (my $choice = readline *STDIN);
        if ($choice and $choice <= $#$menu / 2) {
            my $action = \$menu->[$choice * 2];
            return if not defined $action;
            $action->()  if ref $action eq 'CODE';
            menu $action if ref $action eq 'ARRAY'
        } else {
            print "Invalid choice: $choice\n"
        }
    }
}

my ($mainmenu, $submenu);

$mainmenu = [
    'Main menu',
    'Foo'        => \&foo,
    'Submenu...' => sub { menu $submenu },
    'Exit'       => undef,
];

$submenu = [
    'Submenu',
    'Bar',                  => \&bar,
    'Back to previous menu' => undef,
];

menu $mainmenu;

Update
Aristotle++ has a very good point with the arrayref used as action, so I used Acme::Magpie to steal it :)

menu [
    'Main menu',
    'Foo'        => \&foo,
    'Submenu...' => [
        'Submenu',
        'Bar',                  => \&bar,
        'Back to previous menu' => undef,
    ],
    'Exit'       => undef,
];

- Yes, I reinvent wheels.
- Spam: Visit eurotraQ.