如何在Perl中構建一個簡單的菜單？

Question

我正在研究一個需要一些基本菜單功能的Perl腳本。 最終我希望每個菜單都有幾個選項，然后選擇返回上一個菜單或退出。

例：

這是一個菜單：

1. 選擇1
2. 選擇2
3. 返回上一級菜單
4. 出口

選擇一個選項：

我目前有一個菜單子程序來制作菜單，但沒有功能允許它返回上一個菜單。

    sub menu
    {
        for (;;) {
            print "--------------------\n";
            print "$_[0]\n";
            print "--------------------\n";
            for (my $i = 0; $i < scalar(@{ $_[1]}); $i++) {
                print $i + 1, "\.\t ${ $_[1] }[$i]\n";
            }
            print "\n?: ";
            my $i = <STDIN>; chomp $i;
            if ($i && $i =~ m/[0-9]+/ && $i <= scalar(@{ $_[1]})) {
                return ${ $_[1] }[$i - 1];
            } else {
                print "\nInvalid input.\n\n";
            }
        }
    }

    # Using the menu
    my $choice1  = menu('Menu1 header', \@list_of_choices1);

    # I would like this menu to give the option to go back to
    # the first menu to change $choice1
    my $choice2 = menu('Menu2 header', \@list_of_choices2);

我不想對所有菜單進行硬編碼，並使用if / elsif語句進行所有處理，因此我將菜單轉換為函數。

我的菜單目前看起來像這樣......

菜單標題：

1. 選擇1
2. 選擇2
3. Choice3

