Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Simple text menu

by del (Pilgrim)
on Dec 28, 2002 at 05:29 UTC ( [id://222687]=CUFP: print w/replies, xml ) Need Help??

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);

Replies are listed 'Best First'.
Re: Simple text menu
by Aristotle (Chancellor) on Dec 29, 2002 at 01:19 UTC
    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.

      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" } } }
        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.

Re: Simple text menu
by Juerd (Abbot) on Dec 29, 2002 at 00:57 UTC

    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.
    

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://222687]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (9)
As of 2024-03-28 09:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found