Added an improved solution

Source Link

edited Feb 23, 2015 at 21:20

539
6
17

EDIT:

After some careful code reworking and making the menu items into their own object I was able to create a much cleaner interface for creating menus. Here is my new code:

This is a test script showing an example of how to use the modules to build menus.

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

The Menu.pm module is used to build menu objects. These menu objects can contain multiple Menu::Item objects. The objects are stored in an array so their order is preserved.

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

The Item.pm Module must be stored in a subfolder called "Menu" In order for it to be referenced properly. This module lets you create Menu::Item objects that contain a name and a subroutine reference. These objects will be what the user selects from in the menu.

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

This design is a vast improvement over my previous design and makes creating menus much easier and cleaner.

Let me know what you think.

Any comments, thoughts, or improvement ideas?

EDIT:

After some careful code reworking and making the menu items into their own object I was able to create a much cleaner interface for creating menus. Here is my new code:

This is a test script showing an example of how to use the modules to build menus.

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

The Menu.pm module is used to build menu objects. These menu objects can contain multiple Menu::Item objects. The objects are stored in an array so their order is preserved.

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

The Item.pm Module must be stored in a subfolder called "Menu" In order for it to be referenced properly. This module lets you create Menu::Item objects that contain a name and a subroutine reference. These objects will be what the user selects from in the menu.

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

This design is a vast improvement over my previous design and makes creating menus much easier and cleaner.

Let me know what you think.

Any comments, thoughts, or improvement ideas?

Organized code

Source Link

edited Feb 17, 2015 at 13:47

tjwrona

539
6
17

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

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

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

Source Link

asked Feb 17, 2015 at 13:29

tjwrona

539
6
17

Building a Simple Menu With Perl

I wrote a Perl script to implement a simple menu where you can call subroutines for each menu option. I created a Menu class that can be used to create new menus and a print method that will start the menu.

Is there any way I could simplify this?

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

I wrote up a quick test script to test the module:

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

# Print menu1
$menu1->print();

I feel like there must be a simpler, more elegant (or maybe just more pleasing to the eye) way to pass in the menu options rather than using an array of hashes, but I can't seem to figure out any better way to do it.

optimization perl

Stack Exchange Network

Return to Question

Building a Simple Menu With Perl