？:(在此輸入輸入）

此解決方案仍然不允許用戶返回上一個菜單或退出。 我正在考慮制作一個菜單類來處理菜單，但我仍然不太喜歡面向對象的Perl。 這是一個只有少量菜單的小程序，因此使用復雜的菜單構建模塊可能有點過分。 我想讓我的代碼盡可能輕松。

編輯：

感謝您的快速回復！ 但是仍然存在問題。 當我從“Menu1”中選擇一個選項並進入“Menu2”時，我希望從“Menu1”中保存選項供以后使用：

菜單1：

1. Choice1 < - 如果選擇存儲值，則轉到下一個菜單
2. 選擇2 < - ......
3. 退出< - 退出

菜單2：

1. Choice1 < - 如果選擇存儲值，則轉到下一個菜單
2. 選擇2 < - ......
3. 返回< - 返回上一級菜單以重新選擇值
4. 退出< - 退出

選擇Choice1或Choice2應該在變量中存儲一個值供以后使用， 並進入下一個菜單。 然后，如果您選擇從Menu2返回第一個菜單，它將為您提供重新選擇並重新定義變量的選項。 我試圖避免使用全局變量，這使得這非常困難。

在完成所有菜單並設置所有這些變量的值之后，我想運行一個子程序來處理所有選項並打印最終輸出。

 sub main () {

   # DO MENU STUFF HERE

   # PROCESS RESULTS FROM MENU CHOICES
   my $output = process($menu1_choice, $menu2_choice, $menu3_choice, ... );
 }

此外，如果任何人使用類或其他數據結構有一個面向對象的方法，雖然它可能是矯枉過正，我仍然希望看到它，並試圖繞過這個想法！

Answer 1

您可以使用諸如Term :: Choose之類的模塊：

use Term::Choose qw( choose );

my $submenus = {
    menu1 => [ qw( s_1 s_2 s_3 ) ],
    menu2 => [ qw( s_4 s_5 s_6 s_7) ],
    menu3 => [ qw( s_8 s_9 ) ],
};
my @menus = ( qw( menu1 menu2 menu3 ) );
my $mm = 0;
MAIN: while ( 1 ) {
    my $i = choose( 
        [ undef, @menus ],
        { layout => 3, undef => 'quit', index => 1, default => $mm }
    );
    last if ! $i;
    if ( $mm == $i ) {
        $mm = 0;
        next MAIN;
    }
    else {
        $mm = $i;
    }
    $i--;
    SUB: while ( 1 ) {
        my $choice = choose(
            [ undef, @{$submenus->{$menus[$i]}} ],
            { layout => 3, undef => 'back' }
        );
        last SUB if ! defined $choice;
        say "choice: $choice";
    }
}

Answer 2

如果你不想用這個完整的OO，一個簡單的方法，你可以使這個更靈活是允許每個菜單選擇來控制它的執行方式。 假設每個菜單都有一個包含菜單文本的哈希數組和一個實現菜單功能的coderef。

use strict;
use warnings;

sub menu {
    my @items = @_;

    my $count = 0;
    foreach my $item( @items ) {
        printf "%d: %s\n", ++$count, $item->{text};
    }

    print "\n?: ";

    while( my $line = <STDIN> ) {
        chomp $line;
        if ( $line =~ m/\d+/ && $line <= @items ) {
            return $items[ $line - 1 ]{code}->();
        }

        print "\nInvalid input\n\n?: ";
    }
}

my @menu_choices;
my @other_menu_choices;

@menu_choices = (
    { text  => 'do something',
      code  => sub { print "I did something!\n" } },
    { text  => 'do something else',
      code  => sub { print "foobar!\n" } },
    { text  => 'go to other menu',
      code  => sub { menu( @other_menu_choices ) } }
);

@other_menu_choices = (
    { text  => 'go back',
      code  => sub { menu( @menu_choices ) } }
);

menu( @menu_choices );

menu子例程采用一系列選項，每個選項“知道”如何執行自己的操作。 如果要在菜單之間切換，菜單選項只需再次使用不同的選項列表調用menu ，如@other_menu_choices中的“返回”示例。 這使得菜單之間的鏈接非常容易，並且還可以輕松添加退出選項等。

為了保持此代碼的清晰和可讀性，除了簡單的菜單操作之外的任何其他操作，請使用對子例程的命名引用，而不是匿名子例程引用。 例如：

@another_menu_options = (
    { text => 'complicated action'
      code => \&do_complicated_action
    }
);

sub do_complicated_action { 
    ...
}

Answer 3

在使用Perl進行了幾個月的編程之后，我學到了更多關於如何處理對象的知識，並根據friedo的答案編寫了一個簡單的面向對象的菜單構建模塊。

# Menu.pm

#!/usr/bin/perl

package Menu;

use strict;
use warnings;

# Menu constructor
sub new {

    # Unpack input arguments
    my $class = shift;
    my (%args) = @_;
    my $title       = $args{title};
    my $choices_ref = $args{choices};
    my $noexit      = $args{noexit};

    # Bless the menu object
    my $self = bless {
        title   => $title,
        choices => $choices_ref,
        noexit  => $noexit,
    }, $class;

    return $self;
}

# Print the menu
sub print {

    # Unpack input arguments
    my $self = shift;
    my $title   =   $self->{title  };
    my @choices = @{$self->{choices}};
    my $noexit  =   $self->{noexit };

    # Print menu
    for (;;) {

        # Clear the screen
        system 'cls';

        # Print menu title
        print "========================================\n";
        print "    $title\n";
        print "========================================\n";

        # Print menu options
        my $counter = 0;
        for my $choice(@choices) {
            printf "%2d. %s\n", ++$counter, $choice->{text};
        }
        printf "%2d. %s\n", '0', 'Exit' unless $noexit;

        print "\n?: ";

        # Get user input
        chomp (my $input = <STDIN>);

        print "\n";

        # Process input
        if ($input =~ m/\d+/ && $input >= 1 && $input <= $counter) {
            return $choices[$input - 1]{code}->();
        } elsif ($input =~ m/\d+/ && !$input && !$noexit) {
            print "Exiting . . .\n";
            exit 0;
        } else {
            print "Invalid input.\n\n";
            system 'pause';
        }
    }
}

1;

使用此模塊，您可以相對輕松地構建菜單並將它們鏈接在一起。 請參閱以下用法示例：

# test.pl

#!/usr/bin/perl

use strict;
use warnings;

use Menu;

my $menu1;
my $menu2;

# define menu1 choices
my @menu1_choices = (
    { text => 'Choice1',
      code => sub { print "I did something!\n"; }},
    { text => 'Choice2',
      code => sub { print "I did something else!\n"; }},
    { text => 'Go to Menu2',
      code => sub { $menu2->print(); }},
);

# define menu2 choices
my @menu2_choices = (
    { text => 'Choice1',
      code => sub { print "I did something in menu 2!\n"; }},
    { text => 'Choice2',
      code => sub { print "I did something else in menu 2!\n"; }},
    { text => 'Go to Menu1',
      code => sub { $menu1->print(); }},
);

# Build menu1
$menu1 = Menu->new(
    title   => 'Menu1',
    choices => \@menu1_choices,
);

# Build menu2
$menu2 = Menu->new(
    title   => 'Menu2',
    choices => \@menu2_choices,
    noexit  => 1,
);

# Print menu1
$menu1->print();

此代碼將創建一個帶子菜單的簡單菜單。 進入子菜單后，您可以輕松返回上一個菜單。

感謝所有偉大的答案！ 他們真的幫助我解決了這個問題，如果沒有所有的幫助，我認為我不會得到如此好的解決方案！

---

更好的解決方案：

跟那些丑陋的哈希陣列說再見！

Menu.pm和Item.pm模塊內部的一些代碼可能看起來有點令人困惑，但這種新設計使得構建菜單的界面更加清晰和高效。

經過一些仔細的代碼重新編寫並將各個菜單項放入自己的對象后，我能夠創建一個更清晰的界面來創建菜單。 這是我的新代碼：

這是一個測試腳本，顯示了如何使用模塊構建菜單的示例。

# test.pl

#!/usr/bin/perl

# Always use these
use strict;
use warnings;

# Other use statements
use Menu;

# Create a menu object
my $menu = Menu->new();

# Add a menu item
$menu->add(
    'Test'  => sub { print "This is a test\n";  system 'pause'; },
    'Test2' => sub { print "This is a test2\n"; system 'pause'; },
    'Test3' => sub { print "This is a test3\n"; system 'pause'; },
);

# Allow the user to exit directly from the menu
$menu->exit(1);

# Disable a menu item
$menu->disable('Test2');
$menu->print();

# Do not allow the user to exit directly from the menu
$menu->exit(0);

# Enable a menu item
$menu->enable('Test2');
$menu->print();

Menu.pm模塊用於構建菜單對象。 這些菜單對象可以包含多個Menu :: Item對象。 對象存儲在一個數組中，因此保留了它們的順序。

# Menu.pm

#!/usr/bin/perl

package Menu;

# Always use these
use strict;
use warnings;

# Other use statements
use Carp;
use Menu::Item;

# Menu constructor
sub new {

    # Unpack input arguments
    my ($class, $title) = @_;

    # Define a default title
    if (!defined $title) {
        $title = 'MENU';
    }

    # Bless the Menu object
    my $self = bless {
        _title => $title,
        _items => [],
        _exit  => 0,
    }, $class;

    return $self;
}

# Title accessor method
sub title {
    my ($self, $title) = @_;
    $self->{_title} = $title if defined $title;
    return $self->{_title};
}

# Items accessor method
sub items {
    my ($self, $items) = @_;
    $self->{_items} = $items if defined $items;
    return $self->{_items};
}

# Exit accessor method
sub exit {
    my ($self, $exit) = @_;
    $self->{_exit} = $exit if defined $exit;
    return $self->{_exit};
}

# Add item(s) to the menu
sub add {

    # Unpack input arguments
    my ($self, @add) = @_;
    croak 'add() requires name-action pairs' unless @add % 2 == 0;

    # Add new items
    while (@add) {
        my ($name, $action) = splice @add, 0, 2;

        # If the item already exists, remove it
        for my $index(0 .. $#{$self->{_items}}) {
            if ($name eq $self->{_items}->[$index]->name()) {
                splice @{$self->{_items}}, $index, 1;
            }
        }

        # Add the item to the end of the menu
        my $item = Menu::Item->new($name, $action);
        push @{$self->{_items}}, $item;
    }

    return 0;
}

# Remove item(s) from the menu
sub remove {

    # Unpack input arguments
    my ($self, @remove) = @_;

    # Remove items
    for my $name(@remove) {

        # If the item exists, remove it
        for my $index(0 .. $#{$self->{_items}}) {
            if ($name eq $self->{_items}->[$index]->name()) {
                splice @{$self->{_items}}, $index, 1;
            }
        }
    }

    return 0;
}

# Disable item(s)
sub disable {

    # Unpack input arguments
    my ($self, @disable) = @_;

    # Disable items
    for my $name(@disable) {

        # If the item exists, disable it
        for my $index(0 .. $#{$self->{_items}}) {
            if ($name eq $self->{_items}->[$index]->name()) {
                $self->{_items}->[$index]->active(0);
            }
        }
    }

    return 0;
}

# Enable item(s)
sub enable {

    # Unpack input arguments
    my ($self, @enable) = @_;

    # Disable items
    for my $name(@enable) {

        # If the item exists, enable it
        for my $index(0 .. $#{$self->{_items}}) {
            if ($name eq $self->{_items}->[$index]->name()) {
                $self->{_items}->[$index]->active(1);
            }
        }
    }
}

# Print the menu
sub print {

    # Unpack input arguments
    my ($self) = @_;

    # Print the menu
    for (;;) {
        system 'cls';

        # Print the title
        print "========================================\n";
        print "    $self->{_title}\n";
        print "========================================\n";

        # Print menu items
        for my $index(0 .. $#{$self->{_items}}) {
            my $name   = $self->{_items}->[$index]->name();
            my $active = $self->{_items}->[$index]->active();
            if ($active) {
                printf "%2d. %s\n", $index + 1, $name;
            } else {
                print "\n";
            }
        }
        printf "%2d. %s\n", 0, 'Exit' if $self->{_exit};

        # Get user input
        print "\n?: ";
        chomp (my $input = <STDIN>);

        # Process user input
        if ($input =~ m/^\d+$/ && $input > 0 && $input <= scalar @{$self->{_items}}) {
            my $action = $self->{_items}->[$input - 1]->action();
            my $active = $self->{_items}->[$input - 1]->active();
            if ($active) {
                print "\n";
                return $action->();
            }
        } elsif ($input =~ m/^\d+$/ && $input == 0 && $self->{_exit}) {
            exit 0;
        }

        # Deal with invalid input
        print "\nInvalid input.\n\n";
        system 'pause';
    }
}

1;

Item.pm模塊必須存儲在名為“Menu”的子文件夾中才能正確引用。 此模塊允許您創建包含名稱和子例程引用的Menu :: Item對象。 這些對象將是用戶在菜單中選擇的對象。

# Item.pm

#!/usr/bin/perl

package Menu::Item;

# Always use these
use strict;
use warnings;

# Menu::Item constructor
sub new {

    # Unpack input arguments
    my ($class, $name, $action) = @_;

    # Bless the Menu::Item object
    my $self = bless {
        _name   => $name,
        _action => $action,
        _active => 1,
    }, $class;

    return $self;
}

# Name accessor method
sub name {
    my ($self, $name) = @_;
    $self->{_name} = $name if defined $name;
    return $self->{_name};
}

# Action accessor method
sub action {
    my ($self, $action) = @_;
    $self->{_action} = $action if defined $action;
    return $self->{_action};
}

# Active accessor method
sub active {
    my ($self, $active) = @_;
    $self->{_active} = $active if defined $active;
    return $self->{_active};
}

1;

這種設計比我之前的設計有了很大的改進，使創建菜單變得更加容易和清潔。

讓我知道你的想法。

任何評論，想法或改進想法？

Answer 4

以下是一種方法。 每個選項都有一個相關的子程序。 選擇后，調用相應的子程序。 這里我使用匿名子例程，但您也可以使用對命名子例程的引用。

use warnings; use strict;

sub menu {
  my $args = shift;
  my $title = $args->{title};
  my $choices = $args->{choices};

  while (1) {
    print "--------------------\n";
    print "$title\n";
    print "--------------------\n";
    for (my $i = 1; $i <= scalar(@$choices); $i++) {
      my $itemHeading = $choices->[$i-1][0];
      print "$i.\t $itemHeading\n";
    }
    print "\n?: ";
    my $i = <STDIN>; chomp $i;
    if ($i && $i =~ m/[0-9]+/ && $i <= scalar(@$choices)) {
      &{$choices->[$i-1][1]}();
    } else {
      print "\nInvalid input.\n\n";
    }
  }
}

my $menus = {};
$menus = {
  "1" => {
    "title" => "Menu 1 header",
    "choices" => [
       [ "Choice 1" , sub { print "Choice 1 selected"; }],
       [ "Choice 2" , sub { print "Choice 2 selected"; }],
       [ "Menu 2" , sub { menu($menus->{2}); }],
       [ "Exit" , sub { exit; }],
    ],
  },
 "2" => {
    "title" => "Menu 2 header",
    "choices" => [
       [ "Choice 3" , sub { print "Choice 3 selected"; }],
       [ "Choice 4" , sub { print "Choice 4 selected"; }],
       [ "Menu 1" , sub { menu($menus->{1}); }],
       [ "Exit" , sub { exit; }],
  ],
  },
};

menu($menus->{1});

Answer 5

謝謝大家的回復！ 所有這三個回復都有助於最終提出我的解決方案。 我決定使用Term :: Choose模塊，（感謝sid_com的想法）。 我的菜單結構與你最初的建議不同，我花了很長時間才弄清楚如何讓它完全符合我的想法。 希望這個解決方案可以幫助遇到類似問題的其他人。

我構建了如下所示的菜單：

（ 我用更通用的名稱替換了我的變量，因此更容易理解 ）

    #!/usr/bin/perl

    use strict;
    use warnings;
    use Term::Choose qw(choose);

    my @CHOICES1 = ('A','B','C');
    my @CHOICES2 = ('1','2','3');
    my @CHOICES3 = ('BLUE','YELLOW','GREEN');

    # function to use the choices
    sub some_function {
        print "THIS IS SOME FUNCTION!\n";
        print "Choice 1 is $_[0]\n";
        print "Choice 2 is $_[1]\n";
        print "Choice 3 is $_[2]\n";
        print "Have a nice day! :)\n";
    }

    sub main() {

        # clear the screen
        # (for some reason the build in screen clear 
        # for the module was not working for me)
        system ('cls');

        # create menu object
        my $menu = new Term::Choose();

        # menu 1
        for (;;) {
            my $choice1 = $menu->choose(
                [@CHOICES1, undef],
                {
                    prompt => 'Select a choice1:',
                    undef  => 'Exit',
                    layout => 3,
                }
            );
            last if ! $choice1;

            # submenu 1
            for (;;) {
                my $choice2 = $menu->choose(
                    [@CHOICES2, undef],
                    {
                        prompt => 'Select a choice2:',
                        undef  => 'Back',
                        layout => 3,
                    }
                );
                last if ! $choice2;

                # submenu2
                for (;;) {
                    my $choice3 = $menu->choose(
                        [@CHOICES3, undef],
                        {
                             prompt => 'Select a choice3:',
                            undef  => 'Back',
                            layout => 3,
                        }
                    );
                    last if ! $choice3;

                    # function operating on all choices
                    some_function($choice1, $choice2, $choice3);
                    return;
                }
            }
        }
    }

    main();

我仍然是面向對象Perl的新手，所以這需要花費很長時間來弄清楚它可能並不完美，但它完成了工作。 如果您有任何想法或改進，請告訴我們！

Answer 6

我在perl模塊中找到了這個沒有任何perldoc的舊模塊...請試一試...

#!/usr/bin/perl
    BEGIN { $Curses::OldCurses = 1; }
    use Curses;
    use perlmenu;
    &menu_init(0,"Select an Animal"); # Init menu

    &menu_item("Collie","dog"); # Add item
    &menu_item("Shetland","pony"); # Add item
    &menu_item("Persian","cat"); # Add last item

    $sel = &menu_display("Which animal?"); # Get user selection

    if ($sel eq "dog") {print "Its Lassie!\n";}