#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $done;
while (! $done) {
    print << '__MENU__';
Main Menu
  1. Get date and time
  2. Go to submenu
  3. Quit
__MENU__

    chomp( my $reply = <> );
    next unless $reply =~ /^[123]$/;

    if ($reply == 1) {
        say scalar localtime;

    } elsif ($reply == 2) {
        $done = submenu();

    } else {
        $done = 1;
    }

}

sub submenu {
    my $done;
    while (! $done) {
        print << '__MENU__';
Submenu
  1. Get username
  2. Back
  3. Quit
__MENU__

        chomp( my $reply = <> );
        next unless $reply =~ /^[123]$/;

        if ($reply == 1) {
            say scalar getpwuid $>;

        } else {
            $done = $reply;
        }
    }
    return $done == 3
}
[download]

As you probably noticed, most of the code is repeated, so it should be extracted to a subroutine.

Update:

($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord
}map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
[download]

The solution is to make the entire logic data-driven.

I'm not suggesting this code be attempted by a novice , but once the data structure is designed, and driver code written, menus can easily be expanded by one.

In this example, nesting of menus can go to any depth.

#!/usr/bin/perl -w
use strict;
use Term::ANSIColor qw(:constants);

my $actionFlag="NONE"; # An ugly, but necessary Global

my $Options=[
   {NAME=>"Adtran", 
       SUBMENU=>[
            {NAME=>"Adtran 1148V", ACTION=>sub{print "1148V Options\n"
+;}},
            {NAME=>"Adtran 1100F", ACTION=>sub{print "1100F Options\n"
+;}},
            {NAME=>"Go Back",      ACTION=>sub{print "Go Back a Screen
+\n"; $actionFlag="BACK";},COLOR=>YELLOW},
            {NAME=>"Exit",         ACTION=>sub{print "Exit\n"; $action
+Flag="EXIT";},COLOR=>RED},
            ],
   },
   {NAME=>"Alcatel", ACTION=>sub{print "Alcatel ACTION\n";}},
   {NAME=>"Calix",   ACTION=>sub{print "Calix ACTION\n";}},
   {NAME=>"Juniper", ACTION=>sub{print "Juniper ACTION\n";}},
   {NAME=>"Exit",    ACTION=>sub{print "EXIT ACTION\n"; $actionFlag="E
+XIT"},
    COLOR=>RED},

];

#my $current_menu = $Options; # Can't think of an easy way to avoid th
+is global
#my $prev_menu    = $Options;
#my $current_header="Options"; # This won't survive deep menus ... Lef
+t as an exercise..
my @stack = (["Options",$Options]);

#--------------------------------------------------
sub Display_Options_and_Get_Response{
    my ($header, $opt) = @_;

    print GREEN, "------------------------------------\n", RESET;
    print YELLOW, "              $header                \n", RESET;
    print GREEN, "------------------------------------\n", RESET;
    print "\n";

    for (0..$#$opt){
        my $color = $opt->[$_]{COLOR} || GREEN;
        print $color, ($_+1),"   ",$opt->[$_]{NAME},"\n",RESET;
    }
    print YELLOW, "Selection : ", RESET;
    chomp (my $selection = <>);
    if ($selection and  my $selected=$opt->[$selection - 1]){
        if (my $submenu = $selected->{SUBMENU}){
           #$prev_menu    = $opt;
           #$current_menu = $submenu;
           #$current_header = $opt->[$selection - 1]{NAME};
           push @stack,[$opt->[$selection - 1]{NAME}, $submenu];
           return 0;
        }
        if (my $act = $selected->{ACTION}){
            $act->();
        }
        return $selection;
    }
    print RED,"Invalid Selection:",RESET,$selection,
          " try again\n";
    sleep 1;
    return 0;
}

#---------- M A I N   L O O P ----------------------
while ($actionFlag ne "EXIT"){
   if ($actionFlag eq "BACK"){
      pop @stack if @stack > 1;
   }
   $actionFlag = "NONE";
   Display_Options_and_Get_Response($stack[-1][0],  $stack[-1][1]);
}
[download]

I'm looking for comments on how to avoid/minimize the global declarations.

UPDATE 2: Removed recursion, and track "prev" menu better.

UPDATE 3: Improved "header" of options per O.P, and consolidated globals into one @stack.

G'day NetWallah,

"I'm looking for comments on how to avoid/minimize the global declarations."

I haven't tested your code, nor delved into your logic; however, in response to that specific request for comments, this type of structure may do what you want:

{
    my $actionFlag = 'NONE';
    my $Options = build_options(\$actionFlag);
    my $stack = [[ 'Options', $Options ]];

    while ($actionFlag ne 'EXIT') {
        ...
            pop @$stack if @$stack > 1;
        ...
        Display_Options_and_Get_Response($stack);
    }
}

sub Display_Options_and_Get_Response {
    my $stack = shift;
    my ($header, $opt) = @{$stack->[-1]}[0, 1];
    ...
        push @$stack, [ ... ];
    ...
}

sub build_options {
    my $action_flag_ref = shift;

    return [
        ...
            sub { ... $$action_flag_ref = 'EXIT' }
        ...
    ];
}
[download]

— Ken

Good day! This piece of advice will not be of immediate use with the task at hand. However, it has some relevance to the problem you are trying to solve, and might help you in future, should you find yourself writing more Perl code.

I would point you to the wonderful book "Higher-Order Perl", which describes concept of dispatch tables. The book is available for free on the web.

• https://hop.perl.plover.com/book/
• https://hop.perl.plover.com/book/pdf/02DispatchTables.pdf

I would recommend the book to your attention, in case you are interested in advancing your Perl programming skills for the long term.

G'day Narbawlz,

Welcome to the Monastery.

"Im trying to write a menu driven Perl script ..."

This topic has been discussed in some detail just this week. See "help with user selected hash operations?" for an abundance of ideas.