1package Term::Menus; 2 3# Menus.pm 4# 5# Copyright (C) 2000-2018 6# 7# by Brian M. Kelly. <Brian.Kelly@fullautosoftware.net> 8# 9# You may distribute under the terms of the GNU Affero General 10# Public License, as specified in the LICENSE file. 11# <http://www.gnu.org/licenses/agpl.html>. 12# 13# http://www.fullautosoftware.net/ 14 15## See user documentation at the end of this file. Search for =head 16 17 18our $VERSION = '3.024'; 19 20 21use 5.006; 22 23my $menu_return_debug=0; 24 25use strict; 26use warnings; 27## Module export. 28require Exporter; 29our @ISA = qw(Exporter); 30use vars qw(@EXPORT @EXPORT_OK %term_input %test %Dump %tosspass %b 31 %blanklines %parent_menu %Hosts %fa_code %canload %setsid 32 %VERSION %SetTerminalSize %SetControlChars %find_Selected 33 %clearpath %noclear %ReadKey %local_hostname %BEGIN %ISA 34 %editor %__ANON__ %data_dump_streamer %ReadMode %filechk 35 %fa_conf %transform_pmsi %termwidth %a %tm_menu %fa_code 36 %DumpVars %DumpLex %fullauto %delete_Selected %timeout 37 %pick %termheight %EXPORT_OK %ReadLine %fa_login %Menu 38 %fa_host %fa_menu %abs_path $fa_code %log %FH %AUTOLOAD 39 %get_all_hosts %hostname %GetSpeed %get_subs_from_menu 40 %passwd_file_loc %run_sub %GetTerminalSize %escape_quotes 41 %GetControlChars %numerically %rawInput %transform_sicm 42 %return_result $MenuMap %get_Menu_map_count %MenuMap %facall 43 %get_Menu_map %check_for_dupe_menus %EXPORT_FAIL %EXPORT 44 %import $new_user_flag %new_user_flag %DB_ENV_DSYNC_LOG 45 %DB_LOCK_PUT %DB_ST_IS_RECNO &DB_JOINENV %DB_LOCK_INHERIT 46 %DB_VERB_REP_SYSTEM %DB_VERSION_MISMATCH %DB_ENV_STANDALONE 47 %DB_LOG_VERIFY_ERR %DB_EVENT_REG_ALIVE %DB_XA_CREATE 48 %DB_VERB_REP_ELECT %DB_REP_JOIN_FAILURE %DB_DELIMITER 49 %DB_ENV_TXN %DB_ENV_RPCCLIENT %DB_MPOOL_CLEAN %DB_BTREEOLDVER 50 %DB_TEMPORARY %DB_REPMGR_ACKS_ONE %DB_OLD_VERSION %padwalker 51 %DB_TEST_POSTLOGMETA %DB_SET_RECNO %DB_SA_UNKNOWNKEY 52 %DB_MAX_RECORDS %DB_LOCK_CONFLICT %DB_REP_NEWMASTER %banner 53 %DB_LOCK_FREE_LOCKER %DB_POSITIONI %DB_VERB_FILEOPS 54 %DB_LOCK_DEFAULT %DB_REP_ANYWHERE %DB_REPMGR_CONF_2SITE_STRICT 55 %DB_AUTO_COMMIT %DB_TXN_NOWAIT %DB_STAT_LOCK_PARAMS %pw 56 %DB_REP_CONF_NOWAIT %DB_OK_RECNO %DB_SEQ_WRAPPED %test_hashref 57 %DB_MUTEX_LOCKED %DB_BEFORE %DB_EVENT_REP_MASTER_FAILURE 58 %DB_QUEUE %DB_TXN_LOCK_OPTIMISTIC %DB_REP_UNAVAIL %eval_error 59 %DB_FOREIGN_CASCADE %DB_NOOVERWRITE %DB_REP_CONF_AUTOINIT 60 %LOGREC_OP %DB_RUNRECOVERY %DB_UNREF %DB_REPMGR_ISPEER 61 %DB_VERIFY_BAD %DB_STAT_NOERROR %DB_ENV_LOG_AUTOREMOVE 62 %DB_REP_PAGELOCKED %DB_ST_RECNUM %DB_ORDERCHKONLY %DB_JOINENV 63 %DB_PRIORITY_VERY_LOW %DB_BTREEMAGIC %DB_LOCK_NOTHELD 64 %DB_QAMOLDVER %DB_TEST_POSTSYNC %DB_LOG_AUTO_REMOVE 65 %DB_BTREEVERSION %DB_GET_BOTHC %DB_ENV_RPCCLIENT_GIVEN 66 %DB_CREATE %DB_ARCH_DATA %DB_VERB_WAITSFOR %DB_INIT_REP 67 %DB_ENV_RECOVER_FATAL %DB_LOCK_GET_TIMEOUT %DB_STAT_CLEAR 68 %DB_REP_FULL_ELECTION %DB_VERB_REP_LEASE %DB_REGISTERED 69 %DB_APPLY_LOGREG %DB_REP_HANDLE_DEAD %DB_NOORDERCHK 70 %DB_HEAP_RID_SZ %DB_VERIFY_PARTITION %DB_THREADID_STRLEN 71 %DB_FIRST %DB_REPMGR_CONF_ELECTIONS %DB_SEQ_DEC 72 %DB_REP_CONF_INMEM %DB_MUTEX_ALLOCATED %DB_JOIN_ITEM 73 %DB_REP_CONF_NOAUTOINIT %DB_REPMGR_DISCONNECTED 74 %DB_DUPSORT %DB_TXN_POPENFILES %DB_LOCK_RW_N 75 %DB_TXN_NOT_DURABLE %DB_LOCK_NORUN %DB_REP_CONF_BULK 76 %DB_STAT_SUBSYSTEM %DB_USERCOPY_GETDATA %DB_LOCK_TRADE 77 %DB_COMMIT %DB_LOG_AUTOREMOVE %DB_MPOOL_TRY %DB_WRITEOPEN 78 %DB_STAT_LOCK_CONF %DB_CLIENT %DB_ENV_TIME_NOTGRANTED 79 %DB_REPFLAGS_MASK %DB_ENV_NOPANIC %DB_DUPCURSOR 80 %DB_ENV_APPINIT %DB_LOGFILEID_INVALID %DB_LOCKMAGIC 81 %DB_STAT_MEMP_HASH %DB_REP_FULL_ELECTION_TIMEOUT 82 %DB_TXN_CKP %DB_QAMVERSION %DB_EVENT_REP_CLIENT 83 %DB_NOCOPY %DB_TXNVERSION %LOGREC_PGLIST %DB_RENAMEMAGIC 84 %DB_REP_DUPMASTER %DB_OPEN_CALLED %DB_PAGE_NOTFOUND 85 %DB_VERB_DEADLOCK %DB_TXN_FORWARD_ROLL %DB_MULTIVERSION 86 %DB_LOCK_TIMEOUT %DB_JOIN_NOSORT %DB_NEEDSPLIT 87 %DB_SET_TXN_NOW %DB_TXN_OPENFILES %DB_TEST_POSTOPEN 88 %DB_RECORD_LOCK %DB_TEST_PREOPEN %DB_RPC_SERVERVERS 89 %DB_PRINTABLE %DB_VERB_REPLICATION %DB_MULTIPLE 90 %DB_COMPACT_FLAGS %DB_KEYEXIST %DB_PRIORITY_VERY_HIGH 91 %DB_NOERROR %DB_VERSION_RELEASE %DB_USE_ENVIRON 92 %DB_LOG_VERIFY_DBFILE %DB_TEST_ELECTSEND %DB_TXN_REDO 93 %DB_DURABLE_UNKNOWN %DB_ARCH_LOG %DB_QAMMAGIC 94 %DB_TIMEOUT %DB_VERB_REPMGR_MISC %DB_REP_PAGEDONE 95 %DB_LOCK_PUT_OBJ %DB_VERSION_FAMILY %DB_OK_BTREE 96 %DB_MAX_PAGES %DB_RDONLY %DB_CACHED_COUNTS 97 %DB_CKP_INTERNAL %DB_LOG_IN_MEMORY %DB_LOCK_GET 98 %DB_AGGRESSIVE %DB_STAT_LOCK_LOCKERS %DB_LOCKVERSION 99 %DB_PRIORITY_DEFAULT %DB_ENV_REP_MASTER %DB_FAILCHK 100 %DB_ENV_LOG_INMEMORY %DB_LOG_VERIFY_FORWARD 101 %DB_LOG_VERIFY_WARNING %DB_IGNORE_LEASE %DB_BACKUP_CLEAN 102 %DB_ENV_DBLOCAL %DB_GET_BOTH_RANGE %DB_FOREIGN_ABORT 103 %DB_REP_PERMANENT %DB_MPOOL_NOFILE %DB_LOG_BUFFER_FULL 104 %DB_ENV_MULTIVERSION %DB_RPC_SERVERPROG %DB_MPOOL_DIRTY 105 %DB_REP_NOBUFFER %DB_USE_ENVIRON_ROOT %DB_LOCK_CHECK 106 %DB_PREV_NODUP %DB_ST_TOPLEVEL %DB_PAGEYIELD %DB_EXCL 107 %DB_UPGRADE %DB_INORDER %DB_YIELDCPU %DB_ENV_DSYNC_DB 108 %DB_REP_ELECTION %DB_LOCK_RIW_N %DB_PAGE_LOCK 109 %DB_TXN_SYNC %DB_ST_DUPSORT %DB_LOG_SILENT_ERR 110 %DB_MPOOL_UNLINK %LOGREC_PGDBT %DB_DIRECT %DB_CHKSUM 111 %DB_ENV_OVERWRITE %DB_TXN_LOG_UNDO %DB_INIT_TXN 112 %DB_REP_CHECKPOINT_DELAY %DB_TEST_ELECTVOTE2 113 %DB_TEST_ELECTINIT %DB_EID_BROADCAST %DB_DELETED 114 %DB_REPMGR_ACKS_QUORUM %DB_ENV_LOCKDOWN 115 %DB_MUTEXDEBUG %DB_FREE_SPACE %DB_VERB_REGISTER 116 %DB_MPOOL_EDIT %DB_NORECURSE %DB_TEST_ELECTVOTE1 117 %DB_PRIORITY_LOW %DB_EVENT_REP_PERM_FAILED 118 %DB_SET_RANGE %DB_FORCE %LOGREC_LOCKS %DB_RENUMBER 119 %DB_REP_CONNECTION_RETRY %DB_MPOOL_PRIVATE 120 %DB_SEQUENCE_OLDVER %DB_LOG_CHKPNT %DB_FREELIST_ONLY 121 %DB_VERB_REP_MISC %DB_ENV_REGION_INIT %DB_RENUMBER 122 %DB_TXN_BACKWARD_ROLL %DB_LOCK_ABORT %DB_LOG_RESEND 123 %DB_ENV_REF_COUNTED %DB_DONOTINDEX %DB_NOMMAP 124 %DB_LOCK_UPGRADE %DB_REP_STARTUPDONE %DB_NEXT_DUP 125 %DB_ENV_OPEN_CALLED %DB_LOGVERSION_LATCHING 126 %DB_REP_ELECTION_RETRY %DB_VERB_REP_TEST 127 %DB_VERB_REP_MSGS %DB_debug_FLAG %DB_LOG_DSYNC 128 %DB_DSYNC_LOG %DB_GET_BOTH_LTE %DB_TXN_LOG_VERIFY 129 %DB_LOCK_RANDOM %DB_KEYEMPTY %DB_DIRECT_LOG 130 %DB_LOG_ZERO %DB_ENV_REP_LOGSONLY %DB_NOSYNC 131 %DB_LOG_VERIFY_INTERR %DB_SHALLOW_DUP %DB_SET 132 %DB_LOCK_SET_TIMEOUT %DB_UPDATE_SECONDARY 133 %DB_THREAD %DB_USERCOPY_SETDATA %DB_ASSOC_CREATE 134 %DB_MUTEXLOCKS %DB_LOGOLDVER %DB_TXN_LOCK_MASK 135 %DB_REGION_NAME %DB_NOLOCKING %DB_MPOOL_CREATE 136 %DB_INIT_MPOOL %DB_CURLSN %DB_LOG_PERM %DB_WRITELOCK 137 %DB_ENV_FAILCHK %DB_EVENT_REP_NEWMASTER 138 %DB_JAVA_CALLBACK %DB_OVERWRITE_DUP %DB_RPCCLIENT 139 %DB_ENV_CREATE %DB_ENV_THREAD %DB_PR_HEADERS 140 %DB_TXN_APPLY %DB_WRITELOCK %DB_VRFY_FLAGMASK 141 %DB_REP_LOCKOUT %DB_EVENT_NOT_HANDLED %DB_NEXT 142 %DB_TIME_NOTGRANTED %DB_LOG_INMEMORY %LOGREC_Done 143 %DB_LOG_DIRECT %DB_ALREADY_ABORTED %DB_INCOMPLETE 144 %DB_MUTEX_LOGICAL_LOCK %DB_TXN_LOG_MASK %DB_PREV 145 %DB_STAT_MEMP_NOERROR %DB_CL_WRITER %DB_DSYNC_DB 146 %DB_ENV_TXN_NOWAIT %DB_REGISTER %DB_ODDFILESIZE 147 %DB_FAST_STAT %DB_LOG_NOT_DURABLE %DB_CDB_ALLDB 148 %DB_LOG_NOCOPY %DB_INIT_CDB %DB_RECORDCOUNT 149 %LOGREC_DATA %DB_NEXT_DUP %DB_SET_LOCK_TIMEOUT 150 %DB_PERMANENT %DB_TXN_LOG_REDO %DB_CHECKPOINT 151 %DB_ENV_CDB_ALLDB %DB_EVENT_REP_JOIN_FAILURE 152 %DB_LOG_VERIFY_VERBOSE %DB_LOGCHKSUM %DB_BTREE 153 %DB_LOG_VERIFY_PARTIAL %DB_KEYFIRST %DB_EXTENT 154 %DB_TXN_SNAPSHOT %DB_REP_ISPERM %DB_NOPANIC 155 %DB_LOCK_UPGRADE_WRITE %DB_FOREIGN_CONFLICT 156 %DB_MPOOL_NEW %DB_TXN_UNDO %DB_REGION_MAGIC 157 %DB_PRIORITY_HIGH %DB_ENV_DIRECT_DB %LOGREC_HDR 158 %DB_RECOVER_FATAL %DB_LOCK_REMOVE %DB_LOGVERSION 159 %DB_GID_SIZE %DB_PRIORITY_UNCHANGED %LOGREC_HDR 160 %DB_LOGC_BUF_SIZE %DB_REVSPLITOFF %DB_LOCK_NOWAIT 161 %DB_SEQUENTIAL %DB_REGION_ANON %DB_ENV_NOMMAP 162 %DB_SEQUENCE_VERSION %DB_SYSTEM_MEM %DB_AFTER 163 %DB_REP_ELECTION_TIMEOUT %DB_STAT_ALL %DB_APPEND 164 %DB_HASHVERSION %DB_LOCK_OLDEST %DB_XIDDATASIZE 165 %DB_VERIFY_FATAL %DB_ASSOC_IMMUTABLE_KEY 166 %DB_SEQ_RANGE_SET %DB_REGION_INIT %DB_RECOVER 167 %DB_LOCK_MAXLOCKS %DB_REP_CONF_DELAYCLIENT 168 %DB_EVENT_REP_ELECTION_FAILED %DB_ENV_YIELDCPU 169 %DB_OK_QUEUE %DB_MULTIPLE_KEY %DB_DIRECT_DB 170 %DB_LOCK_DUMP %DB_TEST_PREDESTROY %DB_ENCRYPT 171 %DB_EID_INVALID %DB_LOCK_MINLOCKS %LOGREC_TIME 172 %LOGREC_DBOP %DB_ENV_REP_CLIENT %DB_SPARE_FLAG 173 %DB_TXNMAGIC %DB_LOCK_NOTEXIST %DB_REP_REREQUEST 174 %DB_VERB_REP_SYNC %DB_NO_AUTO_COMMIT %DB_PR_PAGE 175 %DB_EVENT_REP_DUPMASTER %DB_GET_BOTH %DB_HASH 176 %DB_TXN_BULK %DB_TEST_POSTLOG %DB_REP_LOGSONLY 177 %DB_ENV_TXN_NOT_DURABLE %DB_POSITION %DB_RECNUM 178 %DB_LOCKDOWN %DB_LOG_NO_DATA %DB_ST_DUPSET 179 %DB_REP_HEARTBEAT_SEND %DB_SET_TXN_TIMEOUT 180 %DB_REPMGR_ACKS_ALL_PEERS %DB_TEST_ELECTWAIT2 181 %DB_ENV_DATABASE_LOCKING %DB_GET_RECNO 182 %DB_ARCH_REMOVE %DB_LOCK_RECORD %DB_EVENT_PANIC 183 %DB_LOG_LOCKED %DB_LOCK_NOTGRANTED %DB_RMW 184 %DB_ENV_AUTO_COMMIT %DB_NEXT_NODUP %DB_SEQ_WRAP 185 %DB_LOCK_PUT_READ %DB_REP_ACK_TIMEOUT 186 %DB_VERB_CHKPOINT %DB_LOG_DISK %DB_HASHMAGIC 187 %DB_HASHOLDVER %DB_OK_HASH %DB_REP_NEWSITE 188 %DB_TEST_POSTRENAME %DB_ST_RELEN %DB_TXN_LOCK 189 %DB_NOSERVER_ID %DB_UNKNOWN %DB_ENV_LOGGING 190 %DB_EVENT_NO_SUCH_EVENT %DB_NODUPDATA 191 %DB_BUFFER_SMALL %DB_APP_INIT %DB_TXN_FAMILY 192 %DB_ENV_SYSTEM_MEM %DB_READ_UNCOMMITTED 193 %DB_MPOOL_DISCARD %DB_SNAPSHOT %DB_NOSERVER 194 %DB_REPMGR_CONNECTED %DB_VERSION_FULL_STRING 195 %DB_SWAPBYTES %DB_REP_MASTER %DB_SECONDARY_BAD 196 %DB_TXN_LOCK_2PL %DB_TXN_LOG_UNDOREDO 197 %DB_LOG_WRNOSYNC %DB_ENV_FATAL %DB_TRUNCATE 198 %DB_LOCK_PUT_ALL %DB_MUTEX_SELF_BLOCK 199 %DB_CURSOR_BULK %DB_VERSION_PATCH %DB_ENV_CDB 200 %DB_DATABASE_LOCK %DB_HANDLE_LOCK %DB_SET_LTE 201 %DB_LOG_VERIFY_BAD %DB_OPFLAGS_MASK %DB_PAD 202 %DB_SET_REG_TIMEOUT %DB_REP_BULKOVF 203 %DB_REP_CONF_LEASE %DB_INIT_LOCK %DB_NOTFOUND 204 %DB_TXN_PRINT %DB_INIT_LOG %DB_TEST_SUBDB_LOCKS 205 %DB_ARCH_ABS %DB_ST_DUPOK %DB_REP_IGNORE 206 %DB_REPMGR_PEER %DB_REPMGR_ACKS_NONE %LOGREC_DBT 207 %DB_WRNOSYNC %DB_VERSION_STRING %DB_ST_OVFL_LEAF 208 %DB_ENV_TXN_NOSYNC %DB_SA_SKIPFIRSTKEY %DB_FLUSH 209 %DB_REP_EGENCHG %DB_MPOOL_NEW_GROUP %DB_LOGMAGIC 210 %LOGREC_PGDDBT %DB_MPOOL_FREE %DB_READ_COMMITTED 211 %DB_ENV_NOLOCKING %DB_EVENT_REG_PANIC 212 %DB_TXN_NOSYNC %DB_CONSUME_WAIT %DB_CURRENT 213 %DB_REPMGR_ACKS_ALL %DB_REP_NOTPERM %DB_DEGREE_2 214 %LOGREC_POINTER %DB_REP_OUTDATED %DB_RDWRMASTER 215 %DB_ENV_USER_ALLOC %DB_CURSOR_TRANSIENT 216 %DB_FOREIGN_NULLIFY %DB_LOCK_SWITCH %DB_VERIFY 217 %DB_EVENT_REP_MASTER %DB_DIRTY_READ %LOGREC_DB 218 %DB_MPOOL_LAST %DB_CONSUME %DB_KEYLAST 219 %DB_LOCK_MINWRITE %DB_REP_HEARTBEAT_MONITOR 220 %DB_LOG_COMMIT %DB_VERB_RECOVERY %DB_TXN_WAIT 221 %DB_EVENT_REP_ELECTED %DB_FILE_ID_LEN 222 %DB_TEST_ELECTWAIT1 %DB_LOCK_EXPIRE %DB_LAST 223 %DB_DATABASE_LOCKING %DB_FCNTL_LOCKING 224 %DB_TXN_WRITE_NOSYNC %DB_ENV_NO_OUTPUT_SET 225 %DB_user_BEGIN %DB_EVENT_WRITE_FAILED 226 %DB_MPOOL_NOLOCK %DB_VERSION_MINOR %transform_mbii 227 %DB_REP_CREATE %DB_REP_DEFAULT_PRIORITY 228 %DB_REP_LEASE_TIMEOUT %DB_REP_CLIENT 229 %DB_TXN_LOCK_OPTIMIST %DB_LOCK_DEADLOCK 230 %DB_ENCRYPT_AES %DB_LOCK_MAXWRITE %DB_GETREC 231 %DB_MUTEX_THREAD %DB_ENV_PRIVATE %DB_PREV_DUP 232 %DB_TEST_PRERENAME %DB_PR_RECOVERYTEST 233 %DB_MPOOL_EXTENT %DB_FILEOPEN %DB_SALVAGE 234 %DB_CXX_NO_EXCEPTIONS %DB_LOCK_YOUNGEST 235 %DB_VERB_REPMGR_CONNFAIL %DB_REP_LOGREADY 236 %DB_ENV_TXN_WRITE_NOSYNC %DB_ENV_LOCKING 237 %DB_IMMUTABLE_KEY %DB_MUTEX_SHARED %DB_HEAP 238 %DB_CHKSUM_SHA1 %DB_ENV_TXN_SNAPSHOT 239 %DB_VERSION_MAJOR %DB_ENV_HOTBACKUP %transform_mbio 240 %DB_TEST_POSTDESTROY %DB_FORCESYNC %DB_DUP 241 %DB_NOSERVER_HOME %DB_SEQ_INC %DB_FIXEDLEN 242 %DB_LOG_VERIFY_CAF %DB_TXN_TOKEN_SIZE 243 %DB_VERB_FILEOPS_ALL %LOGREC_ARG %DB_RECNO 244 %DB_REP_LEASE_EXPIRED %DB_HOTBACKUP_IN_PROGRESS 245 %DB_ENV_DIRECT_LOG %DB_REPMGR_ACKS_ALL_AVAILABLE 246 %DB_WRITECURSOR %DB_STAT_LOCK_OBJECTS 247 %DB_TEST_RECYCLE %DB_TXN_ABORT %DB_PRIVATE 248 %DB_PANIC_ENVIRONMENT %DB_OVERWRITE 249 %DB_EVENT_REP_STARTUPDONE %DB_SURPRISE_KID 250 %DB_REPMGR_ACKS_ONE_PEER %DB_REP_HOLDELECTION 251 %DB_EVENT_REP_SITE_ADDED %DB_EVENT_REP_INIT_DONE 252 %DB_MEM_THREAD %DB_EVENT_REP_CONNECT_ESTD 253 %DB_ENV_NOFLUSH %DB_EVENT_REP_LOCAL_SITE_REMOVED 254 %DB_LEGACY %DB_GROUP_CREATOR %DB_EID_MASTER 255 %DB_HEAPVERSION %DB_OK_HEAP %DB_MEM_TRANSACTION 256 %DB_EVENT_REP_CONNECT_TRY_FAILED %DB_NOFLUSH 257 %DB_STAT_SUMMARY %DB_MEM_TRANSACTION %CARP_NOT 258 %DB_HEAPMAGIC %DB_REPMGR_NEED_RESPONSE 259 %DB_MEM_LOCKOBJECT %DB_MEM_LOGID %DB_MEM_LOCKER 260 %DB_INTERNAL_DB %DB_MEM_LOCK %DB_HEAPOLDVER 261 %DB_FAILCHK_ISALIVE %DB_BOOTSTRAP_HELPER 262 %DB_HEAP_FULL %DB_STAT_ALLOC %DB_LOCAL_SITE 263 %DB_NO_CHECKPOINT %DB_EVENT_REP_SITE_REMOVED 264 %DB_EVENT_REP_CONNECT_BROKEN %DB_INIT_MUTEX 265 %DB_VERB_BACKUP %DB_INTERNAL_PERSISTENT_DB 266 %DB_REP_CONF_AUTOROLLBACK %DB2_AM_INTEXCL 267 %DB2_AM_EXCL %DB_INTERNAL_TEMPORARY_DB 268 %DB_BACKUP_UPDATE %DB2_AM_NOWAIT %DB_BACKUP_SIZE 269 %DB_BACKUP_FILES %DB_BACKUP_WRITE_DIRECT 270 %DB_EVENT_REP_WOULD_ROLLBACK &DB_BACKUP_CLEAN 271 %DB_BACKUP_READ_COUNT %DB_BACKUP_SINGLE_DIR 272 %DB_LOCK_IGNORE_REC %DB_BACKUP_READ_SLEEP 273 %DB_BACKUP_NO_LOGS %DB_REP_WOULDROLLBACK 274 %DB_STREAM_WRITE %DB_REP_CONF_ELECT_LOGLENGTH 275 %list_module %DB_STREAM_READ %DB_LOG_BLOB 276 %DB_STREAM_SYNC_WRITE %DB_CHKSUM_FAIL 277 %DB_EVENT_REP_AUTOTAKEOVER_FAILED %DB_VERB_MVCC 278 %DB_REPMGR_ISVIEW %DB_MUTEX_PROCESS_ONLY 279 %transform_mbir %DB_EVENT_REP_INQUEUE_FULL 280 %DB_MUTEX_DESCRIBE_STRLEN %DB_FAILURE_SYMPTOM_SIZE 281 %DB_LOG_NOSYNC %DB_REPMGR_CONF_PREFMAS_CLIENT 282 %DB_SET_MUTEX_FAILCHK_TIMEOUT %DB_INTERNAL_BLOB_DB 283 %DB_EVENT_FAILCHK_PANIC %DB_EXIT_FAILCHK 284 %LOGREC_LONGARG %DB_EVENT_MUTEX_DIED 285 %DB_MUTEX_OWNER_DEAD %DB_STREAM_WRITE 286 %DB_REPMGR_CONF_PREFMAS_MASTER %DB_EXIT_FILE_EXISTS 287 %DB_MEM_EXTFILE_DATABASE %DB_EVENT_REP_AUTOTAKEOVER 288 %DB_FORCESYNCENV %SELECT %DB_REPMGR_CONF_FORWARD_WRITES 289 %DB_REPMGR_CONF_ENABLE_EPOLL %DB2_AM_MPOOL_OPENED 290 %DB_REP_WRITE_FORWARD_TIMEOUT %DB_META_CHKSUM_FAIL 291 %DB_MEM_REP_SITE %DB_LOG_EXT_FILE %DB_OFF_T_MAX 292 %DB_REPMGR_ISELECTABLE %DB_SLICE_CORRUPT 293 %DB_VERB_SLICE %DB_REPMGR_CONF_DISABLE_POLL 294 %DB_TXN_DISPATCH %DB_CONVERT %EPOLL %POLL 295 %DB_SYSTEM_MEM_MISSING %DB_REP_INELECT %DB_SLICED 296 %DB_REGION_MAGIC_RECOVER %DB_NOINTMP %HAVE_EPOLL 297 %DB_MEM_DATABASE %DB_MEM_DATABASE_LENGTH); 298 299@EXPORT = qw(pick Menu get_Menu_map); 300 301##################################################################### 302#### ### 303#### DEFAULT MODULE OF Term::Menus $tm_menu IS: ### 304#### ### 305#### ==> *NONE* <== If you want a different ### 306#### ### 307#### module to be the default, change $tm_menu variable below or ### 308#### set the $tm_menu variable in the BEGIN { } block ### 309#### of the top level script invoking &Menu(). (Advised) ### 310#### ### 311##################################################################### 312 313our $tm_menu=''; 314 315 # Example: our $tm_menu='my_menus.pm'; ### 316 ### 317 # See documentation for more info ### 318 ### 319 ################################################################# 320 321use Config (); 322use Cwd 'abs_path'; 323use Capture::Tiny; 324BEGIN { 325 our $filechk = sub { 326 package filechk; 327 eval { die }; 328 my $path=$@; 329 $path=~s/Died at (.*)Term\/Menus.pm.*$/$1/s; 330 chomp($path); 331 return 0 unless -e "$path$_[0]"; 332 return 1; 333 }; 334 our $canload = sub { 335 package canloadone; 336 eval { die }; 337 my $path=$@; 338 $path=~s/Died at (.*)Term\/Menus.pm.*$/$1/s; 339 chomp($path); 340 return 0 unless -e "$path$_[0]"; 341 eval { require $_[0] }; 342 unless ($@) { 343 return 1; 344 } else { 345 return 0; 346 } 347 }; 348} 349 350unless (defined caller(2) && -1<index caller(2),'FullAuto') { 351 352 ### NOTE: $tm_menu will *NOT* be used when Term::Menus 353 ### is used with Net::FullAuto. Set $fa_menu (below) 354 ### or $main::fa_menu when using Net::FullAuto. 355 356 if ($tm_menu) { 357 unless ($Term::Menus::canload->($tm_menu)) { 358 my $die="\n FATAL ERROR: The variable \$tm_menu is defined,\n". 359 " in the module file:\n\n". 360 " $INC{'Term/Menus.pm'}\n\n". 361 " but the value: $tm_menu does not\n". 362 " reference a module that can be loaded"; 363 die $die; 364 } 365 } elsif (defined $main::tm_menu) { 366 if ($Term::Menus::canload->($main::tm_menu)) { 367 $tm_menu=$main::tm_menu; 368 } else { 369 my $die="\n FATAL ERROR: The variable \$tm_menu is defined,\n". 370 " but the value: $tm_menu does not\n". 371 " reference a module that can be loaded"; 372 die $die; 373 } 374 } 375 if ($tm_menu) { 376 require $tm_menu; 377 my $tm=substr($tm_menu, 378 (rindex $tm_menu,'/')+1,-3); 379 import $tm; 380 } 381 382} 383 384############################################################## 385############################################################## 386# 387# THIS BLOCK MARKED BY TWO LINES OF POUND SYMBOLS IS FOR 388# SETTINGS NEEDED BY THE MODULE Net::FullAuto. IF YOU ARE 389# USING Term::Menus OUTSIDE OF Net::FullAuto, YOU CAN 390# SAFELY IGNORE THIS SECTION. (That's 'ignore' - not 'remove') 391# 392 393our $data_dump_streamer=0; 394eval { require Data::Dump::Streamer }; 395unless ($@) { 396 $data_dump_streamer=1; 397 import Data::Dump::Streamer; 398} 399 400#our $io_interactive=0; 401#eval { require IO::Interactive }; 402#unless ($@) { 403# $io_interactive=1; 404# import IO::Interactive; 405#} 406 407BEGIN { ## Begin Net::FullAuto Settings 408 409 eval { require Data::Dump::Streamer }; 410 unless ($@) { 411 $data_dump_streamer=1; 412 import Data::Dump::Streamer; 413 } 414 unless (exists $INC{'Term/Menus.pm'}) { 415 foreach my $fpath (@INC) { 416 my $f=$fpath; 417 if (-e $f.'/Term/Menus.pm') { 418 $INC{'Term/Menus.pm'}=$f.'/Term/Menus.pm'; 419 last; 420 } 421 } 422 } 423 my $vlin=__LINE__; 424 ##################################################################### 425 #### ### 426 #### DEFAULT MODULE OF Net::FullAuto $fa_code IS: ### 427 #### ### 428 #### ==> Distro/fa_code_demo.pm <== If you want a different ### 429 #### ### 430 #### module to be the default, change $fa_code variable below or ### 431 #### set the $fa_code variable in the BEGIN { } block ### 432 #### of the top level script invoking Net::FullAuto. (Advised) ### 433 #### ### 434 ##################################################################### 435 ### 436 our $fa_code=['Distro/fa_code_demo.pm', #<== Change Location Here ### 437 "From $INC{'Term/Menus.pm'}, Line: ".($vlin+13)]; ### 438 ### 439 ##################################################################### 440 441 ##################################################################### 442 #### ### 443 #### DEFAULT MODULE OF Net::FullAuto $fa_conf IS: ### 444 #### ### 445 #### ==> Distro/fa_conf.pm <== If you want a differnet ### 446 #### ### 447 #### module to be the default, change $fa_conf variable below or ### 448 #### set the $fa_conf variable in the BEGIN { } block ### 449 #### of the top level script invoking Net::FullAuto. (Advised) ### 450 #### ### 451 ##################################################################### 452 ### 453 our $fa_conf=['Distro/fa_conf.pm', #<== Change Location Here ### 454 "From $INC{'Term/Menus.pm'}, Line: ".($vlin+30)]; ### 455 ### 456 ##################################################################### 457 458 ##################################################################### 459 #### ### 460 #### DEFAULT MODULE OF Net::FullAuto $fa_host IS: ### 461 #### ### 462 #### ==> Distro/fa_host.pm <== If you want a different ### 463 #### ### 464 #### module to be the default, change $fa_host variable below or ### 465 #### set the $fa_hosts_config variable in the BEGIN { } block ### 466 #### of the top level script invoking Net::FullAuto. (Advised) ### 467 #### ### 468 ##################################################################### 469 ### 470 our $fa_host=['Distro/fa_host.pm', #<== Change Location Here ### 471 "From $INC{'Term/Menus.pm'}, Line: ".($vlin+47)]; ### 472 ### 473 ##################################################################### 474 475 ##################################################################### 476 #### ### 477 #### DEFAULT MODULE OF Net::FullAuto $fa_menu IS: ### 478 #### ### 479 #### ==> Distro/fa_menu_demo.pm <== If you want a different ### 480 #### ### 481 #### module to be the default, change $fa_menu variable below or ### 482 #### set the $fa_menu variable in the BEGIN { } block ### 483 #### of the top level script invoking Net::FullAuto. (Advised) ### 484 #### ### 485 ##################################################################### 486 ### 487 our $fa_menu=['Distro/fa_menu_demo.pm', #<== Change Location Here ### 488 "From $INC{'Term/Menus.pm'}, Line ".($vlin+81)]; ### 489 ### 490 ##################################################################### 491 492 our $fullauto=0;$new_user_flag=1; 493 if (defined caller(2) && -1<index caller(2),'FullAuto') { 494 $fullauto=1; 495 my $default_modules=''; 496 unless ($main::fa_code && $main::fa_conf && $main::fa_host 497 && $main::fa_menu) { 498 unless (exists $INC{'Net/FullAuto.pm'}) { 499 foreach my $fpath (@INC) { 500 my $f=$fpath; 501 if (-e $f.'/Net/FullAuto.pm') { 502 $INC{'Net/FullAuto.pm'}=$f.'/Net/FullAuto.pm'; 503 last; 504 } 505 } 506 } 507 my $fa_path=$INC{'Net/FullAuto.pm'}; 508 my $progname=substr($0,(rindex $0,'/')+1,-3); 509 substr($fa_path,-3)=''; 510 my $username=getlogin || getpwuid($<); 511 if (-f $fa_path.'/fa_global.pm') { 512 if (-r $fa_path.'/fa_global.pm') { 513 { 514 no strict 'subs'; 515 require $fa_path.'/fa_global.pm'; 516 $fa_global::berkeley_db_path||=''; 517 $fa_global::FA_Sudo||={}; 518 if (exists $fa_global::FA_Sudo->{$username}) { 519 $username=$fa_global::FA_Sudo->{$username}; 520 } 521 if ($fa_global::berkeley_db_path && 522 -d $fa_global::berkeley_db_path.'Defaults') { 523 BEGIN { $Term::Menus::facall=caller(2); 524 $Term::Menus::facall||='' }; 525 use if (-1<index $Term::Menus::facall,'FullAuto'), 526 "BerkeleyDB"; 527 my $dbenv = BerkeleyDB::Env->new( 528 -Home => $fa_global::berkeley_db_path.'Defaults', 529 -Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL 530 ) or die( 531 "cannot open environment for DB: ". 532 $BerkeleyDB::Error."\n",'',''); 533 my $kind=(grep { /^--test$/ } @ARGV)?'test':'prod'; 534 my $bdb = BerkeleyDB::Btree->new( 535 -Filename => "${progname}_${kind}_defaults.db", 536 -Flags => DB_CREATE, 537 -Env => $dbenv 538 ); 539 unless ($BerkeleyDB::Error=~/Successful/) { 540 $bdb = BerkeleyDB::Btree->new( 541 -Filename => "${progname}_${kind}_defaults.db", 542 -Flags => DB_CREATE|DB_RECOVER_FATAL, 543 -Env => $dbenv 544 ); 545 unless ($BerkeleyDB::Error=~/Successful/) { 546 die "Cannot Open DB ${progname}_${kind}_defaults.db:". 547 " $BerkeleyDB::Error\n"; 548 } 549 } 550 if (exists $ENV{'SSH_CONNECTION'} && 551 exists $ENV{'USER'} && ($ENV{'USER'} 552 ne $username)) { 553 $username=$ENV{'USER'}; 554 } elsif ($username eq 'SYSTEM' && 555 exists $ENV{'IWUSER'} && ($ENV{'IWUSER'} 556 ne $username)) { 557 my $login_flag=0; 558 foreach (@ARGV) { 559 my $argv=$_; 560 if ($login_flag) { 561 $username=$argv; 562 last; 563 } elsif (lc($argv) eq '--login') { 564 $login_flag=1; 565 } 566 } 567 $username=$ENV{'IWUSER'} unless $login_flag; 568 } elsif (grep { /--login/ } @ARGV) { 569 my $login_flag=0; 570 foreach (@ARGV) { 571 my $argv=$_; 572 if ($login_flag) { 573 $username=$argv; 574 last; 575 } elsif (lc($argv) eq '--login') { 576 $login_flag=1; 577 } 578 } 579 } 580 my $status=$bdb->db_get( 581 $username,$default_modules) if $bdb; 582 $default_modules||=''; 583 $default_modules=~s/\$HASH\d*\s*=\s*//s 584 if -1<index $default_modules,'$HASH'; 585 $default_modules=eval $default_modules; 586 $default_modules||={}; 587 my $save_defaults_for_user_flag=0; 588 if ($data_dump_streamer) { 589 foreach my $mod (keys %{$default_modules}) { 590 if ($mod eq 'set') { 591 if ($default_modules->{set} ne 'none') { 592 $save_defaults_for_user_flag=1; 593 next; 594 } else { next } 595 } 596 unless ($Term::Menus::filechk->( 597 $default_modules->{$mod})) { 598 delete $default_modules->{$mod}; 599 next; 600 } 601 $save_defaults_for_user_flag=1; 602 } 603 if ($save_defaults_for_user_flag) { 604 my $def_modules=Data::Dump::Streamer::Dump( 605 $default_modules)->Out(); 606 my $status=$bdb->db_put( 607 $username,$def_modules) if $bdb; 608 } else { 609 my $status=$bdb->db_del( 610 $username) if $bdb; 611 } 612 } 613 undef $bdb; 614 $dbenv->close(); 615 undef $dbenv; 616 unless (keys %{$default_modules}) { 617 $default_modules->{'set'}='none'; 618 $default_modules->{'fa_code'}= 619 'Net/FullAuto/Distro/fa_code_demo.pm'; 620 $default_modules->{'fa_conf'}= 621 'Net/FullAuto/Distro/fa_conf.pm'; 622 $default_modules->{'fa_host'}= 623 'Net/FullAuto/Distro/fa_host.pm'; 624 $default_modules->{'fa_menu'}= 625 'Net/FullAuto/Distro/fa_menu_demo.pm'; 626 } elsif (exists $default_modules->{'set'} && 627 $default_modules->{'set'} ne 'none') { 628 $new_user_flag=0; 629 my $setname=$default_modules->{'set'}; 630 my $stenv = BerkeleyDB::Env->new( 631 -Home => $fa_global::berkeley_db_path.'Sets', 632 -Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL 633 ) or die( 634 "cannot open environment for DB: ". 635 $BerkeleyDB::Error."\n",'',''); 636 my $std = BerkeleyDB::Btree->new( 637 -Filename => "${progname}_sets.db", 638 -Flags => DB_CREATE, 639 -Env => $stenv 640 ); 641 unless ($BerkeleyDB::Error=~/Successful/) { 642 $std = BerkeleyDB::Btree->new( 643 -Filename => "${progname}_sets.db", 644 -Flags => DB_CREATE|DB_RECOVER_FATAL, 645 -Env => $stenv 646 ); 647 unless ($BerkeleyDB::Error=~/Successful/) { 648 die "Cannot Open DB ${progname}_sets.db:". 649 " $BerkeleyDB::Error\n"; 650 } 651 } 652 #my $username=getlogin || getpwuid($<); 653 my $set=''; 654 my $status=$std->db_get( 655 $username,$set); 656 $set||=''; 657 $set=~s/\$HASH\d*\s*=\s*//s 658 if -1<index $set,'$HASH'; 659 $set=eval $set; 660 $set||={}; 661 undef $std; 662 $stenv->close(); 663 undef $stenv; 664 $fa_code=[$set->{$setname}->{'fa_code'}, 665 "From Default Set $setname ". 666 "(Change with fa --set)"]; 667 $fa_conf=[$set->{$setname}->{'fa_conf'}, 668 "From Default Set $setname ". 669 "(Change with fa --set)"]; 670 $fa_host=[$set->{$setname}->{'fa_host'}, 671 "From Default Set $setname ". 672 "(Change with fa --set)"]; 673 $fa_menu=[$set->{$setname}->{'fa_menu'}, 674 "From Default Set $setname ". 675 "(Change with fa --set)"]; 676 } else { 677 $new_user_flag=0; 678 if (exists $default_modules->{'fa_code'}) { 679 $fa_code=[$default_modules->{'fa_code'}, 680 "From Default Setting ". 681 "(Change with fa --defaults)"]; 682 } 683 if (exists $default_modules->{'fa_conf'}) { 684 $fa_conf=[$default_modules->{'fa_conf'}, 685 "From Default Setting ". 686 "(Change with fa --defaults)"]; 687 } 688 if (exists $default_modules->{'fa_host'}) { 689 $fa_host=[$default_modules->{'fa_host'}, 690 "From Default Setting ". 691 "(Change with fa --defaults)"]; 692 } 693 if (exists $default_modules->{'fa_menu'}) { 694 $fa_menu=[$default_modules->{'fa_menu'}, 695 "From Default Setting ". 696 "(Change with fa --defaults)"]; 697 } 698 } 699 } 700 } 701 } else { 702 warn("WARNING: Cannot read defaults file $fa_path/fa_global.pm". 703 " - permission denied (Hint: Perhaps you need to 'Run as ". 704 "administrator'?)"); 705 } 706 } 707 my @A=();my %A=(); 708 push @A,@ARGV; 709 my $acnt=0; 710 foreach my $a (@A) { 711 $acnt++; 712 my $aa=$a; 713 if (-1<index $aa,'--fa_') { 714 my $k=unpack('x5a*',$aa); 715 my $v=$A[$acnt]||''; 716 unless (-1<index $v, '--fa_') { 717 $A{$k}=$v; 718 } else { 719 @A=(); 720 last; 721 } 722 } elsif (-1<index $aa,'--set') { 723 my $v=$A[$acnt]||''; 724 unless (-1<index $v, '--') { 725 $A{set}=$v; 726 } else { 727 @A=(); 728 last; 729 } 730 } 731 } 732 foreach my $e (('set','code','conf','host','maps','menu')) { 733 if (exists $A{$e}) { 734 $new_user_flag=0; 735 if ($e eq 'set') { 736 no strict 'subs'; 737 my $setname=$A{$e}; 738 my $fa_path=$INC{'Net/FullAuto.pm'}; 739 my $progname=substr($0,(rindex $0,'/')+1,-3); 740 substr($fa_path,-3)=''; 741 if (-f $fa_path.'/fa_global.pm') { 742 my $stenv = BerkeleyDB::Env->new( 743 -Home => $fa_global::berkeley_db_path.'Sets', 744 -Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL 745 ) or die( 746 "cannot open environment for DB: ". 747 $BerkeleyDB::Error."\n",'',''); 748 my $std = BerkeleyDB::Btree->new( 749 -Filename => "${progname}_sets.db", 750 -Flags => DB_CREATE, 751 -Env => $stenv 752 ); 753 unless ($BerkeleyDB::Error=~/Successful/) { 754 $std = BerkeleyDB::Btree->new( 755 -Filename => "${progname}_sets.db", 756 -Flags => DB_CREATE|DB_RECOVER_FATAL, 757 -Env => $stenv 758 ); 759 unless ($BerkeleyDB::Error=~/Successful/) { 760 die "Cannot Open DB ${progname}_sets.db:". 761 " $BerkeleyDB::Error\n"; 762 } 763 } 764 #my $username=getlogin || getpwuid($<); 765 my $set=''; 766 my $status=$std->db_get( 767 $username,$set); 768 $set||=''; 769 $set=~s/\$HASH\d*\s*=\s*//s 770 if -1<index $set,'$HASH'; 771 $set=eval $set; 772 $set||={}; 773 undef $std; 774 $stenv->close(); 775 undef $stenv; 776 $fa_code=[$set->{$setname}->{'fa_code'}, 777 "From CMD arg fa --set $setname line ".__LINE__]; 778 $fa_conf=[$set->{$setname}->{'fa_conf'}, 779 "From CMD arg fa --set $setname line ".__LINE__]; 780 $fa_host=[$set->{$setname}->{'fa_host'}, 781 "From CMD arg fa --set $setname line ".__LINE__]; 782 $fa_menu=[$set->{$setname}->{'fa_menu'}, 783 "From CMD arg fa --set $setname line ".__LINE__]; 784 } else { 785 my $die="\n FATAL ERROR: The Set indicated from". 786 " the CMD arg:\n\n". 787 " ==> fa --set $A{$e}n\n". 788 " does not exist. To create this\n". 789 " set, run fa --set without any\n". 790 " other arguments"; 791 die $die; 792 } 793 } elsif ($e eq 'code') { 794 $fa_code=$A{$e}; 795 $fa_code=[$fa_code, 796 "From CMD arg: fa --fa_code $A{$e}"]; 797 } elsif ($e eq 'menu') { 798 $fa_menu=$A{$e}; 799 $fa_menu=[$fa_menu, 800 "From CMD arg: fa --fa_menu $A{$e}"]; 801 } elsif ($e eq 'host') { 802 $fa_host=$A{$e}; 803 $fa_host=[$fa_host, 804 "From CMD arg: fa --fa_host $A{$e}"]; 805 } elsif ($e eq 'conf') { 806 $fa_conf=$A{$e}; 807 $fa_conf=[$fa_conf, 808 "From CMD arg: fa --fa_conf $A{$e}"]; 809 } 810 } 811 my $abspath=abs_path($0); 812 $abspath=~s/\.exe$//; 813 $abspath.='.pl'; 814 if (defined $main::fa_code && $main::fa_code) { 815 $new_user_flag=0; 816 $fa_code=$main::fa_code; 817 my $p=abs_path($0); 818 $fa_code=[$fa_code, 819 "From \$fa_code variable in $abspath"]; 820 } 821 if (defined $main::fa_conf && $main::fa_conf) { 822 $new_user_flag=0; 823 $fa_conf=$main::fa_conf; 824 $fa_conf=[$fa_conf, 825 "From \$fa_conf variable in $abspath"]; 826 } 827 if (defined $main::fa_host && $main::fa_host) { 828 $new_user_flag=0; 829 $fa_host=$main::fa_host; 830 $fa_host=[$fa_host, 831 "From \$fa_host variable in $abspath"]; 832 } 833 if (defined $main::fa_menu && $main::fa_menu) { 834 $new_user_flag=0; 835 $fa_menu=$main::fa_menu; 836 $fa_menu=[$fa_menu, 837 "From \$fa_menu variable in $abspath"]; 838 } 839 } 840 } else { 841 $new_user_flag=0; 842 my $abspath=abs_path($0); 843 $abspath=~s/\.exe$//; 844 $abspath.='.pl'; 845 $fa_code=[$fa_code, 846 "From \$fa_code variable in $abspath"]; 847 $fa_conf=[$fa_conf, 848 "From \$fa_conf variable in $abspath"]; 849 $fa_host=[$fa_host, 850 "From \$fa_host variable in $abspath"]; 851 $fa_menu=[$fa_menu, 852 "From \$fa_menu variable in $abspath"]; 853 } 854 $fa_code->[0]='Net/FullAuto/'.$fa_code->[0] 855 if $fa_code->[0] && -1==index $fa_code->[0],'Net/FullAuto'; 856 $fa_code->[0]||=''; 857 my $argv=join " ",@ARGV; 858 my $rx='^--edi*t* *|^-e[a-z]|^--admin|^-V|^-v|^--VE*R*S*I*O*N*|'. 859 '^--users|^--ve*r*s*i*o*n*|^--cat|^--tutorial|^--figlet'; 860 if (!map { /$rx/ } @ARGV) { 861 if ($fa_code->[0]) { 862 if ($Term::Menus::canload->($fa_code->[0])) { 863 require $fa_code->[0]; 864 my $mod=substr($fa_code->[0],(rindex $fa_code->[0],'/')+1,-3); 865 import $mod; 866 $fa_code=$mod.'.pm'; 867 } else { 868 my $ln=__LINE__; 869 $ln-=5; 870 die "Cannot load module $fa_code->[0]". 871 "\n $fa_code->[1]\n". 872 "\"require $fa_code->[0];\"". 873 "--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n"; 874 } 875 } else { 876 require 'Net/FullAuto/Distro/fa_code.pm'; 877 import fa_code; 878 $fa_code='fa_code.pm'; 879 } 880 } 881 $fa_conf->[0]='Net/FullAuto/'.$fa_conf->[0] 882 if $fa_conf->[0] && -1==index $fa_conf->[0],'Net/FullAuto'; 883 $fa_conf->[0]||=''; 884 if ($argv!~/--edit |^-e[a-z]|--cat /) { 885 if ($fa_conf->[0]) { 886 if ($Term::Menus::canload->($fa_conf->[0])) { 887 require $fa_conf->[0]; 888 my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3); 889 import $mod; 890 $fa_conf=$mod.'.pm'; 891 } else { 892 my $ln=__LINE__; 893 $ln-=5; 894 die "Cannot load module $fa_conf->[0]". 895 "\n $fa_conf->[1]\n". 896 "\"require $fa_conf->[0];\"". 897 "--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n"; 898 } 899 } else { 900 require 'Net/FullAuto/Distro/fa_conf.pm'; 901 import fa_conf; 902 $fa_conf='fa_conf.pm'; 903 } 904 } 905 $fa_host->[0]='Net/FullAuto/'.$fa_host->[0] 906 if $fa_host->[0] && -1==index $fa_host->[0],'Net/FullAuto'; 907 $fa_host->[0]||=''; 908 if ($argv!~/--edit |^-e[a-z]/) { 909 if ($fa_host->[0]) { 910 if ($Term::Menus::canload->($fa_host->[0])) { 911 require $fa_host->[0]; 912 my $mod=substr($fa_host->[0],(rindex $fa_host->[0],'/')+1,-3); 913 import $mod; 914 $fa_host=$mod.'.pm'; 915 } else { 916 my $ln=__LINE__; 917 $ln-=5; 918 die "Cannot load module $fa_host->[0]". 919 "\n $fa_host->[1]\n". 920 "\"require $fa_host->[0];\"". 921 "--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n"; 922 } 923 } else { 924 require 'Net/FullAuto/Distro/fa_host.pm'; 925 import fa_host; 926 $fa_host='fa_host.pm'; 927 } 928 } 929 $fa_menu->[0]='Net/FullAuto/'.$fa_menu->[0] 930 if $fa_menu->[0] && -1==index $fa_menu->[0],'Net/FullAuto'; 931 $fa_menu->[0]||=''; 932 if ($argv!~/--edit |^-e[a-z]/) { 933 if ($fa_menu->[0]) { 934 if ($Term::Menus::canload->($fa_menu->[0])) { 935 require $fa_menu->[0]; 936 my $mod=substr($fa_menu->[0],(rindex $fa_menu->[0],'/')+1,-3); 937 import $mod; 938 $fa_menu=$mod.'.pm'; 939 } else { 940 my $ln=__LINE__; 941 $ln-=5; 942 die "Cannot load module $fa_menu->[0]". 943 "\n $fa_menu->[1]\n". 944 "\"require $fa_menu->[0];\"". 945 "--failed at ".$INC{'Term/Menus.pm'}." line $ln\.\n$@\n"; 946 } 947 } else { 948 require 'Net/FullAuto/Distro/fa_menu_demo.pm'; 949 import fa_menu_demo; 950 $fa_menu='fa_menu_demo.pm'; 951 } 952 } 953 954 } 955 956} 957 958our %email_defaults=(); 959if (%fa_code::email_defaults) { 960 %email_defaults=%fa_code::email_defaults; 961} 962our %email_addresses=(); 963if (%fa_code::email_addresses) { 964 %email_addresses=%fa_code::email_addresses; 965} 966our $passwd_file_loc=''; 967if (defined $fa_code::passwd_file_loc && $fa_code::passwd_file_loc) { 968 $passwd_file_loc=$fa_code::passwd_file_loc; 969} 970our $test=0; 971if (defined $fa_code::test && $fa_code::test) { 972 $test=$fa_code::test; 973} 974our $timeout=30; 975if (defined $fa_code::timeout && $fa_code::timeout) { 976 $timeout=$fa_code::timeout; 977} 978our $log=0; 979if (defined $fa_code::log && $fa_code::log) { 980 $log=$fa_code::log; 981} 982our $tosspass=0; 983if (defined $fa_code::tosspass && $fa_code::tosspass) { 984 $tosspass=$fa_code::tosspass; 985} 986 987## End Net::FullAuto Settings 988 989############################################################## 990############################################################## 991 992## Begin Term::Menus 993 994our $termwidth=0; 995our $termheight=0; 996our $padwalker=0; 997our $term_input=0; 998eval { require Term::ReadKey }; 999unless ($@) { 1000 import Term::ReadKey; 1001 ($termwidth,$termheight)=eval { 1002 no strict 'subs'; 1003 my ($termwidth,$termheight)=('',''); 1004 ($termwidth, $termheight) = 1005 Term::ReadKey::GetTerminalSize(); 1006 $termwidth||='';$termheight||=''; 1007 return $termwidth,$termheight; 1008 }; 1009 if ($@) { 1010 $termwidth='';$termheight=''; 1011 } 1012} else { 1013 $termwidth='';$termheight=''; 1014} 1015if ($termwidth) { 1016 eval { require Term::RawInput }; 1017 unless ($@) { 1018 $term_input=1; 1019 import Term::RawInput; 1020 } 1021} 1022eval { require PadWalker }; 1023unless ($@) { 1024 $padwalker=1; 1025 import PadWalker; 1026} 1027eval { require Devel::Symdump }; 1028unless ($@) { 1029 #$devel_symdump=1; 1030 import Devel::Symdump; 1031} 1032our $clearpath=''; 1033if ($^O ne 'MSWin32' && $^O ne 'MSWin64') { 1034 if (-e '/usr/bin/clear') { 1035 $clearpath='/usr/bin/'; 1036 } elsif (-e '/bin/clear') { 1037 $clearpath='/bin/'; 1038 } elsif (-e '/usr/local/bin/clear') { 1039 $clearpath='/usr/local/bin/'; 1040 } 1041} 1042 1043our %LookUpMenuName=(); 1044our $MenuMap=[]; 1045 1046our $noclear=1; # set to one to turn off clear for debugging 1047 1048sub check_for_dupe_menus { 1049 1050 my $m_flag=0; 1051 my $s_flag=0; 1052 foreach my $dir (@INC) { 1053 if (!$m_flag && -f "$dir/$Term::Menus::fa_menu") { 1054 $m_flag=1; 1055 open(FH,"<$dir/$Term::Menus::fa_menu"); 1056 my $line='';my %menudups=(); 1057 while ($line=<FH>) { 1058 if ($line=~/^[ \t]*\%(.*)\s*=/) { 1059 if (!exists $menudups{$1}) { 1060 $menudups{$1}=''; 1061 } else { 1062 my $mcmf=$Term::Menus::fa_menu;my $die=''; 1063 $die="\n FATAL ERROR! - Duplicate Hash Blocks:" 1064 ."\n -> \"%$1\" is defined more than once\n" 1065 ." in the $dir/$mcmf file.\n\n" 1066 ." Hint: delete or comment-out all duplicates\n\n"; 1067 if ($Term::Menus::fullauto) { 1068 print $die if !$Net::FullAuto::FA_Core::cron; 1069 &Net::FullAuto::FA_Core::handle_error($die,'__cleanup__'); 1070 } else { die $die } 1071 } 1072 } 1073 } 1074 } 1075 if (!$s_flag && -f "$dir/$Term::Menus::fa_code") { 1076 $s_flag=1; 1077 open(FH,"<$dir/$Term::Menus::fa_code"); 1078 my $line='';my %dups=(); 1079 while ($line=<FH>) { 1080 if ($line=~/^[ \t]*\%(.*)\s*=/) { 1081 if (!exists $dups{$1}) { 1082 $dups{$1}=''; 1083 } else { 1084 my $die="\n FATAL ERROR! - Duplicate Hash Blocks:" 1085 ."\n -> \"%$1\" is defined more " 1086 ."than once\n in the $dir/" 1087 .$Term::Menus::fa_code 1088 ." file.\n\n Hint: delete " 1089 ."or comment-out all duplicates\n\n"; 1090 if ($Term::Menus::fullauto) { 1091 print $die if !$Net::FullAuto::FA_Core::cron; 1092 &Net::FullAuto::FA_Core::handle_error($die,'__cleanup__'); 1093 } else { die $die } 1094 } 1095 } 1096 } 1097 } 1098 } 1099 1100 if ($Term::Menus::fullauto) { 1101 foreach my $symname (keys %Term::Menus::) { 1102 if (eval "\\%$symname") { 1103 my $hashref=eval "\\%$symname"; 1104 HF: foreach my $key (keys %{$hashref}) { 1105 if (ref $hashref->{$key} eq 'HASH') { 1106 foreach my $ky (keys %{$hashref->{$key}}) { 1107 if (lc($ky) eq 'text') { 1108 $LookUpMenuName{$hashref}=$symname; 1109 last HF; 1110 } 1111 } 1112 } 1113 } 1114 } 1115 } 1116 } 1117 1118} 1119 1120&check_for_dupe_menus() if defined $main::fa_menu 1121 && $main::fa_menu; 1122 1123{ 1124 use Sys::Hostname; 1125 our $local_hostname=&Sys::Hostname::hostname(); 1126} 1127 1128my $count=0; 1129our $blanklines=''; 1130if ($Term::Menus::termheight) { 1131 $count=$Term::Menus::termheight; 1132} else { $count=30 } 1133while ($count--) { $blanklines.="\n" } 1134our $parent_menu=''; 1135 1136sub fa_login 1137{ 1138 my $code='';my $menu_args='';my $to='';my $die=''; 1139 my $start_menu_ref='';my $cache=''; 1140 my $returned=''; 1141 eval { 1142 ($code,$menu_args,$to,$cache)= 1143 &Net::FullAuto::FA_Core::fa_login(@_); 1144 $main::cache=$cache if $cache; 1145 undef $main::cache unless $cache; 1146 my $mc=substr($Term::Menus::fa_menu, 1147 (rindex $Term::Menus::fa_menu,'/')+1,-3); 1148 $start_menu_ref=eval '$'.$mc.'::start_menu_ref'; 1149 $to||=0; 1150 $timeout=$to if $to; 1151 if ($code) { 1152 &run_sub($code,$menu_args); 1153 } elsif (ref $start_menu_ref eq 'HASH') { 1154 unless (keys %LookUpMenuName) { 1155 &check_for_dupe_menus(); 1156 } 1157 if ($Net::FullAuto::FA_Core::plan) { 1158 my $plann=shift @{$Net::FullAuto::FA_Core::plan}; 1159 my $return=eval $plann->{Item}; 1160 &Net::FullAuto::FA_Core::handle_error($@,'-1') if $@; 1161 return $return; 1162 } 1163 $returned=&Menu($start_menu_ref); 1164 } elsif ($start_menu_ref) { 1165 my $mcmf=$Term::Menus::fa_menu; 1166 my $die="\n FATAL ERROR! - The top level menu " 1167 ."block indicated\n by the " 1168 ."\$start_menu_ref variable in the\n " 1169 ." $mcmf file, does not exist as" 1170 ."\n a properly constructed and" 1171 ."\\or named hash\n block in the" 1172 ." ".__PACKAGE__.".pm file\n\n Hint: " 1173 ."our \$start_menu_ref=\\%Menu_1\;\n\n " 1174 ."\[ Menu_1 is example - name you choose is" 1175 ." optional \]\n\n %Menu_1=\(\n" 1176 ." Item_1 => { ... },\n " 1177 ."...\n \)\;\n"; 1178 &Net::FullAuto::FA_Core::handle_error($die); 1179 } else { 1180 my $mcmf=$Term::Menus::fa_menu; 1181 my $die="\n FATAL ERROR! - The \$start_menu_ref\n" 1182 ." variable in the $mcmf\n" 1183 ." file, is not defined or properly" 1184 ."\n initialized with the name of " 1185 ."the\n menu hash block designated" 1186 ." for the\n top level menu.\n\n" 1187 ." Hint: our \$start_menu_ref" 1188 ."=\\%Menu_1\;\n\n \[ Menu_1 is example - " 1189 ."name you choose is optional \]\n\n " 1190 ."%Menu_1=\(\n Item_1 => { ... },\n" 1191 ." ...\n \)\;\n"; 1192 &Net::FullAuto::FA_Core::handle_error($die); 1193 } 1194 }; 1195 if ($@) { 1196 my $cmdlin=52; 1197 $cmdlin=47 if $code; 1198 my $errr=$@; 1199 $errr=~s/^\s*/\n /s; 1200 print $errr; 1201 } 1202 &Net::FullAuto::FA_Core::cleanup(0,$returned); 1203 1204} 1205 1206sub run_sub 1207{ 1208 use if $Term::Menus::fullauto, "IO::Handle"; 1209 use if $Term::Menus::fullauto, POSIX => qw(setsid); 1210 1211 if ($Term::Menus::fullauto && defined $Net::FullAuto::FA_Core::service 1212 && $Net::FullAuto::FA_Core::service) { 1213 print "\n\n ##### TRANSITIONING TO SERVICE ######". 1214 "\n\n FullAuto will now continue running as". 1215 "\n as a Service/Daemon. Now exiting". 1216 "\n interactive mode ...\n\n"; 1217 chdir '/' or die "Can't chdir to /: $!"; 1218 umask 0; 1219 open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; 1220 open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!"; 1221 open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!"; 1222 defined(my $pid = fork) or die "Can't fork: $!"; 1223 exit if $pid; 1224 $pid = &setsid or die "Can't start a new session: $!"; 1225 } 1226 1227 my $code=$_[0]; 1228 $code=~s/^[&]//; 1229 my $menu_args= (defined $_[1]) ? $_[1] : ''; 1230 my $subfile=substr($Term::Menus::fa_code,0,-3).'::' 1231 if $Term::Menus::fa_code; 1232 $subfile||=''; 1233 my $return= 1234 eval "\&$subfile$code\(\@{\$menu_args}\)"; 1235 &Net::FullAuto::FA_Core::handle_error($@,'-1') if $@; 1236 return $return; 1237} 1238 1239sub get_all_hosts 1240{ 1241 return Net::FullAuto::FA_Core::get_all_hosts(@_); 1242} 1243 1244sub get_Menu_map_count 1245{ 1246 my $map_count=0;$count=0; 1247 foreach my $map (@{$_[0]}) { 1248 $count=$map->[0]; 1249 $map_count=$count if $map_count<$count; 1250 } 1251 return $map_count; 1252} 1253 1254sub get_Menu_map 1255{ 1256 my %tmphash=();my @menu_picks=(); 1257 foreach my $map (@{$MenuMap}) { 1258 $tmphash{$map->[0]}=$map->[1]; 1259 } 1260 foreach my $number (sort numerically keys %tmphash) { 1261 push @menu_picks, $tmphash{$number}; 1262 } 1263 return @menu_picks; 1264} 1265 1266sub eval_error 1267{ 1268 1269 my $log_handle=$_[1]||''; 1270 if (10<length $_[0] && unpack('a11',$_[0]) eq 'FATAL ERROR') { 1271 if (defined $log_handle && 1272 -1<index $log_handle,'*') { 1273 print $log_handle $@; 1274 close($log_handle); 1275 } 1276 die $_[0]; 1277 } else { 1278 my $die="\n FATAL ERROR! - The Local " 1279 ."System $Term::Menus::local_hostname " 1280 ."Conveyed\n" 1281 ." the Following " 1282 ."Unrecoverable Error Condition :\n\n" 1283 ." $_[0]\n line ".__LINE__; 1284 if (defined $log_handle && 1285 -1<index $log_handle,'*') { 1286 print $log_handle $die; 1287 close($log_handle); 1288 } 1289 if ($Term::Menus::fullauto) { 1290 &Net::FullAuto::FA_Core::handle_error($die); 1291 } else { die $die } 1292 } 1293} 1294 1295sub banner 1296{ 1297 1298 my $banner=$_[0]||''; 1299 return '' unless $banner; 1300 my $Conveyed=$_[1]||{}; 1301 my $SaveMMap=$_[2]||''; 1302 my $picks_from_parent=$_[3]||''; 1303 my $numbor=(defined $_[4])?$_[4]:''; 1304 my $ikey=$_[5]||''; 1305 my $input=$_[6]||{}; 1306 my $MenuUnit_hash_ref=$_[7]||{}; 1307 my $log_handle=$_[8]||''; 1308 $banner||=''; 1309 if (ref $banner eq 'CODE') { 1310 my $banner_code=$banner; 1311 if ($Term::Menus::data_dump_streamer) { 1312 $banner_code= 1313 &Data::Dump::Streamer::Dump($banner_code)->Out(); 1314 $banner_code=&transform_pmsi($banner_code, 1315 $Conveyed,$SaveMMap,$picks_from_parent); 1316 } 1317#print "WHAT IS CDNOW2=$banner_code<==\n";<STDIN>; 1318 $banner_code=~s/\$CODE\d*\s*=\s*//s; 1319#print "WHAT IS CDREALLYNOW=$banner_code<==\n";<STDIN>; 1320 my $eval_banner_code=eval $banner_code; 1321 $eval_banner_code||=sub {}; 1322 my $die="\n" 1323 ." FATAL ERROR! - Error in Banner => sub{ *CONTENT* },\n" 1324 ." code block. To find error, copy the\n" 1325 ." *CONTENT* to a separate script, and\n" 1326 ." test for the error there. Use the\n" 1327 ." 'use strict;' pragma.\n\n"; 1328 eval { 1329 $banner=$eval_banner_code->(); 1330 }; 1331 if ($@) { 1332 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 1333 if (wantarray) { 1334 return '',$@ 1335 } 1336 if (defined $log_handle && 1337 -1<index $log_handle,'*') { 1338 print $log_handle $@; 1339 close($log_handle); 1340 } 1341 if ($Term::Menus::fullauto) { 1342 &Net::FullAuto::FA_Core::handle_error($@); 1343 } else { die $@ } 1344 } else { 1345 if (wantarray) { 1346 return '',$die.' '.$@ 1347 } 1348 if (defined $log_handle && 1349 -1<index $log_handle,'*') { 1350 print $log_handle $die.' '.$@; 1351 close($log_handle); 1352 } 1353 if ($Term::Menus::fullauto) { 1354 &Net::FullAuto::FA_Core::handle_error( 1355 $die.' '.$@); 1356 } else { die $die.' '.$@ } 1357 } 1358 } 1359 } elsif (keys %{$Conveyed} || $picks_from_parent) { 1360 $banner=&transform_pmsi($banner, 1361 $Conveyed,$SaveMMap,$picks_from_parent); 1362 } else { 1363 chomp($banner); 1364 } 1365 if ($banner && ($banner=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ 1366 && grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) && 1367 defined $picks_from_parent && 1368 !ref $picks_from_parent) { 1369 my @banner=(); 1370 if ($banner!~/::/) { 1371 $banner=~s/^[&]//; 1372 eval "\@banner=main::$banner"; 1373 } else { 1374 eval "\@banner=$banner"; 1375 } 1376 $banner=join '',@banner; 1377 } 1378 return transform_mbio(transform_mbii(transform_mbir( 1379 $banner,$Conveyed,$MenuUnit_hash_ref, 1380 $log_handle),$numbor,$ikey,$input, 1381 $MenuUnit_hash_ref,$Conveyed,$log_handle),$MenuUnit_hash_ref, 1382 $Conveyed,$SaveMMap,$picks_from_parent,$log_handle); 1383 1384} 1385 1386sub Menu 1387{ 1388#print "MENUCALLER=",(caller)[0]," and ",__PACKAGE__,"\n";<STDIN>; 1389#print "MENUCALLER=",caller,"\n"; 1390 my $MenuUnit_hash_ref=$_[0]; 1391#print "WHAT IS THIS=",&Data::Dump::Streamer::Dump($MenuUnit_hash_ref)->Out(),"\n"; 1392 $MenuUnit_hash_ref->{Name}=&pw($MenuUnit_hash_ref); 1393 my $select_many=0; 1394 if (exists $MenuUnit_hash_ref->{Select}) { 1395 if (exists $MenuUnit_hash_ref->{Select} && 1396 $MenuUnit_hash_ref->{Select} && 1397 $MenuUnit_hash_ref->{Select}=~/many/i) { 1398 $select_many='Many'; 1399 $MenuUnit_hash_ref->{Select}={}; 1400 } elsif (exists $MenuUnit_hash_ref->{Select} && 1401 $MenuUnit_hash_ref->{Select} && 1402 $MenuUnit_hash_ref->{Select}=~/one/i) { 1403 $MenuUnit_hash_ref->{Select}={}; 1404 } 1405 } else { 1406 $MenuUnit_hash_ref->{Select}={}; 1407 } 1408 my $picks_from_parent=$_[1]||''; 1409 my $log_handle=''; 1410 if ($picks_from_parent && -1<index $picks_from_parent,'*') { 1411 $log_handle=$picks_from_parent; 1412 $picks_from_parent=''; 1413 } 1414 my $unattended=0; 1415 if ($picks_from_parent=~/\](Cron|Batch|Unattended|FullAuto)\[/i) { 1416 $unattended=1; 1417 undef $picks_from_parent; 1418 } 1419 my $recurse = (defined $_[2]) ? $_[2] : 0; 1420 my $FullMenu= (defined $_[3]) ? $_[3] : {}; 1421 my $Selected= (defined $_[4]) ? $_[4] : {}; 1422 my $Conveyed= (defined $_[5]) ? $_[5] : {}; 1423 my $SavePick= (defined $_[6]) ? $_[6] : {}; 1424 my $SaveMMap= (defined $_[7]) ? $_[7] : {}; 1425 my $SaveNext= (defined $_[8]) ? $_[8] : {}; 1426 my $Persists= (defined $_[9]) ? $_[9] : {}; 1427 my $parent_menu= (defined $_[10]) ? $_[10] : ''; 1428 my $no_wantarray=0; 1429 1430 if ((defined $_[11] && $_[11]) || 1431 ((caller)[0] ne __PACKAGE__ && !wantarray)) { 1432 $no_wantarray=1; 1433 } 1434 if (defined $_[12] && $_[12]) { 1435 return '','','','','','','','','','','',$_[12]; 1436 } 1437 if (defined $_[13] && $_[13]) { 1438 $log_handle=$_[13]; 1439 } 1440 my %Items=();my %negate=();my %result=();my %convey=(); 1441 my %chosen=();my %default=();my %select=();my %mark=(); 1442 my $pick='';my $picks=[];my %num__=(); 1443 my $display_this_many_items=10;my $die_err=''; 1444 my $master_substituted='';my $convey='';$mark{BLANK}=1; 1445 my $show_banner_only=0; 1446 my $num=0;my @convey=();my $filtered=0;my $sorted=''; 1447 foreach my $key (keys %{$MenuUnit_hash_ref}) { 1448 if (4<length $key && substr($key,0,4) eq 'Item') { 1449 $Items{substr($key,5)}=$MenuUnit_hash_ref->{$key}; 1450 } 1451 } 1452 $Persists->{unattended}=$unattended if $unattended; 1453 my $start=($FullMenu->{$MenuUnit_hash_ref}[11])? 1454 $FullMenu->{$MenuUnit_hash_ref}[11]:0; 1455 1456 ############################################ 1457 # Breakdown the MenuUnit into its Components 1458 ############################################ 1459 1460 # Breakdown Each Item into its Components 1461 ######################################### 1462 1463 my $got_item_flag=0; 1464 while (++$num) { 1465 $start=$FullMenu->{$MenuUnit_hash_ref}[11]||0; 1466 @convey=(); 1467 unless (exists $Items{$num}) { 1468 if (exists $MenuUnit_hash_ref->{Banner} && !$got_item_flag) { 1469 $show_banner_only=1; 1470 } else { last } 1471 } else { 1472 $got_item_flag=1; 1473 } 1474 if (exists $Items{$num}->{Negate} && 1475 !(keys %{$MenuUnit_hash_ref->{Select}})) { 1476 my $die="Can Only Use \"Negate =>\"" 1477 ."\n\t\tElement in ".__PACKAGE__.".pm when the" 1478 ."\n\t\t\"Select =>\" Element is set to \'Many\'\n\n"; 1479 &Net::FullAuto::FA_Core::handle_error($die) 1480 if $Term::Menus::fullauto; 1481 die $die; 1482 } 1483 my $con_regex=qr/\]c(o+nvey)*\[/i; 1484 if (exists $Items{$num}->{Convey}) { 1485 my $convey_test=$Items{$num}->{Convey}; 1486 if (ref $Items{$num}->{Convey} eq 'ARRAY') { 1487 foreach my $line (@{$Items{$num}->{Convey}}) { 1488 push @convey, $line; 1489 } 1490 } elsif (ref $Items{$num}->{Convey} eq 'CODE') { 1491 my $convey_code=$Items{$num}->{Convey}; 1492 if ($Term::Menus::data_dump_streamer) { 1493 $convey_code= 1494 &Data::Dump::Streamer::Dump($convey_code)->Out(); 1495#print "PICKSFROMPARENTXX=$picks_from_parent AND CONVEY_CODE=$convey_code\n"; 1496 $convey_code=&transform_pmsi($convey_code, 1497 $Conveyed,$SaveMMap,$picks_from_parent); 1498 } 1499#print "WHAT IS CDNOW1=$convey_code<==\n"; 1500 $convey_code=~s/\$CODE\d*\s*=\s*//s; 1501#print "WHAT IS CDREALLYNOW=$convey_code<==\n";<STDIN>; 1502 my $eval_convey_code=eval $convey_code; 1503 $eval_convey_code||=sub {}; 1504 @convey=$eval_convey_code->(); 1505 @convey=@{$convey[0]} if ref $convey[0] eq 'ARRAY'; 1506 if ($@) { 1507 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 1508 if ($parent_menu && wantarray && !$no_wantarray) { 1509 return '',$FullMenu,$Selected,$Conveyed, 1510 $SavePick,$SaveMMap,$SaveNext, 1511 $Persists,$parent_menu,$@; 1512 } 1513 if (defined $log_handle && 1514 -1<index $log_handle,'*') { 1515 print $log_handle $@; 1516 close($log_handle); 1517 } 1518 if ($Term::Menus::fullauto) { 1519 &Net::FullAuto::FA_Core::handle_error($@); 1520 } else { die $@ } 1521 } else { 1522 my $die="\n FATAL ERROR! - The Local " 1523 ."System $Term::Menus::local_hostname " 1524 ."Conveyed\n" 1525 ." the Following " 1526 ."Unrecoverable Error Condition :\n\n" 1527 ." $@\n line ".__LINE__; 1528 if ($parent_menu && wantarray && !$no_wantarray) { 1529 return '',$FullMenu,$Selected,$Conveyed, 1530 $SavePick,$SaveMMap,$SaveNext, 1531 $Persists,$parent_menu,$die; 1532 } 1533 if (defined $log_handle && 1534 -1<index $log_handle,'*') { 1535 print $log_handle $die; 1536 close($log_handle); 1537 } 1538 if ($Term::Menus::fullauto) { 1539 &Net::FullAuto::FA_Core::handle_error($die); 1540 } else { die $die } 1541 } 1542 } 1543 if (0==$#convey && $convey[0]=~/^(?:[{](.*)[}])?[<]$/) { 1544 return \@convey; 1545 } 1546 } elsif ($convey_test=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ && 1547 grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) { 1548 if (defined $picks_from_parent && 1549 !ref $picks_from_parent) { 1550 my $transformed_convey= 1551 &transform_pmsi($Items{$num}->{Convey}, 1552 $Conveyed,$SaveMMap, 1553 $picks_from_parent); 1554 if ($transformed_convey!~/::/) { 1555 $transformed_convey=~s/^[&]//; 1556 eval "\@convey=main::$transformed_convey"; 1557 } else { 1558 eval "\@convey=$transformed_convey"; 1559 } 1560 } 1561 } else { 1562 push @convey, $Items{$num}->{Convey}; 1563 } 1564 foreach my $item (@convey) { 1565 next if $item=~/^\s*$/s; 1566 my $text=$Items{$num}->{Text}; 1567 $text=~s/$con_regex/$item/g; 1568 $text=&transform_pmsi($text, 1569 $Conveyed,$SaveMMap, 1570 $picks_from_parent); 1571 if (-1<index $text,"__Master_${$}__") { 1572 $text=~ 1573 s/__Master_${$}__/Local-Host: $Term::Menus::local_hostname/sg; 1574 $master_substituted="Local-Host: $Term::Menus::local_hostname"; 1575 } 1576 if (exists $Items{$num}->{Include}) { 1577 if ($text=~/$Items{$num}->{Include}/s) { 1578 next if exists $Items{$num}->{Exclude} && 1579 $text=~/$Items{$num}->{Exclude}/; 1580 push @{$picks}, $text; 1581 } else { 1582 next; 1583 } 1584 } elsif (exists $Items{$num}->{Exclude} && 1585 $text=~/$Items{$num}->{Exclude}/) { 1586 next; 1587 } else { 1588 push @{$picks}, $text; 1589 } 1590 if (exists $Items{$num}->{Convey} && 1591 $Items{$num}->{Convey} ne '') { 1592 $convey{$text}=[$item,$Items{$num}->{Convey}]; 1593 } elsif (!exists $Items{$num}->{Convey}) { 1594 $convey{$text}=[$item,'']; 1595 } 1596 $default{$text}=$Items{$num}->{Default} 1597 if exists $Items{$num}->{Default}; 1598#print "WHAT IS THIS=$text and NEGATE=",$Items{$num}->{Negate}," and KEYS=",keys %{$Items{$num}},"\n"; 1599 $negate{$text}=$Items{$num}->{Negate} 1600 if exists $Items{$num}->{Negate}; 1601 if (exists $FullMenu->{$MenuUnit_hash_ref}[2]{$text}) { 1602 $result{$text}= 1603 $FullMenu->{$MenuUnit_hash_ref}[2]{$text}; 1604 } elsif (exists $Items{$num}->{Result}) { 1605 $result{$text}=$Items{$num}->{Result} 1606 } 1607 my $tsttt=$Items{$num}->{Select}; 1608 $select{$text}=$Items{$num}->{Select} 1609 if exists $Items{$num}->{Select} 1610 && $tsttt=~/many/i; 1611 if (exists $Items{$num}->{Mark}) { 1612 $mark{$text}=$Items{$num}->{Mark}; 1613 my $lmt=length $mark{$text}; 1614 $mark{BLANK}=$lmt if $mark{BLANK}<$lmt; 1615 } 1616 $filtered=1 if exists $Items{$num}->{Filter}; 1617 $sorted=$Items{$num}->{Sort} 1618 if exists $Items{$num}->{Sort}; 1619 $chosen{$text}="Item_$num"; 1620 } 1621 } elsif ($show_banner_only) { 1622 if (exists $MenuUnit_hash_ref->{Result}) { 1623 $result{'__FA_Banner__'}=$MenuUnit_hash_ref->{Result}; 1624 } last; 1625 } else { 1626 my $text=&transform_pmsi($Items{$num}->{Text}, 1627 $Conveyed,$SaveMMap, 1628 $picks_from_parent); 1629 if (-1<index $Items{$num}->{Text},"__Master_${$}__") { 1630 $text=~ 1631 s/__Master_${$}__/Local-Host: $Term::Menus::local_hostname/sg; 1632 $master_substituted= 1633 "Local-Host: $Term::Menus::local_hostname"; 1634 } 1635 if (exists $Items{$num}->{Include}) { 1636 if ($Items{$num}->{Text}=~/$Items{$num}->{Include}/) { 1637 next if exists $Items{$num}->{Exclude} && 1638 $Items{$num}->{Text}=~/$Items{$num}->{Exclude}/; 1639 push @{$picks}, $text; 1640 } else { next } 1641 } elsif (exists $Items{$num}->{Exclude} && 1642 $Items{$num}->{Text}=~/$Items{$num}->{Exclude}/) { 1643 next; 1644 } else { push @{$picks}, $text } 1645 $convey{$Items{$num}->{Text}}=['',$Items{$num}->{Convey}] 1646 if exists $Items{$num}->{Convey}; 1647 $default{$text}=$Items{$num}->{Default} 1648 if exists $Items{$num}->{Default}; 1649 $negate{$text}=$Items{$num}->{Negate} 1650 if exists $Items{$num}->{Negate}; 1651 if (exists $FullMenu->{$MenuUnit_hash_ref}[2]{$text}) { 1652 $result{$text}= 1653 $FullMenu->{$MenuUnit_hash_ref}[2]{$text}; 1654 } elsif (exists $Items{$num}->{Result}) { 1655 $result{$text}=$Items{$num}->{Result} 1656 } 1657 my $tsttt=$Items{$num}->{Select}||''; 1658 $select{$text}=$Items{$num}->{Select} 1659 if exists $Items{$num}->{Select} 1660 && $tsttt=~/many/i; 1661 if (exists $Items{$num}->{Mark}) { 1662 $mark{$text}=$Items{$num}->{Mark}; 1663 my $lmt=length $mark{$text}; 1664 $mark{BLANK}=$lmt if $mark{BLANK}<$lmt; 1665 } 1666 $filtered=1 if exists $Items{$num}->{Filter}; 1667 $sorted=$Items{$num}->{Sort} 1668 if exists $Items{$num}->{Sort}; 1669 $chosen{$text}="Item_$num"; 1670 $num__{$text}=$Items{$num}->{__NUM__} 1671 if exists $Items{$num}->{__NUM__}; 1672 } 1673 } 1674 1675 1676 ######################################### 1677 # End Items Breakdown 1678 1679 $display_this_many_items=$_[0]->{Display} 1680 if exists $_[0]->{Display}; 1681 1682 if (exists $MenuUnit_hash_ref->{Scroll} && 1683 ref $MenuUnit_hash_ref->{Scroll} ne 'ARRAY') { 1684 $MenuUnit_hash_ref->{Scroll}= 1685 [ $MenuUnit_hash_ref->{Scroll},1 ]; 1686 } 1687 1688 ############################################ 1689 # End MenuUnit Breakdown 1690 ############################################ 1691 1692 %default=() if defined $FullMenu->{$MenuUnit_hash_ref}[5]; 1693 my $nm_=(keys %num__)?\%num__:{}; 1694#print "MENU=",$MenuUnit_hash_ref->{Name}," and CONVEY=",keys %convey,"\n";<STDIN>; 1695 $FullMenu->{$MenuUnit_hash_ref}=[ $MenuUnit_hash_ref, 1696 \%negate,\%result,\%convey,\%chosen,\%default, 1697 \%select,\%mark,$nm_,$filtered,$picks,$start ]; 1698 if ($select_many || keys %{$MenuUnit_hash_ref->{Select}}) { 1699 my @filtered_menu_return=(); 1700 my $error=''; 1701 ($pick,$FullMenu,$Selected,$Conveyed,$SavePick, 1702 $SaveMMap,$SaveNext,$Persists,$parent_menu, 1703 @filtered_menu_return,$error)=&pick( 1704 $picks,$MenuUnit_hash_ref->{Banner}||'', 1705 $display_this_many_items,'','', 1706 $MenuUnit_hash_ref,++$recurse, 1707 $picks_from_parent,$parent_menu, 1708 $FullMenu,$Selected,$Conveyed,$SavePick, 1709 $SaveMMap,$SaveNext,$Persists, 1710 $no_wantarray,$sorted, 1711 $select_many); 1712 if (-1<$#filtered_menu_return) { 1713 return $pick,$FullMenu,$Selected,$Conveyed,$SavePick, 1714 $SaveMMap,$SaveNext,$Persists,$parent_menu, 1715 $filtered_menu_return[0],$filtered_menu_return[1], 1716 $filtered_menu_return[2]; 1717 } 1718 if ($Term::Menus::fullauto && $master_substituted) { 1719 $pick=~s/$master_substituted/__Master_${$}__/sg; 1720 } 1721 if ($pick eq ']quit[') { 1722 return ']quit[' 1723 } elsif ($pick eq '-' || $pick eq '+') { 1724 return $pick,$FullMenu,$Selected,$Conveyed, 1725 $SavePick,$SaveMMap,$SaveNext,$Persists; 1726 } elsif ($pick=~/DONE/) { 1727 return $pick,$FullMenu,$Selected,$Conveyed, 1728 $SavePick,$SaveMMap,$SaveNext,$Persists; 1729 } elsif (ref $pick eq 'ARRAY' && wantarray 1730 && !$no_wantarray && 1==$recurse) { 1731 if (ref $pick->[$#{$pick}] eq 'HASH') { 1732 my @choyce=@{$pick};undef @{$pick};undef $pick; 1733 pop @choyce; 1734 pop @choyce; 1735 return @choyce 1736 } 1737 my @choyce=@{$pick};undef @{$pick};undef $pick; 1738 return @choyce 1739 } elsif ($pick) { return $pick } 1740 } else { 1741 my @filtered_menu_return=(); 1742 my $error=''; 1743 ($pick,$FullMenu,$Selected,$Conveyed,$SavePick, 1744 $SaveMMap,$SaveNext,$Persists,$parent_menu, 1745 @filtered_menu_return,$error) 1746 =&pick($picks,$MenuUnit_hash_ref->{Banner}||'', 1747 $display_this_many_items, 1748 '','',$MenuUnit_hash_ref,++$recurse, 1749 $picks_from_parent,$parent_menu, 1750 $FullMenu,$Selected,$Conveyed,$SavePick, 1751 $SaveMMap,$SaveNext,$Persists, 1752 $no_wantarray,$sorted, 1753 $select_many); 1754 if (-1<$#filtered_menu_return) { 1755 return $pick,$FullMenu,$Selected,$Conveyed,$SavePick, 1756 $SaveMMap,$SaveNext,$Persists,$parent_menu, 1757 $filtered_menu_return[0],$filtered_menu_return[1], 1758 $filtered_menu_return[2]; 1759 } 1760#print "WAHT IS ALL=",keys %{$pick->[0]}," and FULL=$FullMenu and SEL=$Selected and CON=$Conveyed and SAVE=$SavePick and LAST=$SaveMMap and NEXT=$SaveNext and PERSISTS=$Persists and PARENT=$parent_menu<==\n"; 1761 if ($Term::Menus::fullauto && $master_substituted) { 1762 $pick=~s/$master_substituted/__Master_${$}__/sg; 1763 } 1764 if ($pick eq ']quit[') { 1765 return ']quit[' 1766 } elsif ($pick eq '-' || $pick eq '+') { 1767 unless (keys %{$SavePick->{$MenuUnit_hash_ref}}) { 1768 return $pick,$FullMenu,$Selected,$Conveyed, 1769 $SavePick,$SaveMMap,$SaveNext,$Persists; 1770 } elsif ($select_many || keys %{$Selected->{$MenuUnit_hash_ref}}) { 1771 return '+',$FullMenu,$Selected,$Conveyed, 1772 $SavePick,$SaveMMap,$SaveNext,$Persists; 1773 } else { 1774 return $pick,$FullMenu,$Selected,$Conveyed, 1775 $SavePick,$SaveMMap,$SaveNext,$Persists; 1776 } 1777 } elsif ($pick=~/DONE/) { 1778 return $pick,$FullMenu,$Selected,$Conveyed, 1779 $SavePick,$SaveMMap,$SaveNext,$Persists; 1780 } elsif (ref $pick eq 'ARRAY') { 1781 my $topmenu=''; 1782 my $savpick=''; 1783 if (1==$recurse && ref $pick->[$#{$pick}] eq 'HASH') { 1784 $topmenu=pop @{$pick}; 1785 $savpick=pop @{$pick}; 1786 } 1787 if (wantarray && 1==$recurse) { 1788 my @choyce=@{$pick};undef @{$pick};undef $pick; 1789 return @choyce 1790 } elsif (ref $pick eq 'ARRAY' && -1<$#{$pick} && 1791 $pick->[0]=~/^[{](.*)[}][<]$/) { 1792 return $pick,$FullMenu,$Selected,$Conveyed, 1793 $SavePick,$SaveMMap,$SaveNext,$Persists; 1794 } elsif (!$picks_from_parent && 1795 !(keys %{$MenuUnit_hash_ref->{Select}})) { 1796 if (ref $topmenu eq 'HASH' && (keys %{$topmenu->{Select}} && 1797 $topmenu->{Select} eq 'Many') || (ref $savpick eq 'HASH' && 1798 exists $topmenu->{Select}->{(keys %{$savpick})[0]})) { 1799 if (wantarray) { 1800 return @{$pick} 1801 } else { 1802 return $pick; 1803 } 1804 } elsif (-1==$#{$pick} && 1805 (ref $topmenu eq 'HASH') && 1806 (grep { /Item_/ } keys %{$topmenu})) { 1807 return [ $topmenu ]; 1808 } else { 1809 return $pick->[0]; 1810 } 1811 } else { 1812 if ($picks_from_parent) { 1813 $pick->[0]=&transform_pmsi($pick->[0], 1814 $Conveyed,$SaveMMap,$picks_from_parent); 1815 } 1816 return $pick 1817 } 1818 } elsif ($pick) { return $pick } 1819 } 1820 1821} 1822 1823sub pw { 1824 1825 ## pw [p]ad [w]alker 1826 #print "PWCALLER=",caller,"\n"; 1827 return $_[0]->{Name} if ref $_[0] eq 'HASH' 1828 && exists $_[0]->{Name}; 1829 my @packages=(); 1830 @packages=@{$_[1]} if defined $_[1] && $_[1]; 1831 my $name=''; 1832 unless (ref $_[0] eq 'HASH') { 1833 return ''; 1834 } else { 1835 my $flag=1; 1836 my $n=0; 1837 WH: while (1) { 1838 { 1839 local $SIG{__DIE__}; # No sigdie handler 1840 eval { 1841 $name=PadWalker::var_name($n++,$_[0]); 1842 }; 1843 if ($@) { 1844 undef $@; 1845 my $o=0; 1846 while (1) { 1847 eval { 1848 my $vars=PadWalker::peek_our($o++); 1849 foreach my $key (keys %{$vars}) { 1850 if (ref $vars->{$key} eq 'HASH' && 1851 %{$_[0]} eq %{$vars->{$key}}) { 1852 $name=$key; 1853 last; 1854 } 1855 } 1856 }; 1857 if ($@) { 1858 undef $@; 1859 my $s=0; 1860 unshift @packages, 'main'; 1861 PK: foreach my $package (@packages) { 1862 my $obj=Devel::Symdump->rnew($package); 1863 foreach my $hash ($obj->hashes) { 1864 next if $hash=~/^_</; 1865 next if $hash=~/^Term::Menus::/; 1866 next if $hash=~/^Config::/; 1867 next if $hash=~/^DynaLoader::/; 1868 next if $hash=~/^warnings::/; 1869 next if $hash=~/^utf8::/; 1870 next if $hash=~/^Carp::/; 1871 next if $hash=~/^fields::attr/; 1872 next if $hash=~/^Text::Balanced::/; 1873 next if $hash=~/^Data::Dump::Streamer/; 1874 next if $hash=~/^re::EXPORT_OK/; 1875 next if $hash=~/^fa_code::email_addresses/; 1876 next if $hash=~/^fa_code::email_defaults/; 1877 next if $hash=~/^PadWalker::/; 1878 next if $hash=~/^Fcntl::/; 1879 next if $hash=~/^B::Utils::/; 1880 next if $hash=~/^ExtUtils::/; 1881 next if $hash=~/^Exporter::/; 1882 next if $hash=~/^Moo::/; 1883 next if $hash=~/^overload::/; 1884 next if $hash=~/^Term::ReadKey::/; 1885 next if $hash=~/^main::INC/; 1886 next if $hash=~/^main::SIG/; 1887 next if $hash=~/^main::ENV/; 1888 next if $hash=~/^main[:][^\w]*$/; 1889 next if $hash=~/^main::[@]$/; 1890 next if $hash=~/^Net::FullAuto::FA_Core::makeplan/; 1891 next if $hash=~ 1892 /^Net::FullAuto::FA_Core::admin_menus/; 1893 my %test=eval "%$hash"; 1894 $name=$hash if %test eq %{$_[0]}; 1895 last PK if $name; 1896 } 1897 } 1898 $name||=''; 1899 $name=~s/^.*::(.*)$/$1/; 1900 last WH; 1901 } 1902 last WH if $name; 1903 } 1904 } 1905 last if $name; 1906 }; 1907 } 1908 $name||=''; 1909 $name=~s/^%//; 1910 return $name if $name; 1911 } 1912} 1913 1914sub list_module { 1915 my @modules = @_; 1916 my @result=(); 1917 no strict 'refs'; 1918 foreach my $module (@modules) { 1919 $module=~s/\.pm$//; 1920 push @result,grep { defined &{"$module\::$_"} } keys %{"$module\::"}; 1921 } 1922 return @result; 1923} 1924 1925sub test_hashref { 1926 1927 my $hashref_to_test=$_[0]; 1928 if (ref $hashref_to_test eq 'HASH') { 1929 if (grep { /Item_/ } keys %{$hashref_to_test}) { 1930 return 1; 1931 } elsif (exists $hashref_to_test->{Input} && 1932 $hashref_to_test->{Input}) { 1933 return 1; 1934 } elsif (!grep { /Item_/ } keys %{$hashref_to_test} 1935 && grep { /Banner/ } keys %{$hashref_to_test}) { 1936 return 1; 1937 } else { 1938 my $die="\n FATAL ERROR! - Unable to verify Menu\n" 1939 ."\n This Error is usually the result of a Menu" 1940 ."\n block that does not contain properly" 1941 ."\n coded Item blocks or was not coded" 1942 ."\n ABOVE the parent Menu hash block" 1943 ."\n (Example: 1), or not coded with" 1944 ."\n GLOBAL scope (Example: 2).\n" 1945 ."\n Example 1:" 1946 ."\n my %Example_Menu=( \# ABOVE parent" 1947 ."\n \# Best Practice" 1948 ."\n Item_1 => {" 1949 ."\n Text => 'Item Text'," 1950 ."\n }," 1951 ."\n );" 1952 ."\n my %Parent_Menu=(\n" 1953 ."\n Item_1 => {" 1954 ."\n Text => 'Item Text'," 1955 ."\n Result => \%Example_Menu," 1956 ."\n }," 1957 ."\n );\n" 1958 ."\n" 1959 ."\n Example 2:" 1960 ."\n my %Parent_Menu=(\n" 1961 ."\n Item_1 => {" 1962 ."\n Text => 'Item Text'," 1963 ."\n Result => \%Example_Menu," 1964 ."\n }," 1965 ."\n );" 1966 ."\n our %Example_Menu=( \# GLOBAL scope" 1967 ."\n \# Note: 'our' pragma" 1968 ."\n Item_1 => {" 1969 ."\n Text => 'Item Text'," 1970 ."\n }," 1971 ."\n );\n" 1972 ."\n"; 1973 die $die; 1974 } 1975 } else { return 0 } 1976 1977} 1978 1979sub transform_sicm 1980{ 1981 1982#print "TRANSFORM_SICM_CALLER=",caller,"\n"; 1983 ## sicm - [s]elected [i]tems [c]urrent [m]enu 1984 my $text=$_[0]||''; 1985 my $numbor=$_[1]||-1; 1986 my $all_menu_items_array=$_[2]||''; 1987 my $picks=$_[3]||''; 1988 my $pn=$_[4]||''; 1989 my $return_from_child_menu=$_[5]||''; 1990 my $log_handle=$_[6]||''; 1991 my $current_menu_name=$_[7]||''; 1992 my $selected=[];my $replace=''; 1993 my $expand_array_flag=0; 1994 my $sicm_regex= 1995 qr/\](!)?s(?:e+lected[-_]*)*i*(?:t+ems[-_]*) 1996 *c*(?:u+rrent[-_]*)*m*(?:e+nu[-_]*)*\[/xi; 1997 my $tsmi_regex=qr/\](!)?t(?:e+st[-_]*)*s*(?:e+lected[-_]*) 1998 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 1999 if ((-1<index $text,'][[') && (-1<index $text,']][')) { 2000 unless ($text=~/^\s*\]\[\[\s*/s && $text=~/\s*\]\]\[\s*$/s) { 2001 my $die="\n FATAL ERROR! - The --RETURN-ARRAY-- Macro" 2002 ."\n Boundary indicators: '][[' and ']]['" 2003 ."\n are only supported at the beginning" 2004 ."\n and end of the return instructions." 2005 ."\n Nothing but white space should precede" 2006 ."\n the left indicator, nor extend beyond" 2007 ."\n the right indicator.\n" 2008 ."\n Your String:\n" 2009 ."\n $text\n" 2010 ."\n Remedy: Recreate your return instructions" 2011 ."\n to conform to this convention. Also" 2012 ."\n be sure to use the Macro delimiter" 2013 ."\n indicator ']|[' to denote return array" 2014 ."\n element separation boundaries." 2015 ."\n Example:\n" 2016 ."\n '][[ ]S[ ]|[ ]P[{Menu_One} ]|[ SomeString ]]['" 2017 ."\n"; 2018 if (defined $log_handle && 2019 -1<index $log_handle,'*') { 2020 print $log_handle $die; 2021 close($log_handle); 2022 } 2023 } 2024 $expand_array_flag=1; 2025 } 2026 my @pks=keys %{$picks}; 2027 if (0<$#pks && !$return_from_child_menu) { 2028 foreach my $key (sort numerically keys %{$picks}) { 2029 push @{$selected},$all_menu_items_array->[$key-1]; 2030 } 2031 $replace=&Data::Dump::Streamer::Dump($selected)->Out(); 2032 $replace=~s/\$ARRAY\d*\s*=\s*//s; 2033 $replace=~s/\;\s*$//s; 2034 if ($expand_array_flag) { 2035 $replace='eval '.$replace; 2036 } 2037 $replace=~s/\'/\\\'/sg; 2038 } else { 2039 if (ref $pn eq 'HASH') { 2040 $pn->{$numbor}->[1]||=1; #COMEHERE 2041 $replace=$all_menu_items_array->[$pn->{$numbor}->[1]-1]; 2042 } elsif ($pn) { 2043 $replace=$all_menu_items_array->[$pn]; 2044 } else { 2045 $replace=$all_menu_items_array->[$numbor-1]||''; 2046 } 2047 $replace=~s/\'/\\\'/g; 2048 $replace=~s/\"/\\\"/g; 2049 $replace='"'.$replace.'"' unless 2050 $text=~/^&?(\w+)\s*[(]["'].*["'][)]\s*$/; 2051 } 2052 my $test_regx_flag=0; 2053 FE: foreach my $regx ($tsmi_regex,$sicm_regex) { 2054 last if $test_regx_flag; 2055 while ($text=~m/($regx(?:\\\{([^}]+)\})*)/sg) { 2056 $test_regx_flag=1 if -1<index $regx,'(!)?t(?:'; 2057 my $esc_one=$1; 2058 my $bang=$2; 2059 my $menu=$3; 2060 $menu||=''; 2061 $esc_one=~s/\[/\\\[/;$esc_one=~s/\]/\\\]/; 2062 $replace=~s/\s*//s if $text=~/[)]\s*$/s; 2063 if ($menu) { 2064 if (-1<index $menu, $current_menu_name) { 2065 $text=~s/$esc_one/$replace/sg; 2066 } else { 2067 $test_regx_flag=0; 2068 } 2069 next; 2070 } 2071 $text=~s/$esc_one(?![{])/$replace/g; 2072 } 2073 } 2074 return $text; 2075 2076} 2077 2078sub transform_mbio 2079{ 2080 2081 my $text=$_[0]||''; 2082 my $input=$_[1]||{}; 2083 my $MenuUnit_hash_ref=$_[2]||{}; 2084 my $Conveyed=$_[3]||''; 2085 my $SaveMMap=$_[4]||''; 2086 my $picks_from_parent=$_[5]||''; 2087 my $log_handle=$_[6]||''; 2088 my $tobi_regex=qr/\](!)?o(?:u+tput[-_]*)*b*(?:a+nner[-_]*) 2089 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2090 my $test_regx_flag=0; 2091 FE: foreach my $regx ($tobi_regex) { 2092 last if $test_regx_flag; 2093 while ($text=~m/($regx(?:\{[^}]+\})*)/sg) { 2094 $test_regx_flag=1 if -1<index $regx,'(!)?t(?:'; 2095 my $esc_one=$1;my $bang=$2; 2096 my $length_of_macro=length $esc_one; 2097 $esc_one=~s/["]\s*[.]\s*["]//s; 2098 my $esc_two=$esc_one; 2099 $esc_two=~s/\]/\\\]/;$esc_two=~s/\[/\\\[/; 2100 $esc_one=~s/^\]/\[\]\]/;$esc_one=~s/^(.*?)\[\{/$1\[\[\]{/; 2101 $esc_one=~s/^(.*?[]])[{](.*)[}]$/$1\[\{\]$2\[\}\]/; 2102 my $instructions=$esc_two; 2103 $instructions=~s/^\\[]][^[]+\\[[]\s*[{](.*?)[}]$/$1/; 2104 $instructions=~/^(.*?),(.*?)$/; 2105 my $input_macro=$1;my $code=$2; 2106 $code=~s/["']//g; 2107 $code="\$main::$code"; 2108 my $input_text=$input->{$input_macro}; 2109 $code=eval $code; 2110 my $cd=&Data::Dump::Streamer::Dump($code)->Out(); 2111 $cd=&transform_pmsi($cd, 2112 $Conveyed,$SaveMMap, 2113 $picks_from_parent); 2114 $cd=~s/\$CODE\d*\s*=\s*//s; 2115 $code=eval $cd; 2116 my $output=''; 2117 $output=$code->($input_text) if $input_text!~/^\s*$/; 2118 my $out_height=$output=~tr/\n//; 2119 my @output=split /\n/,$output; 2120 my @newtext=(); 2121 foreach my $line (split "\n",$text) { 2122 if ($line=~/^(.*)$esc_one(.*)$/) { 2123 my $front_of_line=$1;my $back_of_line=$2; 2124 my $frlen=length $front_of_line; 2125 my $bottomline=pop @output||''; 2126 $bottomline=$front_of_line.$bottomline.$back_of_line; 2127 foreach my $ln (@output) { 2128 my $pad=sprintf "%-${frlen}s",''; 2129 push @newtext,$pad.$ln; 2130 } 2131 push @newtext,$bottomline; 2132 } else { 2133 push @newtext,$line; 2134 } 2135 } $text=join "\n",@newtext; 2136 } 2137 } 2138 return $text,$input; 2139 2140} 2141 2142sub transform_mbir 2143{ 2144 2145 ## mbir - [m]enu [b]anner [i]nput [r]esults 2146 my $text=$_[0]||''; 2147 my $Conveyed=$_[1]||{}; 2148 my $MenuUnit_hash_ref=$_[2]||''; 2149 my $log_handle=$_[3]||''; 2150 my $tbii_regex=qr/\](!)?i(?:n+put[-_]*)*b*(?:a+nner[-_]*) 2151 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2152 my $test_regx_flag=0; 2153 FE: foreach my $regx ($tbii_regex) { 2154 last if $test_regx_flag; 2155 while ($text=~m/($regx(?:\{[^}]+\})*)/sg) { 2156 $test_regx_flag=1 if -1<index $regx,'(!)?t(?:'; 2157 my $esc_one=$1;my $bang=$2; 2158 my $length_of_macro=length $esc_one; 2159 $esc_one=~s/["]\s*[.]\s*["]//s; 2160 $esc_one=~s/\]/\\\]/;$esc_one=~s/\[/\\\[/; 2161 my $instructions=$esc_one; 2162 $instructions=~s/^\\[]][^[]+\\[[]\s*[{](.*?)[}]$/$1/; 2163 $instructions='('.$instructions.')'; 2164 my @instructions=eval $instructions; 2165 next if $#instructions==2; 2166 if ($#instructions==1) { 2167 if (exists $Conveyed->{$instructions[0].'_mbir'}) { 2168 my $item=$instructions[0].'_mbir'; 2169 my $replace=$Conveyed->{$item}->{$instructions[1]}; 2170 $esc_one=~s/[{]/\\{/g; 2171 $text=~s/$esc_one/$replace/s; 2172 } 2173 } 2174 } 2175 } return $text; 2176} 2177 2178sub transform_mbii 2179{ 2180 2181 ## mbii - [m]enu [b]anner [i]nput [i]tems 2182 my $text=$_[0]||''; 2183 my $numbor=(defined $_[1])?$_[1]:''; 2184 my $ikey=$_[2]||''; 2185 my $input=$_[3]||{}; 2186 my $MenuUnit_hash_ref=$_[4]||{}; 2187 my $Conveyed=$_[5]||''; 2188 my $log_handle=$_[6]||''; 2189 my $tbii_regex=qr/\](!)?i(?:n+put[-_]*)*b*(?:a+nner[-_]*) 2190 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2191 my $test_regx_flag=0; 2192 if ($ikey eq 'TAB' && exists $input->{focus}) { 2193 $input->{focus}->[0]=$input->{focus}->[2]->{$input->{focus}->[0]}; 2194 $ikey='';$numbor=''; 2195 } 2196 2197 FE: foreach my $regx ($tbii_regex) { 2198 last if $test_regx_flag; 2199 my $fill_focus=0; 2200 $fill_focus=1 unless exists $input->{focus}; 2201 while ($text=~m/($regx(?:\{[^}]+\})*)/sg) { 2202 $test_regx_flag=1 if -1<index $regx,'(!)?t(?:'; 2203 my $esc_one=$1;my $bang=$2; 2204 my $length_of_macro=length $esc_one; 2205 $esc_one=~s/["]\s*[.]\s*["]//s; 2206 my $esc_two=$esc_one; 2207 $esc_two=~s/\]/\\\]/;$esc_two=~s/\[/\\\[/; 2208 $esc_one=~s/^\]/\[\]\]/;$esc_one=~s/^(.*?)\[\{/$1\[\[\]{/; 2209 $esc_one=~s/^(.*?[]])[{](.*)[}]$/$1\[\{\]$2\[\}\]/; 2210 my $instructions=$esc_two; 2211 $instructions=~s/^\\[]][^[]+\\[[]\s*[{](.*?)[}]$/$1/; 2212 $instructions='('.$instructions.')'; 2213 my @instructions=eval $instructions; 2214 unless (exists $input->{$instructions[0]}) { 2215 $input->{$instructions[0]}=$instructions[1]; 2216 $numbor=''; 2217 } 2218 $input->{$instructions[0]}='' unless defined 2219 $input->{$instructions[0]}; 2220 if ($fill_focus) { 2221 unless (exists $input->{focus}) { 2222 my $default_focus=$instructions[0]; 2223 if (exists $MenuUnit_hash_ref->{Focus} && 2224 $MenuUnit_hash_ref->{Focus}) { 2225 $default_focus=$MenuUnit_hash_ref->{Focus}; 2226 } 2227 $input->{focus}=[$default_focus,[$instructions[0]],{}]; 2228 } else { 2229 $input->{focus}->[2]->{ 2230 $input->{focus}->[1][$#{$input->{focus}->[1]}]} 2231 =$instructions[0]; 2232 push @{$input->{focus}->[1]},$instructions[0]; 2233 $input->{focus}->[2]->{$instructions[0]}= 2234 $input->{focus}->[1]->[0]; 2235 } 2236 } 2237 my @newtext=(); 2238 foreach my $line (split "\n",$text) { 2239 if ($line=~/^(.*)$esc_one(.*)$/) { 2240 my $front_of_line=$1;my $back_of_line=$2; 2241 my $box_top_bottom='';my @sides=('| ',' |'); 2242 if ($#instructions==2 and $instructions[2]>0) { 2243 if ($input->{focus}->[0] eq $instructions[0]) { 2244 for (1..$instructions[2]) { 2245 $box_top_bottom.='='; 2246 } 2247 @sides=('[ ',' ]'); 2248 } else { 2249 for (1..$instructions[2]) { 2250 $box_top_bottom.='-'; 2251 } 2252 } 2253 } 2254 if ($input->{focus}->[0] eq $instructions[0]) { 2255 if ($ikey eq 'BACKSPACE') { 2256 chop $input->{$instructions[0]}; 2257 } elsif ($ikey eq 'DELETE') { 2258 $input->{$instructions[0]}=''; 2259 } elsif ($ikey ne 'TAB' && defined $numbor) { 2260 my $length_input=length $input->{$instructions[0]}; 2261 my $length_box=$instructions[2]; 2262 if ($length_input>$length_box) { 2263 print "\n\n WARNING! - input exceeds box size!"; 2264 print "\n\n You may have forgotten to [TAB] to the". 2265 "\n next box, or the input for the next box". 2266 "\n box has a TAB in it - usually at the". 2267 "\n front of the string. Use a text editor". 2268 "\n to see and remove it before pasting". 2269 "\n input."; 2270 print "\n\n Press to continue ...\n\n"; 2271 sleep 1; 2272 <STDIN>; 2273 } 2274 $input->{$instructions[0]}.=$numbor; 2275 } 2276 } 2277 my $insert=$sides[0]; 2278 $insert.=$input->{$instructions[0]}; 2279 $Conveyed->{&pw($MenuUnit_hash_ref).'_mbir'}-> 2280 {$instructions[0]}=$input->{$instructions[0]}; 2281 my $insert_num_of_spaces=$instructions[2]-2; 2282 $insert=sprintf "%-${insert_num_of_spaces}s",$insert; 2283 $insert.=$sides[1]; 2284 my $frlen=length $front_of_line; 2285 my $box_top_line=''; 2286 my $box_mid_line=''; 2287 my $box_bot_line=''; 2288 my $length_of_front_and_macro=$frlen+$length_of_macro; 2289 if ($#newtext==-1 || $#newtext==0) { 2290 $box_top_line=sprintf "%-${frlen}s",''; 2291 $box_top_line.=$box_top_bottom; 2292 } else { 2293 my $front_of_box_top=unpack("a$frlen",$newtext[$#newtext-1]); 2294 $front_of_box_top=sprintf "%-${frlen}s",$front_of_box_top 2295 if length $front_of_box_top<$frlen; 2296 my $back_of_box_top=''; 2297 if ($length_of_front_and_macro<=length 2298 $newtext[$#newtext-1]) { 2299 $back_of_box_top=unpack("x$length_of_front_and_macro a*", 2300 $newtext[$#newtext-1]); 2301 } 2302 $box_top_line=$front_of_box_top. 2303 $box_top_bottom.$back_of_box_top; 2304 } 2305 if ($#newtext==-1) { 2306 $box_mid_line=sprintf "%-${frlen}s",''; 2307 $box_mid_line.=$insert; 2308 } else { 2309 my $elem=($#newtext==0)?0:$#newtext; 2310 my $front_of_box_mid=sprintf "%-${frlen}s",''; 2311 if ($newtext[$elem]!~/^\s*$/) { 2312 $front_of_box_mid=unpack("a$frlen",$newtext[$elem]); 2313 $front_of_box_mid=sprintf "%-${frlen}s",$front_of_box_mid 2314 if length $front_of_box_mid<$frlen; 2315 } 2316 my $back_of_box_mid=''; 2317 if ($length_of_front_and_macro<=length $newtext[$elem]) { 2318 $back_of_box_mid=unpack("x$length_of_front_and_macro a*", 2319 $newtext[$elem]); 2320 } 2321 $box_mid_line=$front_of_box_mid. 2322 $insert.$back_of_box_mid; 2323 } 2324 $box_bot_line=$front_of_line.$box_top_bottom.$back_of_line; 2325 if ($#newtext==-1) { 2326 push @newtext,$box_top_line; 2327 push @newtext,$box_mid_line; 2328 } elsif ($#newtext==0) { 2329 unshift @newtext,$box_top_line; 2330 $newtext[1]=$box_mid_line; 2331 } else { 2332 $newtext[$#newtext-1]=$box_top_line; 2333 $newtext[$#newtext]=$box_mid_line; 2334 } push @newtext, $box_bot_line; 2335 } else { 2336 push @newtext,$line; 2337 } 2338 } $text=join "\n",@newtext; 2339 } 2340 } return $text, $input; 2341} 2342 2343sub transform_pmsi 2344{ 2345 2346#print "TRANSFORM_PMSI CALLER=",caller,"\n"; 2347 ## pmsi - [p]revious [m]enu [s]elected [i]tems 2348 my $text=$_[0]||''; 2349 my $Conveyed=$_[1]||''; 2350 my $SaveMMap=$_[2]||''; 2351 my $picks_from_parent=$_[3]||''; 2352 my $log_handle=$_[4]||''; 2353 my $expand_array_flag=0; 2354 my $tpmi_regex=qr/\](!)?t(?:e+st[-_]*)*p*(?:r+vious[-_]*) 2355 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2356 my $pmsi_regex=qr/\](!)?p(?:r+evious[-_]*)*m*(?:e+nu[-_]*) 2357 *s*(?:e+lected[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2358 my $amlm_regex=qr/\]a(n+cestor[-_]*)*m*(e+nu[-_]*) 2359 *l*(a+bel[-_]*)*m*(a+p[-_]*)*\[/xi; 2360 $text=~s/\s?$//s; 2361 if ((-1<index $text,'][[') && (-1<index $text,']][')) { 2362 unless ($text=~/^\s*\]\[\[\s*/s && $text=~/\s*\]\]\[\s*$/s) { 2363 my $die=<<DIE; 2364 2365 FATAL ERROR! - The --RETURN-ARRAY-- Macro 2366 Boundary indicators: '][[' and ']][' 2367 are only supported at the beginning 2368 and end of the return instructions. 2369 Nothing but white space should precede 2370 the left indicator, nor extend beyond 2371 the right indicator. 2372 Your String: 2373 $text 2374 Remedy: Recreate your return instructions 2375 to conform to this convention. Also 2376 be sure to use the Macro delimiter 2377 indicator ']|[' to denote return array 2378 element separation boundaries. 2379 Example: 2380 '][[ ]S[ ]|[ ]P[{Menu_One} ]|[ SomeString ]][' 2381DIE 2382 if (defined $log_handle && 2383 -1<index $log_handle,'*') { 2384 print $log_handle $die; 2385 close($log_handle); 2386 } 2387 } 2388 $expand_array_flag=1; 2389 } 2390 my $test_regx_flag=0; 2391 FE: foreach my $regx ($tpmi_regex,$pmsi_regex) { 2392 last if $test_regx_flag; 2393 while ($text=~m/($regx(?:\{[^}]+\})*)/sg) { 2394 $test_regx_flag=1 if -1<index $regx,'(!)?t(?:'; 2395 my $esc_one=$1;my $bang=$2; 2396 $esc_one=~s/["]\s*[.]\s*["]//s; 2397 $esc_one=~s/\]/\\\]/;$esc_one=~s/\[/\\\[/; 2398 $esc_one=~s/[{]/\\\{\(/;$esc_one=~s/\}/\)\}/; 2399 while ($esc_one=~/[{]/ && $text=~m/$esc_one/) { 2400 unless (exists $Conveyed->{$1} || $bang || $test_regx_flag) { 2401 my $die="\n\n FATAL ERROR! - The Menu Name: \"$1\"" 2402 ."\n describes a Menu that is *NOT* in the" 2403 ."\n invocation history of this process.\n" 2404 ."\n This Error is *usually* the result of a missing," 2405 ."\n Menu, a Menu block that was not global or" 2406 ."\n was not coded ABOVE the parent Menu hash" 2407 ."\n block. (See Example)\n" 2408 ."\n Also be sure to use a UNIQUE name for every" 2409 ."\n Menu.\n" 2410 ."\n Example: my %Example_Menu=(\n" 2411 ."\n Item_1 => {" 2412 ."\n ... # ]P[ is a Macro 'Previous'" 2413 ."\n Result => sub { return ']P[{Parent_Menu}' }," 2414 ."\n );" 2415 ."\n my %Parent_Menu=(\n" 2416 ."\n Item_1 => {" 2417 ."\n ..." 2418 ."\n Result => \\%Example_Menu," 2419 ."\n ..." 2420 ."\n );\n" 2421 ."\n *HOWEVER*: Read the Documentation on \"stepchild\"" 2422 ."\n and other deeply nested menus. There are" 2423 ."\n scenarios with dynamically generated menus" 2424 ."\n where Term::Menus simply cannot test for" 2425 ."\n menu stack integrity when it encounters" 2426 ."\n unexpanded macros in defined but ungenerated" 2427 ."\n menus. In these situations this error" 2428 ."\n message should be turned off by using the" 2429 ."\n \"test\" macro ( ]T[ ) or using an" 2430 ."\n exclamation point character with either" 2431 ."\n or both the ]S[ (becomes ]!S[) and ]P[" 2432 ."\n (becomes ]!P[) macros.\n\n"; 2433 if (defined $log_handle && 2434 -1<index $log_handle,'*') { 2435 print $log_handle $die; 2436 close($log_handle); 2437 } 2438 if ($Term::Menus::fullauto) { 2439 &Net::FullAuto::FA_Core::handle_error($die); 2440 } else { die $die } 2441 } 2442 unless ($Conveyed->{$1}) { 2443 $test_regx_flag=0; 2444 next FE 2445 } 2446 my $replace=$Conveyed->{$1}; 2447 if (ref $replace) { 2448 $replace=&Data::Dump::Streamer::Dump($Conveyed->{$1})->Out(); 2449 my $type=ref $Conveyed->{$1}; 2450 $replace=~s/\$$type\d*\s*=\s*//s; 2451 $replace=~s/\'/\\\'/sg; 2452 if ($expand_array_flag) { 2453 $replace='eval '.$replace; 2454 } 2455 } 2456 if ($text=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ && 2457 grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) { 2458 $replace=~s/\'/\\\'/g; 2459 $replace=~s/\"/\\\"/g; 2460 $replace='"'.$replace.'"' unless 2461 $text=~/^&?(\w+)\s*[(]["'].*["'][)]\s*$/; 2462 } 2463 if ($replace=~/^.(?<!["']).*(?!["']).?$/s && $replace=~/\s/s) { 2464 $replace='"'.$replace.'"' if 2465 $text!~/^&?(\w+)\s*[(]["'].*["'][)]\s*$/ && 2466 $replace!~/^eval /; 2467 } 2468 $text=~s/$esc_one/$replace/se; 2469 } 2470 my $replace=''; 2471 if (ref $picks_from_parent eq 'ARRAY') { 2472 $replace=&Data::Dump::Streamer::Dump($picks_from_parent)->Out(); 2473 my $type=ref $picks_from_parent; 2474 $replace=~s/\$$type\d*\s*=\s*//s; 2475 $replace=~s/\'/\\\'/sg; 2476 if ($expand_array_flag) { 2477 $replace='eval '.$replace; 2478 } elsif ($replace=~/^.(?<!["']).*(?!["']).?$/s && $replace=~/\s/s) { 2479 $replace='"'.$replace.'"' unless 2480 $text=~/^&?(\w+)\s*[(]["'].*["'][)]\s*$/; 2481 } 2482 } else { 2483 $replace=$picks_from_parent; 2484 if ($replace=~/^.(?<!["']).*(?!["']).?$/s && $replace=~/\s/s) { 2485 $replace='"'.$replace.'"' unless 2486 $text=~/^&?(\w+)\s*[(]["'].*["'][)]\s*$/; 2487 } 2488 2489 } 2490 if ($text=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ && 2491 grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) { 2492 $replace=~s/\'/\\\'/g; 2493 $replace=~s/\"/\\\"/g; 2494 $replace='"'.$replace.'"' if 2495 $text!~/^&?(?:.*::)*(\w+)\s*[(]["'].*["'][)]\s*$/ && 2496 $replace!~/^eval /; 2497 } 2498 $text=~s/$esc_one/$replace/s; 2499 } 2500 } 2501 while ($text=~m/($amlm_regex(?:\{[^}]+\})*)/sg) { 2502 my $esc_one=$1; 2503 last unless $esc_one; 2504 $esc_one=~s/\]/\\\]/;$esc_one=~s/\[/\\\[/; 2505 $esc_one=~s/\{/\{\(/;$esc_one=~s/\}/\)\}/; 2506 my $replace=$Conveyed->{$1}; 2507 if (ref $replace) { 2508 $replace=&Data::Dump::Streamer::Dump($Conveyed->{$1})->Out(); 2509 my $type=ref $Conveyed->{$1}; 2510 $replace=~s/\$$type\d*\s*=\s*//s; 2511 $replace=~s/\'/\\\'/sg; 2512 if ($expand_array_flag) { 2513 $replace='eval '.$replace; 2514 } 2515 } 2516 $text=~s/$esc_one/$replace/se; 2517 } return $text; 2518 2519} 2520 2521sub pick # USAGE: &pick( ref_to_choices_array, 2522 # (Optional) banner_string, 2523 # (Optional) display_this_many_items, 2524 # (Optional) return_index_only_flag, 2525 # (Optional) log_file_handle, 2526 # ---------- 2527 # For Use With Sub-Menus 2528 # ---------- 2529 # (Optional) MenuUnit_hash_ref, 2530 # (Optional) recurse_level, 2531 # (Optional) picks_from_parent, 2532 # (Optional) parent_menu, 2533 # (Optional) menus_cfg_file, 2534 # (Optional) Full_Menu_data_structure, 2535 # (Optional) Selected_data_structure, 2536 # (Optional) Conveyed_data_structure, 2537 # (Optional) SavePick_data_structure, 2538 # (Optional) SaveMMap_data_structure, 2539 # (Optional) SaveNext_data_structure, 2540 # (Optional) Persists_data_structure, 2541 # (Optional) no_wantarray_flag, 2542 # (Optional) sorted 2543 # (Optional) select_many ) 2544{ 2545 2546#print "PICKCALLER=",caller," and Argument 7 =>$_[6]<=\n";<STDIN>; 2547 2548 # "pick" --> This function presents the user with 2549 # with a list of items from which to choose. 2550 2551 my @all_menu_items_array=@{$_[0]}; 2552 my $banner=defined $_[1] ? $_[1] : "\n Please Pick an Item :"; 2553 my $display_this_many_items=defined $_[2] ? $_[2] : 10; 2554 my $return_index_only_flag=(defined $_[3]) ? 1 : 0; 2555 my $log_handle= (defined $_[4]) ? $_[4] : ''; 2556 2557 # Used Only With Cascasding Menus (Optional) 2558 my $MenuUnit_hash_ref= (defined $_[5]) ? $_[5] : {}; 2559 my $show_banner_only=0; 2560 unless (grep { /Item_/ } keys %{$MenuUnit_hash_ref}) { 2561 if (grep { /Banner/ } keys %{$MenuUnit_hash_ref}) { 2562 $show_banner_only=1; 2563 } 2564 } 2565 $MenuUnit_hash_ref->{Select}||={}; 2566 my $recurse_level= (defined $_[6]) ? $_[6] : 1; 2567 my $picks_from_parent= (defined $_[7]) ? $_[7] : ''; 2568 my $parent_menu= (defined $_[8]) ? $_[8] : ''; 2569 my $FullMenu= (defined $_[9]) ? $_[9] : {}; 2570 my $Selected= (defined $_[10]) ? $_[10] : {}; 2571 my $Conveyed= (defined $_[11]) ? $_[11] : {}; 2572 my $SavePick= (defined $_[12]) ? $_[12] : {}; 2573 my $SaveMMap= (defined $_[13]) ? $_[13] : {}; 2574 my $SaveNext= (defined $_[14]) ? $_[14] : {}; 2575 my $Persists= (defined $_[15]) ? $_[15] : {}; 2576 my $no_wantarray= (defined $_[16]) ? $_[16] : 0; 2577 my $sorted= (defined $_[17]) ? $_[17] : 0; 2578 my $select_many= (defined $_[18]) ? $_[18] : 0; 2579 2580 my %items=();my %picks=();my %negate=(); 2581 my %exclude=();my %include=();my %default=(); 2582 my %labels=(); 2583 foreach my $menuhash (keys %{$FullMenu}) { 2584 my $name=&pw($FullMenu->{$menuhash}[0]); 2585 if ($name) { 2586 $FullMenu->{$menuhash}[0]->{Name}=$name; 2587 } else { next } 2588 $labels{$name}=$FullMenu->{$menuhash}[0]; 2589 } 2590 if ($SavePick && exists $SavePick->{$MenuUnit_hash_ref}) { 2591 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 2592 } 2593 my $num_pick=$#all_menu_items_array+1; 2594 my $caller=(caller(1))[3]||''; 2595 my $numbor=0; # Number of Item Selected 2596 my $ikey=''; # rawInput Key - key used 2597 # to end menu. Can be 2598 # any non-alphanumeric 2599 # key like Enter or 2600 # Right Arrow. 2601 my $return_from_child_menu=0; 2602 2603 my $choose_num=''; 2604 my $convey=''; 2605 my $menu_output=''; 2606 my $hidedefaults=0; 2607 my $start=($FullMenu->{$MenuUnit_hash_ref}[11])? 2608 $FullMenu->{$MenuUnit_hash_ref}[11]:0; 2609 my $got_default=0; 2610 2611 sub delete_Selected 2612 { 2613 2614 my $Selected=$_[2]; 2615 my $SavePick=$_[3]; 2616 my $SaveNext=$_[4]; 2617 my $Persists=$_[5]; 2618 if ($_[1]) { 2619 my $result=$Selected->{$_[0]}{$_[1]}; 2620 delete $Selected->{$_[0]}{$_[1]}; 2621 delete $SavePick->{$_[0]}{$_[1]}; 2622 if ($result) { 2623 &delete_Selected($result,'', 2624 $Selected,$SavePick,$SaveNext); 2625 } delete $SaveNext->{$_[0]}; 2626 } else { 2627 if (keys %{$Selected->{$_[0]}}) { 2628 foreach my $key (keys %{$Selected->{$_[0]}}) { 2629 delete $Selected->{$_[0]}{$key}; 2630 delete $SavePick->{$_[0]}{$key}; 2631 delete $SaveNext->{$_[0]}; 2632 } 2633 } else { 2634 foreach my $key (keys %{$SavePick->{$_[0]}}) { 2635 delete $SavePick->{$_[0]}{$key}; 2636 delete $SaveNext->{$_[0]}; 2637 } 2638 } 2639 } delete $SaveNext->{$_[0]}; 2640 return $SaveNext; 2641 2642 } 2643 2644 sub find_Selected 2645 { 2646 my $Selected=$_[2]; 2647 if ($_[1]) { 2648 my $result=$Selected->{$_[0]}{$_[1]}; 2649 if ($result=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ && 2650 grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) { 2651 return 0; 2652 } else { 2653 return &find_Selected($result,'',$Selected); 2654 } 2655 } else { 2656 if (keys %{$Selected->{$_[0]}}) { 2657 foreach my $key (keys %{$Selected->{$_[0]}}) { 2658 my $result=$Selected->{$_[0]}{$key}; 2659 #return '+' if substr($result,0,1) eq '&'; 2660 if ($result=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ && 2661 grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) { 2662 return '+'; 2663 } 2664 my $output=&find_Selected($result,'',$Selected); 2665 return '+' if $output eq '+'; 2666 } 2667 } 2668 } 2669 } 2670 2671 sub get_subs_from_menu 2672 { 2673 my $Selected=$_[0]; 2674 my @subs=(); 2675 foreach my $key (keys %{$Selected}) { 2676 foreach my $item (keys %{$Selected->{$key}}) { 2677 my $seltext=$Selected->{$key}{$item}; 2678 if ($seltext=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ && 2679 grep { $1 eq $_ } list_module('main',$Term::Menus::fa_code)) { 2680 push @subs, escape_quotes($seltext); 2681 } elsif (ref $seltext eq 'CODE') { 2682 push @subs, $seltext; 2683 } 2684 } 2685 } 2686 return @subs; 2687 } 2688 2689 my $get_result = sub { 2690 2691 # $_[0] => $MenuUnit_hash_ref 2692 # $_[1] => \@all_menu_items_array 2693 # $_[2] => $picks 2694 # $_[3] => $picks_from_parent 2695 2696 my $convey=[]; 2697 my $FullMenu=$_[4]; 2698 my $Conveyed=$_[5]; 2699 my $Selected=$_[6]; 2700 my $SaveNext=$_[7]; 2701 my $Persists=$_[8]; 2702 my $parent_menu=$_[9]; 2703 my $pick=(keys %{$_[2]})[0] || 1; 2704 $_[1]->[$pick-1]||=''; 2705 my $gotmany=(exists $MenuUnit_hash_ref->{Select} && 2706 $MenuUnit_hash_ref->{Select}) ? 1 : 0; 2707 $FullMenu->{$_[0]}[3]={} unless $gotmany; 2708 if ($pick && exists $FullMenu->{$_[0]}[3]{$_[1]->[$pick-1]}) { 2709 if ($pick && exists $_[0]->{$FullMenu->{$_[0]} 2710 [4]{$_[1]->[$pick-1]}}{Convey}) { 2711 my $contmp=''; 2712 if (0<$#{[keys %{$_[2]}]}) { 2713 foreach my $numb (sort numerically keys %{$_[2]}) { 2714 $contmp=${${$FullMenu}{$_[0]}[3]} 2715 {${$_[1]}[$numb-1]}[0]; 2716 $contmp=~s/\s?$//s; 2717 push @{$convey}, $contmp; 2718 } 2719 } else { 2720 $convey=${${${$FullMenu}{$_[0]}[3]}{${$_[1]}[$pick-1]}}[0]; 2721 #$convey=$FullMenu->{$_[0]}[3]->{$_[1]->[$pick-1]}->[0]; 2722 $convey=~s/\s?$//s; 2723 } 2724 $convey='SKIP' if $convey eq ''; 2725 if (ref $convey eq 'ARRAY' && $#{$convey}==0) { 2726 $convey=$convey->[0]; 2727 } 2728 } 2729 $Conveyed->{&pw($_[0])}=$convey; 2730 } elsif ($pick) { 2731 $convey=${$_[1]}[$pick-1]; 2732 $Conveyed->{&pw($_[0])}=$convey; 2733 } elsif ($_[3]) { 2734 $convey=$_[3]; 2735 $Conveyed->{&pw($_[0])}=$convey; 2736 } 2737 $convey='' if !$convey || 2738 (ref $convey eq 'ARRAY' && $#{$convey}==-1); 2739 my $test_item='';my $show_banner_only=0; 2740 if (exists $FullMenu->{$_[0]}[2]{'__FA_Banner__'}) { 2741 $test_item=$FullMenu->{$_[0]}[2]{'__FA_Banner__'}; 2742 $show_banner_only=1;$pick=0; 2743 } elsif ($pick) { 2744 $test_item=$FullMenu->{$_[0]}[2]{$_[1]->[$pick-1]}; 2745 } 2746 $test_item||=''; 2747 if (($pick && 2748 exists $FullMenu->{$_[0]}[2]{$_[1]->[$pick-1]} && 2749 (ref $test_item eq 'HASH' && 2750 (values %{$test_item})[0] ne 'recurse')) || 2751 ref $test_item eq 'CODE') { 2752 if ((ref $test_item eq 'HASH' && 2753 ((grep { /Item_/ } keys %{$test_item}) || 2754 ($show_banner_only && (grep { /Banner/ } 2755 keys %{$test_item})))) 2756 || ($test_item=~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ 2757 && grep { $1 eq $_ } list_module( 2758 'main',$Term::Menus::fa_code)) 2759 || ref $test_item eq 'CODE' || 2760 &test_hashref($test_item)) { 2761 my $con_regex=qr/\]c(o+nvey)*\[/i; 2762 my $tpmi_regex=qr/\](!)?t(?:e+st[-_]*)*p*(?:r+vious[-_]*) 2763 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2764 my $sicm_regex= 2765 qr/\]s(e+lected[-_]*)*i*(t+ems[-_]*) 2766 *c*(u+rrent[-_]*)*m*(e+nu[-_]*)*\[/xi; 2767 my $pmsi_regex=qr/\](!)?p(?:r+evious[-_]*)*m*(?:e+nu[-_]*) 2768 *s*(?:e+lected[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2769 my $amlm_regex=qr/\]a(n+cestor[-_]*)*m*(e+nu[-_]*) 2770 *l*(a+bel[-_]*)*m*(a+p[-_]*)*\[/xi; 2771 my $tbii_regex=qr/\](!)?i(?:n+put[-_]*)*b*(?:a+nner[-_]*) 2772 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 2773 if ($test_item=~/$con_regex|$pmsi_regex| 2774 $amlm_regex|$sicm_regex|$tpmi_regex|$tbii_regex/x) { 2775 $test_item=&transform_mbii($test_item, 2776 $Conveyed,$SaveMMap, 2777 $picks_from_parent,$log_handle); 2778 $test_item=&transform_sicm($test_item,$numbor, 2779 \@all_menu_items_array,$_[2],'', 2780 $return_from_child_menu,$log_handle, 2781 $_[0]->{Name}); 2782 $test_item=&transform_pmsi($test_item, 2783 $Conveyed,$SaveMMap, 2784 $picks_from_parent,$log_handle); 2785 $test_item=&transform_mbir($test_item, 2786 $Conveyed,$MenuUnit_hash_ref,$log_handle); 2787 } elsif (ref $test_item eq 'CODE') { 2788 my $cd=''; 2789 #if ($Term::Menus::data_dump_streamer && (!$show_banner_only 2790 # || (exists $MenuUnit_hash_ref->{Input} 2791 # && $MenuUnit_hash_ref->{Input}==1))) { 2792 $cd=&Data::Dump::Streamer::Dump($test_item)->Out(); 2793 $cd=&transform_sicm($cd,$numbor, 2794 \@all_menu_items_array,$_[2],'', 2795 $return_from_child_menu,$log_handle, 2796 $_[0]->{Name}); 2797 $cd=&transform_pmsi($cd, 2798 $Conveyed,$SaveMMap, 2799 $picks_from_parent); 2800 $cd=&transform_mbir($cd,$Conveyed,$MenuUnit_hash_ref, 2801 $log_handle); 2802 #} 2803 $cd=~s/\$CODE\d*\s*=\s*//s; 2804#print "CD2=$cd<==\n";<STDIN>; 2805 eval { $test_item=eval $cd }; 2806 if ($@) { 2807 if (unpack('a11',$@) eq 'FATAL ERROR') { 2808 if (defined $log_handle && 2809 -1<index $log_handle,'*') { 2810 print $log_handle $@; 2811 close($log_handle); 2812 } 2813 die $@; 2814 } else { 2815 my $die="\n FATAL ERROR! - The Local " 2816 ."System $Term::Menus::local_hostname Conveyed\n" 2817 ." the Following " 2818 ."Unrecoverable Error Condition :\n\n" 2819 ." $@\n line ".__LINE__; 2820 if (defined $log_handle && 2821 -1<index $log_handle,'*') { 2822 print $log_handle $die; 2823 close($log_handle); 2824 } 2825 if ($parent_menu && wantarray && !$no_wantarray) { 2826 return $FullMenu,$Conveyed, 2827 $SaveNext,$Persists,$Selected, 2828 $convey,$parent_menu; 2829 } elsif ($Term::Menus::fullauto) { 2830 &Net::FullAuto::FA_Core::handle_error($die); 2831 } else { die $die } 2832 } 2833 } 2834 my $item=($show_banner_only)?'__FA_Banner__':$pick; 2835 $Selected->{$_[0]}->{$item}=$test_item; 2836 return $FullMenu,$Conveyed,$SaveNext, 2837 $Persists,$Selected,$convey,$parent_menu; 2838 } 2839 if ($test_item=~/Convey\s*=\>/) { 2840 if ($convey ne 'SKIP') { 2841 $test_item=~s/Convey\s*=\>/$convey/g; 2842 } else { 2843 $test_item=~s/Convey\s*=\>/${$_[1]}[$pick-1]/g; 2844 } 2845 } 2846 if ($test_item=~/Text\s*=\>/) { 2847 $test_item=~s/Text\s*=\>/${$_[1]}[$pick-1]/g; 2848 } 2849 } else { 2850 my $die="The \"Result3 =>\" Setting\n -> " 2851 .$FullMenu->{$_[0]}[2]{$_[1]->[$_[2]-1]} 2852 ."\n Found in the Menu Unit -> " 2853 .$MenuUnit_hash_ref 2854 ."\n is not a Menu Unit\," 2855 ." and Because it Does Not Have" 2856 ."\n an \"&\" as" 2857 ." the Lead Character, $0" 2858 ."\n Cannot Determine " 2859 ."if it is a Valid SubRoutine.\n\n"; 2860 die $die; 2861 } 2862 } 2863 if ($show_banner_only) { 2864 $Selected->{$_[0]}{'__FA_Banner__'}=$test_item; 2865 $SaveNext->{$_[0]}=$FullMenu->{$_[0]}[2]{'__FA_Banner__'}; 2866 } else { 2867 chomp($pick) if $pick; 2868 $Selected->{$_[0]}{$pick}=$test_item if $pick; 2869 if ($pick && ref $_[0]->{$FullMenu->{$_[0]} 2870 [4]{$_[1]->[$pick-1]}}{'Result'} eq 'HASH') { 2871 $SaveNext->{$_[0]}=$FullMenu->{$_[0]}[2] 2872 {$_[1]->[$pick-1]}; 2873 } 2874 } 2875 return $FullMenu,$Conveyed,$SaveNext, 2876 $Persists,$Selected,$convey,$parent_menu; 2877 }; 2878 2879 my $filtered_menu=0;my $defaults_exist=0;my $input=''; 2880 while (1) { 2881 if ($num_pick-$start<=$display_this_many_items) { 2882 $choose_num=$num_pick-$start; 2883 } else { $choose_num=$display_this_many_items } 2884 $numbor=$start+$choose_num+1;my $done=0;my $savechk=0;my %pn=(); 2885 my $sorted_flag=0; 2886 $Persists->{$MenuUnit_hash_ref}={} unless exists 2887 $Persists->{$MenuUnit_hash_ref}; 2888 if (!exists $Persists->{$MenuUnit_hash_ref}{defaults} && 2889 defined ${[keys %{$FullMenu->{$MenuUnit_hash_ref}[5]}]}[0]) { 2890 my $it=${[keys %{$FullMenu->{$MenuUnit_hash_ref}[5]}]}[0]; 2891 my $def=$FullMenu->{$MenuUnit_hash_ref}[5]{$it}; 2892 if ($def) { 2893 $def='.*' if $def eq '*'; 2894 foreach my $item ( 2895 @{[keys %{$FullMenu->{$MenuUnit_hash_ref}[5]}]}) { 2896 if ($item=~/$def/) { 2897 $Persists->{$MenuUnit_hash_ref}{defaults}=1; 2898 } 2899 } 2900 } 2901 } 2902 $Persists->{$MenuUnit_hash_ref}{defaults}=0 unless exists 2903 $Persists->{$MenuUnit_hash_ref}{defaults}; 2904 my $plann='';my $plannn=''; 2905 if (ref $Net::FullAuto::FA_Core::plan eq 'HASH') { 2906 my $plann=shift @{$Net::FullAuto::FA_Core::plan}; 2907 $plannn=$plann->{Item}; 2908 my $plan_=''; 2909 if (substr($plannn,2,5) eq 'ARRAY') { 2910 my $eval_plan=substr($plannn,1,-1); 2911 $plan_=eval $eval_plan; 2912 &eval_error($@,$log_handle) if $@; 2913 } else { 2914 $plan_=$plannn; 2915 } 2916 return $plan_; 2917 } 2918 while ($numbor=~/\d+/ && 2919 ($numbor<=$start || $start+$choose_num < $numbor || 2920 $numbor eq 'admin') || $input) { 2921 my $menu_text='';my $picknum_for_display=''; 2922 my $bout=''; 2923 ($bout,$input)=&banner($MenuUnit_hash_ref->{Banner}||$banner, 2924 $Conveyed,$SaveMMap,$picks_from_parent, 2925 $numbor,$ikey,$input,$MenuUnit_hash_ref,$log_handle); 2926 $menu_text.=$bout."\n"; 2927 my $picknum=$start+1; 2928 my $numlist=$choose_num; 2929 my $mark=''; 2930 my $mark_len=$FullMenu->{$MenuUnit_hash_ref}[7]{BLANK}; 2931 while ($mark_len--) { 2932 $mark.=' '; 2933 } 2934 my $mark_blank=$mark; 2935 my $mark_flg=0;my $prev_menu=0; 2936 $numlist=1 if $numbor eq 'admin'; 2937 while (0 < $numlist) { 2938 if (exists $picks{$picknum}) { 2939 $mark_flg=1; 2940 if ($return_from_child_menu) { 2941 $mark=$mark_blank; 2942 substr($mark,-1)=$picks{$picknum}=$return_from_child_menu; 2943 %{$SavePick->{$MenuUnit_hash_ref}}=%picks; 2944 $prev_menu=$picknum; 2945#print "DO WE GET HERE3 and SEL=$MenuUnit_hash_ref->{Select}! and $return_from_child_menu\n"; 2946 } else { 2947 $mark=$mark_blank; 2948 substr($mark,-1)=$picks{$picknum}; 2949 } 2950#print "DO WE GET HERE4 and SEL=$MenuUnit_hash_ref->{Select}!\n"; 2951 my $gotmany=($select_many || 2952 (keys %{$MenuUnit_hash_ref->{Select}})) ? 1 : 0; 2953 if (($gotmany 2954 && $numbor=~/^[Ff]$/) || ($picks{$picknum} ne 2955 '+' && $picks{$picknum} ne '-' && 2956 !$gotmany)) { 2957#print "DO WE GET HERE5! and $MenuUnit_hash_ref->{Select}\n"; 2958 $mark_flg=1; 2959 $mark=$mark_blank; 2960 substr($mark,-1)='*'; 2961 if ((exists $FullMenu->{$MenuUnit_hash_ref}[2] 2962 {$all_menu_items_array[$picknum-1]}) && ref 2963 $FullMenu->{$MenuUnit_hash_ref}[2] 2964 {$all_menu_items_array[$picknum-1]} eq 'HASH' && 2965 (grep { /Item_/ } keys %{$FullMenu-> 2966 {$MenuUnit_hash_ref}[3]})) { 2967 if (exists $FullMenu->{$MenuUnit_hash_ref}[3] 2968 {$all_menu_items_array[$picknum-1]}) { 2969 $convey=$FullMenu->{$MenuUnit_hash_ref}[3] 2970 {$all_menu_items_array[$picknum-1]}->[0]; 2971 } else { $convey=$all_menu_items_array[$picknum-1] } 2972 eval { 2973 ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, 2974 $SaveMMap,$SaveNext,$Persists)=&Menu($FullMenu-> 2975 {$MenuUnit_hash_ref}[2] 2976 {$all_menu_items_array[$picknum-1]},$convey, 2977 $recurse_level,$FullMenu, 2978 $Selected,$Conveyed,$SavePick, 2979 $SaveMMap,$SaveNext,$Persists, 2980 $MenuUnit_hash_ref,$no_wantarray); 2981 }; # MENU RETURN MENURETURN 1 2982 print "MENU RETURN 1\n" if $menu_return_debug; 2983 die $@ if $@; 2984 chomp($menu_output) if !(ref $menu_output); 2985 if ($menu_output eq '-') { 2986 $picks{$picknum}='-'; 2987 $mark=$mark_blank; 2988 substr($mark,-1)='-'; 2989 $start=${$FullMenu}{$MenuUnit_hash_ref}[11]; 2990 } elsif ($menu_output eq '+') { 2991 $picks{$picknum}='+'; 2992 $mark=$mark_blank; 2993 substr($mark,-1)='+'; 2994 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 2995 } elsif ($menu_output eq 'DONE_SUB') { 2996 return 'DONE_SUB'; 2997 } elsif ($menu_output eq 'DONE') { 2998 if (1==$recurse_level) { 2999 my $subfile=substr($Term::Menus::fa_code,0,-3).'::' 3000 if $Term::Menus::fa_code; 3001 $subfile||=''; 3002 foreach my $sub (&get_subs_from_menu($Selected)) { 3003 my @resu=(); 3004 if (ref $sub eq 'CODE') { 3005 if ($Term::Menus::fullauto && (!exists 3006 $MenuUnit_hash_ref->{'NoPlan'} || 3007 !$MenuUnit_hash_ref->{'NoPlan'}) 3008 && defined 3009 $Net::FullAuto::FA_Core::makeplan) { 3010#print "IN MAKEPLAN1\n"; 3011 if (-1== 3012 $#{$Net::FullAuto::FA_Core::makeplan{ 3013 'Plan'}} && !exists 3014 $Net::FullAuto::FA_Core::makeplan->{ 3015 'Title'}) { 3016 $Net::FullAuto::FA_Core::makeplan->{ 3017 'Title'}=$pn{$numbor}[0]; 3018 } 3019 my $n='Number'; 3020 my $planid= 3021 $Net::FullAuto::FA_Core::makeplan->{ 3022 $n}; 3023 my $s=$sub; 3024 my $item= 3025 &Data::Dump::Streamer::Dump( 3026 $s)->Out(); 3027 push @{$Net::FullAuto::FA_Core::makeplan->{ 3028 'Plan'}}, 3029 { Menu => &pw($MenuUnit_hash_ref), 3030 Number => $numbor, 3031 PlanID => $planid, 3032 Item => $item 3033 } 3034 } 3035 eval { @resu=$sub->() }; 3036 if ($@) { 3037 if (10<length $@ && unpack('a11',$@) 3038 eq 'FATAL ERROR') { 3039 if ($parent_menu && wantarray 3040 && !$no_wantarray) { 3041 return '',$FullMenu,$Selected, 3042 $Conveyed,$SavePick,$SaveMMap, 3043 $SaveNext,$Persists, 3044 $parent_menu,$@; 3045 } 3046 if (defined $log_handle && 3047 -1<index $log_handle,'*') { 3048 print $log_handle $@; 3049 close($log_handle); 3050 } 3051 if ($Term::Menus::fullauto) { 3052 &Net::FullAuto::FA_Core::handle_error( 3053 $@); 3054 } else { die $@ } 3055 } else { 3056 my $die='' 3057 ."\n FATAL ERROR! - The Local " 3058 ."System $Term::Menus::local_hostname" 3059 ." Conveyed\n" 3060 ." the Following " 3061 ."Unrecoverable Error Condition :\n\n" 3062 ." $@\n line ".__LINE__; 3063 if ($parent_menu && wantarray 3064 && !$no_wantarray) { 3065 return '',$FullMenu,$Selected, 3066 $Conveyed,$SavePick,$SaveMMap, 3067 $SaveNext,$Persists, 3068 $parent_menu,$die; 3069 } 3070 if (defined $log_handle && 3071 -1<index $log_handle,'*') { 3072 print $log_handle $die; 3073 close($log_handle); 3074 } 3075 if ($Term::Menus::fullauto) { 3076 &Net::FullAuto::FA_Core::handle_error( 3077 $die); 3078 } else { die $die } 3079 } 3080 } 3081 if (-1<$#resu) { 3082 if ($resu[0] eq '<') { %picks=();next } 3083 if (0<$#resu && wantarray && 3084 !$no_wantarray) { 3085 return @resu; 3086 } else { 3087 return return_result($resu[0], 3088 $MenuUnit_hash_ref,$Conveyed); 3089 } return 'DONE_SUB'; 3090 } 3091 } 3092 eval { 3093 if ($subfile) { 3094 $sub=~s/^[&]//; 3095 if ($Term::Menus::fullauto && (!exists 3096 $MenuUnit_hash_ref->{'NoPlan'} || 3097 !$MenuUnit_hash_ref->{'NoPlan'}) 3098 && defined 3099 $Net::FullAuto::FA_Core::makeplan) { 3100#print "IN MAKEPLAN2\n"; 3101 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 3102 'Plan'}} && !exists 3103 $Net::FullAuto::FA_Core::makeplan->{ 3104 'Title'}) { 3105 $Net::FullAuto::FA_Core::makeplan->{ 3106 'Title'}=$pn{$numbor}[0]; 3107 } 3108 push @{$Net::FullAuto::FA_Core::makeplan->{ 3109 'Plan'}}, 3110 { Menu => &pw($MenuUnit_hash_ref), 3111 Number => $numbor, 3112 PlanID => 3113 $Net::FullAuto::FA_Core::makeplan->{Number}, 3114 Item => "&$subfile$sub" } 3115 } 3116 eval "\@resu=\&$subfile$sub"; 3117 my $firsterr=$@||''; 3118 3119 if ((-1<index $firsterr, 3120 'Undefined subroutine') && 3121 (-1<index $firsterr,$sub)) { 3122 if ($sub!~/::/) { 3123 eval "\@resu=main::$sub"; 3124 } else { 3125 eval "\@resu=$sub"; 3126 } 3127 my $seconderr=$@||'';my $die=''; 3128 my $c=$Term::Menus::fa_code; 3129 if ($seconderr=~/Undefined subroutine/) { 3130 if ($FullMenu->{$MenuUnit_hash_ref} 3131 [2]{$all_menu_items_array[ 3132 $numbor-1]}) { 3133 $die="The \"Result15 =>\" Setting" 3134 ."\n\t\t-> " . $FullMenu-> 3135 {$MenuUnit_hash_ref}[2] 3136 {$all_menu_items_array[ 3137 $numbor-1]} 3138 ."\n\t\tFound in the Menu " 3139 ."Unit -> " 3140 .$MenuUnit_hash_ref->{Name} 3141 ."\n\t\t" 3142 ."Specifies a Subroutine" 3143 ." that Does NOT Exist" 3144 ."\n\t\tin the User Code File " 3145 .$c.",\n\t\tnor was a routine " 3146 ."with that name\n\t\tlocated" 3147 ." in the main:: script.\n"; 3148 } else { 3149 $die= 3150 "$firsterr\n $seconderr" 3151 } 3152 } else { $die=$seconderr } 3153 &Net::FullAuto::FA_Core::handle_error( 3154 $die); 3155 } elsif ($firsterr) { 3156 &Net::FullAuto::FA_Core::handle_error( 3157 $firsterr); 3158 } 3159 } else { 3160 if ($sub!~/::/) { 3161 $sub=~s/^[&]//; 3162 eval "\@resu=main::$sub"; 3163 } else { 3164 eval "\@resu=$sub"; 3165 } 3166 die $@ if $@; 3167 } 3168 }; 3169 if ($@) { 3170 if (10<length $@ && unpack('a11',$@) 3171 eq 'FATAL ERROR') { 3172 if ($parent_menu && wantarray 3173 && !$no_wantarray) { 3174 return '',$FullMenu,$Selected,$Conveyed, 3175 $SavePick,$SaveMMap,$SaveNext, 3176 $Persists,$parent_menu,$@; 3177 } 3178 if (defined $log_handle && 3179 -1<index $log_handle,'*') { 3180 print $log_handle $@; 3181 close($log_handle); 3182 } 3183 if ($Term::Menus::fullauto) { 3184 &Net::FullAuto::FA_Core::handle_error($@); 3185 } else { die $@ } 3186 } else { 3187 my $die='' 3188 ."\n FATAL ERROR! - The Local " 3189 ."System $Term::Menus::local_hostname " 3190 ."Conveyed\n" 3191 ." the Following " 3192 ."Unrecoverable Error Condition :\n\n" 3193 ." $@\n line ".__LINE__; 3194 if ($parent_menu && wantarray 3195 && !$no_wantarray) { 3196 return '',$FullMenu,$Selected,$Conveyed, 3197 $SavePick,$SaveMMap,$SaveNext, 3198 $Persists,$parent_menu,$die; 3199 } 3200 if (defined $log_handle && 3201 -1<index $log_handle,'*') { 3202 print $log_handle $die; 3203 close($log_handle); 3204 } 3205 if ($Term::Menus::fullauto) { 3206 &Net::FullAuto::FA_Core::handle_error( 3207 $die); 3208 } else { die $die } 3209 } 3210 } 3211 if (-1<$#resu) { 3212 if ($resu[0] eq '<') { %picks=();next } 3213 if (0<$#resu && wantarray && !$no_wantarray) { 3214 return @resu; 3215 } else { 3216 return return_result($resu[0], 3217 $MenuUnit_hash_ref,$Conveyed); 3218 } 3219 } 3220 } 3221 return 'DONE_SUB'; 3222 } else { return 'DONE' } 3223 } elsif ($menu_output) { 3224 return $menu_output; 3225 } else { 3226 $picks{$picknum}='+'; 3227 $mark=$mark_blank; 3228 substr($mark,-1)='+'; 3229 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 3230 } 3231 } 3232 } 3233 } else { 3234 $mark=''; 3235 my $mark_len=$FullMenu->{$MenuUnit_hash_ref}[7]{BLANK}; 3236 while ($mark_len--) { 3237 $mark.=' '; 3238 } 3239 } 3240 $mark=$FullMenu->{$MenuUnit_hash_ref}[7] 3241 {$all_menu_items_array[$picknum-1]} 3242 if exists $FullMenu->{$MenuUnit_hash_ref}[7] 3243 {$all_menu_items_array[$picknum-1]}; 3244 if (!$hidedefaults && 3245 ref $FullMenu->{$MenuUnit_hash_ref}[5] eq 'HASH' 3246 && $FullMenu->{$MenuUnit_hash_ref}[5] 3247 {$all_menu_items_array[$picknum-1]} && ($FullMenu-> 3248 {$MenuUnit_hash_ref}[5]{$all_menu_items_array[$picknum-1]} 3249 eq '*' || $all_menu_items_array[$picknum-1]=~ 3250 /$FullMenu->{$MenuUnit_hash_ref}[5]{ 3251 $all_menu_items_array[$picknum-1]}/)) { 3252 $mark=$mark_blank; 3253 substr($mark,-1)='*';$mark_flg=1; 3254 $SavePick->{$MenuUnit_hash_ref}{$picknum}='*'; 3255 } 3256 $picknum_for_display=$picknum; 3257 if (ref $FullMenu->{$MenuUnit_hash_ref}[8] eq 'HASH' 3258 && keys %{$FullMenu->{$MenuUnit_hash_ref}[8]} && 3259 exists $FullMenu->{$MenuUnit_hash_ref}[8] 3260 {$all_menu_items_array[$picknum-1]} 3261 && $FullMenu->{$MenuUnit_hash_ref}[8] 3262 {$all_menu_items_array[$picknum-1]}) { 3263 $picknum_for_display= 3264 $FullMenu->{$MenuUnit_hash_ref}[8] 3265 {$all_menu_items_array[$picknum-1]}; 3266 $mark=$mark_blank; 3267 if (exists $SavePick->{$MenuUnit_hash_ref} 3268 {$picknum_for_display} && 3269 $SavePick->{$MenuUnit_hash_ref} 3270 {$picknum_for_display}) { 3271 substr($mark,-1)=$SavePick->{$MenuUnit_hash_ref} 3272 {$picknum_for_display} 3273 } else { $mark=' ' } 3274 $mark_flg=1 unless $mark=~/^ +$/; 3275 $Persists->{$MenuUnit_hash_ref}{defaults}=1 3276 if $Persists->{$parent_menu}{defaults}; 3277 if ($FullMenu->{$MenuUnit_hash_ref}[9]) { 3278 $filtered_menu=1; 3279 } 3280 } 3281 $pn{$picknum_for_display}= 3282 [ $all_menu_items_array[$picknum-1],$picknum ]; 3283 my $scroll=' '; 3284 if (exists $MenuUnit_hash_ref->{Scroll} 3285 && ($MenuUnit_hash_ref->{Scroll}->[1] eq $picknum 3286 || $MenuUnit_hash_ref->{Scroll}->[0] eq $picknum)) { 3287 if ($MenuUnit_hash_ref->{Scroll}->[0]) { 3288 if ($MenuUnit_hash_ref->{Scroll}->[0] eq $picknum) { 3289 $MenuUnit_hash_ref->{Scroll}->[1]=$picknum; 3290 $MenuUnit_hash_ref->{Scroll}->[0]=0; 3291 $scroll='>'; 3292 } 3293 } else { 3294 $scroll='>'; 3295 } 3296 } 3297 my $picknum_display=sprintf "%-7s",$picknum_for_display; 3298 $menu_text.=" $scroll$mark $picknum_display" 3299 ."$all_menu_items_array[$picknum-1]\n"; 3300 if (exists $FullMenu->{$MenuUnit_hash_ref}[6] 3301 {$all_menu_items_array[$picknum-1]}) { 3302 my $tstt=$FullMenu->{$MenuUnit_hash_ref}[6] 3303 {$all_menu_items_array[$picknum-1]}; 3304 if ($tstt=~/many/i) { 3305 $MenuUnit_hash_ref->{Select}{$picknum_for_display}='many'; 3306 } 3307 } 3308 if ($mark=~/^ +$/ || (exists $picks{$picknum} || 3309 exists $picks{$picknum_for_display})) { 3310 ${$_[0]}[$picknum_for_display-1]= 3311 $all_menu_items_array[$picknum-1]; 3312 } 3313 $picknum++; 3314 $numlist--; 3315 } $hidedefaults=1;$picknum--; 3316 if ($Term::Menus::fullauto && (!exists 3317 $MenuUnit_hash_ref->{'NoPlan'} || 3318 !$MenuUnit_hash_ref->{'NoPlan'}) && 3319 $Net::FullAuto::FA_Core::makeplan && 3320 $Persists->{$MenuUnit_hash_ref}{defaults} && 3321 !$filtered_menu) { 3322 my %askmenu=( 3323 3324 Item_1 => { 3325 3326 Text => "Use the result saved with the \"Plan\"" 3327 3328 }, 3329 Item_2 => { 3330 3331 Text => "Use the \"Default\" setting to determine result" 3332 3333 }, 3334 NoPlan => 1, 3335 Banner => " FullAuto has determined that the ". 3336 &pw($MenuUnit_hash_ref) . 3337 " Menu has been\n". 3338 " configured with a \"Default\" setting." 3339 3340 ); 3341 my $answ=Menu(\%askmenu); 3342 if ($answ eq ']quit[') { 3343 return ']quit[' 3344 } 3345 if (-1==index $answ,'result saved') { 3346#print "IN MAKEPLAN3\n"; 3347 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{'Plan'}} && 3348 !exists $Net::FullAuto::FA_Core::makeplan->{'Title'}) { 3349 $Net::FullAuto::FA_Core::makeplan->{'Title'}=$pn{$numbor}[0]; 3350 } 3351 push @{$Net::FullAuto::FA_Core::makeplan->{'Plan'}}, 3352 { Menu => &pw($MenuUnit_hash_ref), 3353 Number => 'Default', 3354 PlanID => 3355 $Net::FullAuto::FA_Core::makeplan->{Number}, 3356 Item => '' }; 3357 $got_default=1; 3358 } 3359 } 3360 unless ($Persists->{unattended}) { 3361 if ($^O ne 'cygwin') { 3362 unless ($noclear) { 3363 if ($^O eq 'MSWin32' || $^O eq 'MSWin64') { 3364 system("cmd /c cls"); 3365 print "\n"; 3366 } else { 3367 print `${Term::Menus::clearpath}clear`."\n"; 3368 print $blanklines 3369 } 3370 } else { print $blanklines } 3371 } else { print $blanklines } 3372 print $menu_text;my $ch=0; 3373 if ($select_many || (keys %{${$MenuUnit_hash_ref}{Select}})) { 3374 print "\n"; 3375 unless (keys %{$FullMenu->{$MenuUnit_hash_ref}[1]}) { 3376 print " a. Select All";$ch=1; 3377 } 3378 if ($mark_flg==1 || $Persists->{$MenuUnit_hash_ref}{defaults}) { 3379 print " c. Clear All";#print "\n" if $ch; 3380 } 3381 print " f. FINISH\n"; 3382 if ($filtered_menu) { 3383 print "\n (Type '<' to return to previous Menu)\n"; 3384 } 3385 if ($Persists->{$MenuUnit_hash_ref}{defaults} && 3386 !$filtered_menu) { 3387 print "\n == Default Selections Exist! == ", 3388 "(Type '*' to view them)\n"; 3389 } 3390 } else { 3391 if ($Persists->{$MenuUnit_hash_ref}{defaults}) { 3392 print "\n", 3393 " c. Clear Default Selection.", 3394 " f. FINISH with Default Selection.\n"; 3395 if ($filtered_menu) { 3396 print "\n (Type '<' to return to previous Menu)\n"; 3397 } else { 3398 print "\n == Default Selection Exists! == ", 3399 "(Type '*' to view it)\n"; 3400 } 3401 } elsif ($filtered_menu) { 3402 print "\n (Type '<' to return to previous Menu)\n"; 3403 } 3404 } 3405 if ($display_this_many_items<$num_pick) { 3406 my $len=length $num_pick;my $pad=''; 3407 foreach my $n (1..$len) { 3408 $pad.=' '; 3409 } 3410 print $pad, 3411 "\n $num_pick Total Choices ", 3412 "[v][^] Scroll with ARROW keys ". 3413 " [F1] for HELP\n"; 3414 } else { print "\n \(Press [F1] for HELP\)\n" } 3415 if ($Term::Menus::term_input) { 3416 print "\n"; 3417 if (exists $MenuUnit_hash_ref->{Input} && 3418 $MenuUnit_hash_ref->{Input}) { 3419 ($numbor,$ikey)=rawInput(" \([ESC] to Quit\)". 3420 " Press ENTER when finished ",1); 3421 next unless ($ikey eq 'ENTER' || $ikey eq 'ESC' || 3422 $ikey eq 'UPARROW' || $ikey eq 'DOWNARROW' || 3423 $ikey eq 'LEFTARROW' || $ikey eq 'RIGHTARROW' || 3424 $ikey eq 'F1'); 3425 } elsif ($show_banner_only) { 3426 ($numbor,$ikey)=rawInput(" \([ESC] to Quit\)". 3427 " Press ENTER to continue ... "); 3428 3429 } else { 3430 ($numbor,$ikey)=rawInput(" \([ESC] to Quit\)". 3431 " PLEASE ENTER A CHOICE: "); 3432 } 3433 print "\n"; 3434 } else { 3435 if ($show_banner_only) { 3436 print "\n \([ESC] to Quit\)", 3437 " Press ENTER to continue ... "; 3438 } else { 3439 print "\n \([ESC] to Quit\)", 3440 " PLEASE ENTER A CHOICE: "; 3441 } 3442 $numbor=<STDIN>; 3443 } $picknum_for_display=$numbor;chomp $picknum_for_display; 3444 } elsif ($Persists->{$MenuUnit_hash_ref}{defaults}) { 3445 $numbor='f'; 3446 } elsif (wantarray && !$no_wantarray) { 3447 my $die="\n FATAL ERROR! - 'Unattended' mode cannot be\n" 3448 ." used without a Plan or Default\n" 3449 ." Selections being available."; 3450 return '',$die; 3451 } else { 3452 my $die="\n FATAL ERROR! - 'Unattended' mode cannot be\n" 3453 ." used without a Plan or Default\n" 3454 ." Selections being available."; 3455 die($die); 3456 } 3457 if ($numbor=~/^[Ff]$/ && 3458 ($Persists->{$MenuUnit_hash_ref}{defaults} || 3459 $filtered_menu)) { 3460 # FINISH 3461 delete $main::maintain_scroll_flag->{$MenuUnit_hash_ref} 3462 if defined $main::maintain_scroll_flag; 3463 my $choice='';my @keys=(); 3464 my $chosen=''; 3465 if ($filtered_menu) { 3466 $chosen=$parent_menu; 3467 return '-', 3468 $FullMenu,$Selected,$Conveyed, 3469 $SavePick,$SaveMMap,$SaveNext, 3470 $Persists,$parent_menu; 3471 } else { $chosen=$MenuUnit_hash_ref } 3472 @keys=keys %picks; 3473 if (-1==$#keys) { 3474 if ($Persists->{$MenuUnit_hash_ref}{defaults}) { 3475 if ($filtered_menu) { 3476 $chosen=$parent_menu; 3477 } 3478 my $it=${[keys %{${$FullMenu}{$chosen}[5]}]}[0]; 3479 my $def=${$FullMenu}{$chosen}[5]{$it}; 3480 $def='.*' if $def eq '*'; 3481 if ($def) { 3482 my $cnt=1; 3483 foreach my $item (@all_menu_items_array) { 3484 #sort @{[keys %{${$FullMenu}{$chosen}[5]}]}) { 3485 if ($item=~/$def/) { 3486 $picks{$cnt}='*'; 3487 push @keys, $item; 3488 } $cnt++ 3489 } 3490 } 3491 } else { 3492 @keys=keys %{$SavePick->{$parent_menu}}; 3493 if (-1==$#keys) { 3494 if ($^O ne 'cygwin') { 3495 unless ($noclear) { 3496 if ($^O eq 'MSWin32' || $^O eq 'MSWin64') { 3497 system("cmd /c cls"); 3498 print "\n"; 3499 } else { 3500 print `${Term::Menus::clearpath}clear`."\n"; 3501 } 3502 } else { print $blanklines } 3503 } else { print $blanklines } 3504 print "\n\n Attention USER! :\n\n ", 3505 "You have selected \"f\" to finish your\n", 3506 " selections, BUT -> You have not actually\n", 3507 " selected anything!\n\n Do you wish ", 3508 "to quit or re-attempt selecting?\n\n ", 3509 "Press [ESC] to quit or ENTER to continue ... "; 3510 if ($Term::Menus::term_input) { 3511 print "\n"; 3512 ($choice,$ikey)=rawInput(" \([ESC] to Quit\)". 3513 " PLEASE ENTER A CHOICE: "); 3514 print "\n"; 3515 } else { 3516 print " \([ESC] to Quit\)", 3517 "\n PLEASE ENTER A CHOICE: "; 3518 $choice=<STDIN>; 3519 } 3520 chomp($choice); 3521 next if lc($choice) ne 'quit'; 3522 return ']quit[' 3523 } 3524 } 3525 } 3526 my $return_values=0; 3527 sub numerically { $a <=> $b } 3528 my %dupseen=();my @pickd=(); 3529 foreach my $pk (sort numerically keys %picks) { 3530 $return_values=1 if !exists 3531 ${$FullMenu}{$chosen}[2]{${$_[0]}[$pk-1]} 3532 || !keys 3533 %{${$FullMenu}{$chosen}[2]{${$_[0]}[$pk-1]}}; 3534 if (${${$FullMenu}{$parent_menu}[10]}[$pk-1] && 3535 !${$_[0]}[$pk-1]) { 3536 my $txt=${${$FullMenu}{$parent_menu}[10]}[$pk-1]; 3537 if (-1<index $txt,"__Master_${$}__") { 3538 my $lhn=$Term::Menus::local_hostname; 3539 $txt=~s/__Master_${$}__/Local-Host: $lhn/sg; 3540 } 3541 unless (exists $dupseen{$txt}) { 3542 push @pickd, $txt; 3543 } $dupseen{$txt}=''; 3544 } elsif (${$_[0]}[$pk-1]) { 3545 my $txt=${$_[0]}[$pk-1]; 3546 if (-1<index $txt,"__Master_${$}__") { 3547 my $lhn=$Term::Menus::local_hostname; 3548 $txt=~s/__Master_${$}__/Local-Host: $lhn/sg; 3549 } 3550 unless (exists $dupseen{$txt}) { 3551 push @pickd, $txt; 3552 } $dupseen{$txt}=''; 3553 } elsif ($pn{$picknum}) { 3554 my $txt=$pn{$picknum}[0]; 3555 if (-1<index $txt,"__Master_${$}__") { 3556 my $lhn=$Term::Menus::local_hostname; 3557 $txt=~s/__Master_${$}__/Local-Host: $lhn/sg; 3558 } 3559 unless (exists $dupseen{$txt}) { 3560 push @pickd, $txt; 3561 } $dupseen{$txt}=''; 3562 } 3563 } 3564 if ($return_values && $Term::Menus::fullauto && 3565 (!exists ${$MenuUnit_hash_ref}{'NoPlan'} || 3566 !${$MenuUnit_hash_ref}{'NoPlan'}) && 3567 defined $Net::FullAuto::FA_Core::makeplan) { 3568#print "IN MAKEPLAN4\n"; 3569 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{'Plan'}} && 3570 !exists $Net::FullAuto::FA_Core::makeplan->{'Title'}) { 3571 $Net::FullAuto::FA_Core::makeplan->{'Title'}= 3572 "Multiple Selections"; 3573 } 3574 unless ($got_default) { 3575 push @{$Net::FullAuto::FA_Core::makeplan->{'Plan'}}, 3576 { Menu => &pw($MenuUnit_hash_ref), 3577 Number => 'Multiple', 3578 PlanID => 3579 $Net::FullAuto::FA_Core::makeplan->{Number}, 3580 Item => "'". 3581 &Data::Dump::Streamer::Dump(\@pickd)->Out(). 3582 "'" } 3583 } 3584 } 3585 return \@pickd if $return_values; 3586 return 'DONE'; 3587 } elsif ($numbor=~/^\s*%(.*)/s) { 3588 # PERCENT SYMBOL SORT ORDER 3589 my $one=$1||''; 3590 chomp $one; 3591 $one=qr/$one/ if $one; 3592 my @spl=(); 3593 chomp $numbor; 3594 my $cnt=0;my $ct=0;my @splice=(); 3595 my $sort_ed=''; 3596 if ($one) { 3597 3598 } elsif ($sorted && $sorted eq 'forward') { 3599 @spl=reverse @all_menu_items_array;$sort_ed='reverse'; 3600 } else { @spl=sort @all_menu_items_array;$sort_ed='forward' } 3601 next if $#spl==-1; 3602 my %sort=(); 3603 foreach my $line (@all_menu_items_array) { 3604 $cnt++; 3605 if (exists $pn{$picknum} && 3606 exists $FullMenu->{$MenuUnit_hash_ref}[8] 3607 {$pn{$picknum}[0]} && $FullMenu-> 3608 {$MenuUnit_hash_ref}[8]{$pn{$picknum}[0]} && 3609 ref $FullMenu->{$MenuUnit_hash_ref}[8] 3610 {$pn{$picknum}[0]} eq 'HASH' && 3611 keys %{$FullMenu->{$MenuUnit_hash_ref}[8] 3612 {$pn{$picknum}[0]}} && $FullMenu-> 3613 {$MenuUnit_hash_ref}[8]{$pn{$picknum}[0]}) { 3614 $sort{$line}=$FullMenu->{$MenuUnit_hash_ref}[8]{$line}; 3615 } else { $sort{$line}=$cnt } 3616 } $cnt=0; 3617 my $chosen=''; 3618 if (!$sorted) { 3619 my $send_select='Many' if $select_many; 3620 $chosen={ 3621 Select => $send_select, 3622 Banner => ${$MenuUnit_hash_ref}{Banner}, 3623 }; 3624 my $cnt=0; 3625 foreach my $text (@spl) { 3626 my $num=$sort{$text}; 3627 $cnt++; 3628 if (exists $picks{$num}) { 3629 $chosen->{'Item_'.$cnt}= 3630 { Text => $text,Default => '*',__NUM__=>$num }; 3631 } else { 3632 $chosen->{'Item_'.$cnt}= 3633 { Text => $text,__NUM__=>$num }; 3634 } 3635 $chosen->{'Item_'.$cnt}{Result}= 3636 ${${$MenuUnit_hash_ref}{${${$FullMenu} 3637 {$MenuUnit_hash_ref}[4]}{$text}}}{'Result'} 3638 if exists ${${$MenuUnit_hash_ref}{${${$FullMenu} 3639 {$MenuUnit_hash_ref}[4]}{$text}}}{'Result'}; 3640 $chosen->{'Item_'.$cnt}{Sort}=$sort_ed; 3641 $chosen->{'Item_'.$cnt}{Filter}=1; 3642 } $sorted=$sort_ed; 3643 } else { 3644 @all_menu_items_array=reverse @all_menu_items_array; 3645 next; 3646 } 3647 %{$SavePick->{$chosen}}=%picks; 3648 my @return_from_filtered_menu=(); 3649 eval { 3650 ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, 3651 $SaveMMap,$SaveNext,$Persists, 3652 @return_from_filtered_menu)=&Menu( 3653 $chosen,$picks_from_parent, 3654 $recurse_level,$FullMenu, 3655 $Selected,$Conveyed,$SavePick, 3656 $SaveMMap,$SaveNext,$Persists, 3657 $MenuUnit_hash_ref,$no_wantarray); 3658 }; # MENU RETURN MENURETURN 2 3659 print "MENU RETURN 2\n" if $menu_return_debug; 3660 die $@ if $@; 3661 if (-1<$#return_from_filtered_menu) { 3662 if ((values %{$menu_output})[0] eq 'recurse') { 3663 my %k=%{$menu_output}; 3664 delete $k{Menu}; 3665 my $lab=(keys %k)[0]; 3666 $menu_output=$labels{$lab}; 3667 } 3668 $MenuMap=$Persists->{$MenuUnit_hash_ref}; 3669 eval { 3670 ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, 3671 $SaveMMap,$SaveNext,$Persists)=&Menu( 3672 $menu_output,$FullMenu, 3673 $Selected,$Conveyed,$SavePick, 3674 $SaveMMap,$SaveNext,$Persists, 3675 $return_from_filtered_menu[0], 3676 $MenuUnit_hash_ref, 3677 $return_from_filtered_menu[2]); 3678 }; 3679 die $@ if $@; 3680 } 3681 chomp($menu_output) if !(ref $menu_output); 3682 if ($menu_output eq '-') { 3683 %picks=%{$SavePick->{$chosen}}; 3684 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 3685 } elsif ($menu_output eq '+') { 3686 %picks=%{$SavePick->{$chosen}}; 3687 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 3688 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 3689 } elsif ($menu_output eq 'DONE_SUB') { 3690 return 'DONE_SUB'; 3691 } elsif ($menu_output eq 'DONE') { 3692 if (1==$recurse_level) { 3693 my $subfile=substr($Term::Menus::fa_code,0,-3) 3694 .'::' if $Term::Menus::fa_code; 3695 $subfile||=''; 3696 foreach my $sub (&get_subs_from_menu($Selected)) { 3697 my @resu=(); 3698 if (ref $sub eq 'CODE') { 3699 if ($Term::Menus::fullauto && (!exists 3700 ${$MenuUnit_hash_ref}{'NoPlan'} || 3701 !${$MenuUnit_hash_ref}{'NoPlan'}) && 3702 defined $Net::FullAuto::FA_Core::makeplan) { 3703#print "IN MAKEPLAN5\n"; 3704 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 3705 'Plan'}} && !exists 3706 $Net::FullAuto::FA_Core::makeplan->{ 3707 'Title'}) { 3708 $Net::FullAuto::FA_Core::makeplan->{'Title'} 3709 =$pn{$numbor}[0]; 3710 } 3711 push @{$Net::FullAuto::FA_Core::makeplan->{ 3712 'Plan'}}, 3713 { Menu => &pw($MenuUnit_hash_ref), 3714 Number => $numbor, 3715 PlanID => 3716 $Net::FullAuto::FA_Core::makeplan->{ 3717 'Number'}, 3718 Item => 3719 &Data::Dump::Streamer::Dump($sub)->Out() } 3720 } 3721 eval { @resu=$sub->() }; 3722 if ($@) { 3723 if (10<length $@ && unpack('a11',$@) 3724 eq 'FATAL ERROR') { 3725 if ($parent_menu && wantarray && !$no_wantarray) { 3726 return '',$FullMenu,$Selected,$Conveyed, 3727 $SavePick,$SaveMMap,$SaveNext, 3728 $Persists,$parent_menu,$@; 3729 } 3730 if (defined $log_handle && 3731 -1<index $log_handle,'*') { 3732 print $log_handle $@; 3733 close($log_handle); 3734 } 3735 if ($Term::Menus::fullauto) { 3736 &Net::FullAuto::FA_Core::handle_error($@); 3737 } else { die $@ } 3738 } else { 3739 my $die="\n FATAL ERROR! - The Local " 3740 ."System $Term::Menus::local_hostname " 3741 ."Conveyed\n" 3742 ." the Following " 3743 ."Unrecoverable Error Condition :\n\n" 3744 ." $@\n line ".__LINE__; 3745 if ($parent_menu && wantarray && !$no_wantarray) { 3746 return '',$FullMenu,$Selected,$Conveyed, 3747 $SavePick,$SaveMMap,$SaveNext, 3748 $Persists,$parent_menu,$die; 3749 } 3750 if (defined $log_handle && 3751 -1<index $log_handle,'*') { 3752 print $log_handle $die; 3753 close($log_handle); 3754 } 3755 if ($Term::Menus::fullauto) { 3756 &Net::FullAuto::FA_Core::handle_error($die); 3757 } else { die $die } 3758 } 3759 } 3760 if (-1<$#resu) { 3761 if ($resu[0] eq '<') { %picks=();next } 3762 if (0<$#resu && wantarray && !$no_wantarray) { 3763 return @resu; 3764 } else { 3765 return return_result($resu[0], 3766 $MenuUnit_hash_ref,$Conveyed); 3767 } 3768 } 3769 $done=1;last 3770 } 3771 eval { 3772 if ($subfile) { 3773 $sub=~s/^[&]//; 3774 if ($Term::Menus::fullauto && (!exists 3775 ${$MenuUnit_hash_ref}{'NoPlan'} || 3776 !${$MenuUnit_hash_ref}{'NoPlan'}) && 3777 defined $Net::FullAuto::FA_Core::makeplan) { 3778#print "IN MAKEPLAN6\n"; 3779 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 3780 'Plan'}} && !exists 3781 $Net::FullAuto::FA_Core::makeplan->{ 3782 'Title'}) { 3783 $Net::FullAuto::FA_Core::makeplan->{'Title'} 3784 =$pn{$numbor}[0]; 3785 } 3786 push @{$Net::FullAuto::FA_Core::makeplan->{ 3787 'Plan'}}, 3788 { Menu => &pw($MenuUnit_hash_ref), 3789 Number => $numbor, 3790 PlanID => 3791 $Net::FullAuto::FA_Core::makeplan->{ 3792 'Number'}, 3793 Item => "&$subfile$sub" } 3794 } 3795 eval "\@resu=\&$subfile$sub"; 3796 my $firsterr=$@||''; 3797 if ((-1<index $firsterr,'Undefined subroutine') && 3798 (-1<index $firsterr,$sub)) { 3799 if ($sub!~/::/) { 3800 eval "\@resu=main::$sub"; 3801 } else { 3802 eval "\@resu=$sub"; 3803 } 3804 my $seconderr=$@||'';my $die=''; 3805 if ($seconderr=~/Undefined subroutine/) { 3806 if ($FullMenu->{$MenuUnit_hash_ref} 3807 [2]{$all_menu_items_array[$numbor-1]}) { 3808 $die="The \"Result15 =>\" Setting" 3809 ."\n\t\t-> " . ${$FullMenu} 3810 {$MenuUnit_hash_ref}[2] 3811 {$all_menu_items_array[$numbor-1]} 3812 ."\n\t\tFound in the Menu Unit -> " 3813 .$MenuUnit_hash_ref->{Name}."\n\t\t" 3814 ."Specifies a Subroutine" 3815 ." that Does NOT Exist" 3816 ."\n\t\tin the User Code File " 3817 .$Term::Menus::fa_code 3818 .",\n\t\tnor was a routine with " 3819 ."that name\n\t\tlocated in the" 3820 ." main:: script.\n"; 3821 } else { $die="$firsterr\n $seconderr" } 3822 } else { $die=$seconderr } 3823 &Net::FullAuto::FA_Core::handle_error($die); 3824 } elsif ($firsterr) { 3825 &Net::FullAuto::FA_Core::handle_error($firsterr); 3826 } 3827 } else { 3828 if ($sub!~/::/) { 3829 $sub=~s/^[&]//; 3830 eval "\@resu=main::$sub"; 3831 } else { 3832 eval "\@resu=$sub"; 3833 } 3834 die $@ if $@; 3835 } 3836 }; 3837 if ($@) { 3838 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 3839 if ($parent_menu && wantarray && !$no_wantarray) { 3840 return '',$FullMenu,$Selected,$Conveyed, 3841 $SavePick,$SaveMMap,$SaveNext, 3842 $Persists,$parent_menu,$@; 3843 } 3844 if (defined $log_handle && 3845 -1<index $log_handle,'*') { 3846 print $log_handle $@; 3847 close($log_handle); 3848 } 3849 if ($Term::Menus::fullauto) { 3850 &Net::FullAuto::FA_Core::handle_error($@); 3851 } else { die $@ } 3852 } else { 3853 my $die="\n FATAL ERROR! - The Local " 3854 ."System $Term::Menus::local_hostname " 3855 ."Conveyed\n" 3856 ." the Following " 3857 ."Unrecoverable Error Condition :\n\n" 3858 ." $@\n line ".__LINE__; 3859 if ($parent_menu && wantarray && !$no_wantarray) { 3860 return '',$FullMenu,$Selected,$Conveyed, 3861 $SavePick,$SaveMMap,$SaveNext, 3862 $Persists,$parent_menu,$die; 3863 } 3864 if (defined $log_handle && 3865 -1<index $log_handle,'*') { 3866 print $log_handle $die; 3867 close($log_handle); 3868 } 3869 if ($Term::Menus::fullauto) { 3870 &Net::FullAuto::FA_Core::handle_error($die); 3871 } else { die $die } 3872 } 3873 } 3874 if (-1<$#resu) { 3875 if ($resu[0] eq '<') { %picks=();next } 3876 if (0<$#resu && wantarray && !$no_wantarray) { 3877 return @resu; 3878 } else { 3879 return return_result($resu[0], 3880 $MenuUnit_hash_ref,$Conveyed); 3881 } 3882 } 3883 } 3884 return 'DONE_SUB'; 3885 } else { return 'DONE' } 3886 } elsif ($menu_output) { 3887 return $menu_output; 3888 } else { 3889 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 3890 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 3891 } 3892 } elsif ($numbor=~/^\*\s*$/s) { 3893 # SHOW DEFAULT SELECTIONS using STAR symbol 3894 if ($filtered_menu) { 3895 print "\n WARNING!: Only -ONE- Level of Filtering", 3896 " is Supported!\n"; 3897 sleep 2; 3898 last; 3899 } 3900 my @splice=(); 3901 my @spl=(); 3902 foreach my $key (keys %{$SavePick->{$parent_menu}}) { 3903 $picks{$key}='*'; 3904 } 3905 $SavePick->{$MenuUnit_hash_ref}||={}; 3906 foreach my $key (keys %picks) { 3907 if ($parent_menu) { 3908 $SavePick->{$parent_menu}->{$key}='*'; 3909 } else { 3910 $SavePick->{$MenuUnit_hash_ref}->{$key}='*'; 3911 } 3912 } 3913 if ($Persists->{$MenuUnit_hash_ref}{defaults}) { 3914 my $it=${[keys %{$FullMenu->{$MenuUnit_hash_ref}[5]}]}[0]; 3915 my $def=$FullMenu->{$MenuUnit_hash_ref}[5]{$it}; 3916 $def='.*' if $def eq '*'; 3917 if ($def) { 3918 my $cnt=1; 3919 foreach my $item (@all_menu_items_array) { 3920 if ($item=~/$def/) { 3921 $picks{$cnt}='*'; 3922 } $cnt++ 3923 } 3924 } 3925 } 3926 foreach my $pick (sort numerically keys %picks) { 3927 push @splice,($pick-1) 3928 } 3929 foreach my $spl (@splice) { 3930 push @spl, $FullMenu->{$MenuUnit_hash_ref}[10]->[$spl]; 3931 } 3932 my $send_select='Many' if $select_many; 3933 my $chosen={ 3934 Select => $send_select, 3935 Banner => $MenuUnit_hash_ref->{Banner}, 3936 }; my $cnt=0; 3937 my $hash_ref=$parent_menu||$MenuUnit_hash_ref; 3938 foreach my $text (@spl) { 3939 my $num=shift @splice; 3940 $cnt++; 3941 $chosen->{'Item_'.$cnt}= 3942 { Text => $text,Default => '*',__NUM__=>$num+1 }; 3943 $chosen->{'Item_'.$cnt}{Result}= 3944 ${${$MenuUnit_hash_ref}{${${$FullMenu} 3945 {$MenuUnit_hash_ref}[4]}{$text}}}{'Result'} 3946 if exists ${${$MenuUnit_hash_ref}{${${$FullMenu} 3947 {$MenuUnit_hash_ref}[4]}{$text}}}{'Result'}; 3948 $chosen->{'Item_'.$cnt}{Filter}=1; 3949 } 3950 %{$SavePick->{$chosen}}=%picks; 3951 $hidedefaults=1; 3952 eval { 3953 my ($ignore1,$ignore2,$ignore3)=('','',''); 3954 ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, 3955 $SaveMMap,$SaveNext,$Persists,$ignore1,$ignore2, 3956 $ignore3) 3957 =&Menu($chosen,$picks_from_parent, 3958 $recurse_level,$FullMenu, 3959 $Selected,$Conveyed,$SavePick, 3960 $SaveMMap,$SaveNext,$Persists, 3961 $MenuUnit_hash_ref,$no_wantarray); 3962 }; # MENU RETURN MENURETURN 3 3963 print "MENU RETURN 3\n" if $menu_return_debug; 3964 die $@ if $@; 3965 chomp($menu_output) if !(ref $menu_output); 3966 if ($menu_output eq '-') { 3967 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 3968 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 3969 } elsif ($menu_output eq '+') { 3970 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 3971 $start=${$FullMenu}{$MenuUnit_hash_ref}[11]; 3972 } elsif ($menu_output eq 'DONE_SUB') { 3973 return 'DONE_SUB'; 3974 } elsif ($menu_output eq 'DONE') { 3975 if (1==$recurse_level) { 3976 my $subfile=substr($Term::Menus::fa_code,0,-3) 3977 .'::' if $Term::Menus::fa_code; 3978 $subfile||=''; 3979 foreach my $sub (&get_subs_from_menu($Selected)) { 3980 my @resu=(); 3981 if (ref $sub eq 'CODE') { 3982 if ($Term::Menus::fullauto && (!exists 3983 ${$MenuUnit_hash_ref}{'NoPlan'} || 3984 !${$MenuUnit_hash_ref}{'NoPlan'}) && 3985 defined $Net::FullAuto::FA_Core::makeplan) { 3986#print "IN MAKEPLAN7\n"; 3987 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 3988 'Plan'}} && !exists 3989 $Net::FullAuto::FA_Core::makeplan->{ 3990 'Title'}) { 3991 $Net::FullAuto::FA_Core::makeplan->{'Title'} 3992 =$pn{$numbor}[0]; 3993 } 3994 my $n='Number'; 3995 push @{$Net::FullAuto::FA_Core::makeplan->{ 3996 'Plan'}}, 3997 { Menu => &pw($MenuUnit_hash_ref), 3998 Number => $numbor, 3999 PlanID => 4000 $Net::FullAuto::FA_Core::makeplan->{$n}, 4001 Item => 4002 &Data::Dump::Streamer::Dump($sub)->Out() } 4003 } 4004 eval { @resu=$sub->() }; 4005 if ($@) { 4006 if (10<length $@ && unpack('a11',$@) 4007 eq 'FATAL ERROR') { 4008 if ($parent_menu && wantarray && !$no_wantarray) { 4009 return '',$FullMenu,$Selected,$Conveyed, 4010 $SavePick,$SaveMMap,$SaveNext, 4011 $Persists,$parent_menu,$@; 4012 } 4013 if (defined $log_handle && 4014 -1<index $log_handle,'*') { 4015 print $log_handle $@; 4016 close($log_handle); 4017 } 4018 if ($Term::Menus::fullauto) { 4019 &Net::FullAuto::FA_Core::handle_error($@); 4020 } else { die $@ } 4021 } else { 4022 my $die="\n FATAL ERROR! - The Local " 4023 ."System $Term::Menus::local_hostname " 4024 ."Conveyed\n" 4025 ." the Following " 4026 ."Unrecoverable Error Condition :\n\n" 4027 ." $@\n line ".__LINE__; 4028 if ($parent_menu && wantarray && !$no_wantarray) { 4029 return '',$FullMenu,$Selected,$Conveyed, 4030 $SavePick,$SaveMMap,$SaveNext, 4031 $Persists,$parent_menu,$die; 4032 } 4033 if (defined $log_handle && 4034 -1<index $log_handle,'*') { 4035 print $log_handle $die; 4036 close($log_handle); 4037 } 4038 if ($Term::Menus::fullauto) { 4039 &Net::FullAuto::FA_Core::handle_error($die); 4040 } else { die $die } 4041 } 4042 } 4043 if (-1<$#resu) { 4044 if ($resu[0] eq '<') { %picks=();next } 4045 if (0<$#resu && wantarray && !$no_wantarray) { 4046 return @resu; 4047 } else { 4048 return return_result($resu[0], 4049 $MenuUnit_hash_ref,$Conveyed); 4050 } 4051 } 4052 $done=1;last 4053 } 4054 eval { 4055 if ($subfile) { 4056 $sub=~s/^[&]//; 4057 if ($Term::Menus::fullauto && (!exists 4058 ${$MenuUnit_hash_ref}{'NoPlan'} || 4059 !${$MenuUnit_hash_ref}{'NoPlan'}) && 4060 defined $Net::FullAuto::FA_Core::makeplan) { 4061#print "IN MAKEPLAN8\n"; 4062 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 4063 'Plan'}} && !exists 4064 $Net::FullAuto::FA_Core::makeplan->{ 4065 'Title'}) { 4066 $Net::FullAuto::FA_Core::makeplan->{'Title'} 4067 =$pn{$numbor}[0]; 4068 } 4069 my $n='Number'; 4070 push @{$Net::FullAuto::FA_Core::makeplan->{ 4071 'Plan'}}, 4072 { Menu => &pw($MenuUnit_hash_ref), 4073 Number => $numbor, 4074 PlanID => 4075 $Net::FullAuto::FA_Core::makeplan->{$n}, 4076 Item => "&$subfile$sub" } 4077 } 4078 eval "\@resu=\&$subfile$sub"; 4079 my $firsterr=$@||''; 4080 if ((-1<index $firsterr,'Undefined subroutine') && 4081 (-1<index $firsterr,$sub)) { 4082 if ($sub!~/::/) { 4083 eval "\@resu=main::$sub"; 4084 } else { 4085 eval "\@resu=$sub"; 4086 } 4087 my $seconderr=$@||'';my $die=''; 4088 if ($seconderr=~/Undefined subroutine/) { 4089 if (${$FullMenu}{$MenuUnit_hash_ref} 4090 [2]{$all_menu_items_array[$numbor-1]}) { 4091 $die="The \"Result15 =>\" Setting" 4092 ."\n\t\t-> " . ${$FullMenu} 4093 {$MenuUnit_hash_ref}[2] 4094 {$all_menu_items_array[$numbor-1]} 4095 ."\n\t\tFound in the Menu Unit -> " 4096 .$MenuUnit_hash_ref->{Name}."\n\t\t" 4097 ."Specifies a Subroutine" 4098 ." that Does NOT Exist" 4099 ."\n\t\tin the User Code File " 4100 .$Term::Menus::fa_code 4101 .",\n\t\tnor was a routine with " 4102 ."that name\n\t\tlocated in the" 4103 ." main:: script.\n"; 4104 } else { $die="$firsterr\n $seconderr" } 4105 } else { $die=$seconderr } 4106 &Net::FullAuto::FA_Core::handle_error($die); 4107 } elsif ($firsterr) { 4108 &Net::FullAuto::FA_Core::handle_error($firsterr); 4109 } 4110 } else { 4111 if ($sub!~/::/) { 4112 $sub=~s/^[&]//; 4113 eval "\@resu=main::$sub"; 4114 } else { 4115 eval "\@resu=$sub"; 4116 } 4117 die $@ if $@; 4118 } 4119 }; 4120 if ($@) { 4121 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 4122 if ($parent_menu && wantarray && !$no_wantarray) { 4123 return '',$FullMenu,$Selected,$Conveyed, 4124 $SavePick,$SaveMMap,$SaveNext, 4125 $Persists,$parent_menu,$@; 4126 } 4127 if (defined $log_handle && 4128 -1<index $log_handle,'*') { 4129 print $log_handle $@; 4130 close($log_handle); 4131 } 4132 if ($Term::Menus::fullauto) { 4133 &Net::FullAuto::FA_Core::handle_error($@); 4134 } else { die $@ } 4135 } else { 4136 my $die="\n FATAL ERROR! - The Local " 4137 ."System $Term::Menus::local_hostname " 4138 ."Conveyed\n" 4139 ." the Following " 4140 ."Unrecoverable Error Condition :\n\n" 4141 ." $@\n line ".__LINE__; 4142 if ($parent_menu && wantarray && !$no_wantarray) { 4143 return '',$FullMenu,$Selected,$Conveyed, 4144 $SavePick,$SaveMMap,$SaveNext, 4145 $Persists,$parent_menu,$die; 4146 } 4147 if (defined $log_handle && 4148 -1<index $log_handle,'*') { 4149 print $log_handle $die; 4150 close($log_handle); 4151 } 4152 if ($Term::Menus::fullauto) { 4153 &Net::FullAuto::FA_Core::handle_error($die); 4154 } else { die $die } 4155 } 4156 } 4157 if (-1<$#resu) { 4158 if ($resu[0] eq '<') { %picks=();next } 4159 if (0<$#resu && wantarray && !$no_wantarray) { 4160 return @resu; 4161 } else { 4162 return return_result($resu[0], 4163 $MenuUnit_hash_ref,$Conveyed); 4164 } 4165 } 4166 } 4167 return 'DONE_SUB'; 4168 } else { return 'DONE' } 4169 } elsif ($menu_output) { 4170 return $menu_output; 4171 } else { 4172 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 4173 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 4174 } 4175 } elsif ($numbor=~/^\s*\/(.+)$/s) { 4176 ## SLASH SEARCH 4177 if ($filtered_menu) { 4178 print "\n WARNING!: ", 4179 "Only -ONE- Level of Search is Supported!\n"; 4180 sleep 2; 4181 last; 4182 } 4183 my $one=$1||''; 4184 chomp $one; 4185 $one=~s/\*/[\*]/g; 4186 $one=~s/\+/[\+]/g; 4187 $one=qr/$one/ if $one; 4188 my @spl=(); 4189 chomp $numbor; 4190 my $def=''; 4191 unless (exists $Persists->{$MenuUnit_hash_ref}{defaults}) { 4192 my $it=${[keys %{${$FullMenu}{$MenuUnit_hash_ref}[5]}]}[0]; 4193 $def=${$FullMenu}{$MenuUnit_hash_ref}[5]{$it}; 4194 $def='.*' if $def eq '*'; 4195 if ($def) { 4196 my $cnt=1; 4197 foreach my $item (sort 4198 @{[keys %{${$FullMenu}{$MenuUnit_hash_ref}[5]}]}) { 4199 if ($item=~/$def/) { 4200 $picks{$cnt}='*'; 4201 } $cnt++ 4202 } 4203 } 4204 } 4205 4206 my $cnt=0;my $ct=0;my @splice=(); 4207 foreach my $pik (@all_menu_items_array) { 4208 $cnt++; 4209 if ($pik=~/$one/s) { 4210 push @spl, $pik; 4211 $splice[$ct++]=$cnt; 4212 } 4213 } 4214 next if $#spl==-1; 4215 my $send_select='Many' if $select_many; 4216 my $chosen={ 4217 Select => $send_select, 4218 Banner => ${$MenuUnit_hash_ref}{Banner}, 4219 }; $cnt=0; 4220 foreach my $text (@spl) { 4221 my $num=$splice[$cnt]; 4222 $cnt++; 4223 if (exists $picks{$num}) { 4224 $chosen->{'Item_'.$cnt}= 4225 { Text => $text,Default => '*',__NUM__=>$num }; 4226 } elsif ($def && $text=~/$def/) { 4227 $chosen->{'Item_'.$cnt}= 4228 { Text => $text,Default => '*',__NUM__=>$num }; 4229 $picks{$num}='*'; 4230 } else { 4231 $chosen->{'Item_'.$cnt}= 4232 { Text => $text,__NUM__=>$num }; 4233 } 4234 $chosen->{'Item_'.$cnt}{Result}= 4235 ${${$MenuUnit_hash_ref}{${$FullMenu-> 4236 {$MenuUnit_hash_ref}[4]}{$text}}}{'Result'} 4237 if exists ${${$MenuUnit_hash_ref}{${$FullMenu-> 4238 {$MenuUnit_hash_ref}[4]}{$text}}}{'Result'}; 4239 $chosen->{'Item_'.$cnt}{Filter}=1; 4240 } 4241 %{$SavePick->{$chosen}}=%picks; 4242 my @return_from_filtered_menu=(); 4243 eval { 4244 ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, 4245 $SaveMMap,$SaveNext,$Persists, 4246 @return_from_filtered_menu)=&Menu( 4247 $chosen,$picks_from_parent, 4248 $recurse_level,$FullMenu, 4249 $Selected,$Conveyed,$SavePick, 4250 $SaveMMap,$SaveNext,$Persists, 4251 $MenuUnit_hash_ref,$no_wantarray); 4252 }; # MENU RETURN MENURETURN 4 4253 print "MENU RETURN 4\n" if $menu_return_debug; 4254 die $@ if $@; 4255 if (-1<$#return_from_filtered_menu) { 4256 if ((values %{$menu_output})[0] eq 'recurse') { 4257 my %k=%{$menu_output}; 4258 delete $k{Menu}; 4259 my $lab=(keys %k)[0]; 4260 $menu_output=$labels{$lab}; 4261 } 4262 $MenuMap=$Persists->{$MenuUnit_hash_ref}; 4263 eval { 4264 ($menu_output,$FullMenu,$Selected,$Conveyed,$SavePick, 4265 $SaveMMap,$SaveNext,$Persists)=&Menu( 4266 $menu_output,$FullMenu, 4267 $Selected,$Conveyed,$SavePick, 4268 $SaveMMap,$SaveNext,$Persists, 4269 $return_from_filtered_menu[0], 4270 $MenuUnit_hash_ref, 4271 $return_from_filtered_menu[2]); 4272 }; # MENU RETURN MENURETURN 5 4273 print "MENU RETURN 5\n" if $menu_return_debug; 4274 die $@ if $@; 4275 } 4276 chomp($menu_output) if !(ref $menu_output); 4277 if (($menu_output eq '-') && exists 4278 $SavePick->{$MenuUnit_hash_ref}) { 4279 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 4280 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 4281 } elsif ($menu_output eq '+' && exists 4282 $SavePick->{$MenuUnit_hash_ref}) { 4283 %picks=%{$SavePick->{$MenuUnit_hash_ref}}; 4284 $start=$FullMenu->{$MenuUnit_hash_ref}[11]; 4285 } elsif ($menu_output eq 'DONE_SUB') { 4286 return 'DONE_SUB'; 4287 } elsif ($menu_output eq 'DONE') { 4288 if (1==$recurse_level) { 4289 my $subfile=substr($Term::Menus::fa_code,0,-3) 4290 .'::' if $Term::Menus::fa_code; 4291 $subfile||=''; 4292 foreach my $sub (&get_subs_from_menu($Selected)) { 4293 my @resu=(); 4294 if (ref $sub eq 'CODE') { 4295 if ($Term::Menus::fullauto && (!exists 4296 $MenuUnit_hash_ref->{'NoPlan'} || 4297 !$MenuUnit_hash_ref->{'NoPlan'}) && 4298 defined $Net::FullAuto::FA_Core::makeplan) { 4299#print "IN MAKEPLAN9\n"; 4300 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 4301 'Plan'}} && !exists 4302 $Net::FullAuto::FA_Core::makeplan->{ 4303 'Title'}) { 4304 $Net::FullAuto::FA_Core::makeplan->{'Title'} 4305 =$pn{$numbor}[0]; 4306 } 4307 my $n='Number'; 4308 push @{$Net::FullAuto::FA_Core::makeplan->{ 4309 'Plan'}}, 4310 { Menu => &pw($MenuUnit_hash_ref), 4311 Number => $numbor, 4312 PlanID => 4313 $Net::FullAuto::FA_Core::makeplan->{$n}, 4314 Item => 4315 &Data::Dump::Streamer::Dump($sub)->Out() } 4316 } 4317 eval { @resu=$sub->() }; 4318 if ($@) { 4319 if (10<length $@ && unpack('a11',$@) eq 4320 'FATAL ERROR') { 4321 if ($parent_menu && wantarray && !$no_wantarray) { 4322 return '',$FullMenu,$Selected,$Conveyed, 4323 $SavePick,$SaveMMap,$SaveNext, 4324 $Persists,$parent_menu,$@; 4325 } 4326 if (defined $log_handle && 4327 -1<index $log_handle,'*') { 4328 print $log_handle $@; 4329 close($log_handle); 4330 } 4331 if ($Term::Menus::fullauto) { 4332 &Net::FullAuto::FA_Core::handle_error($@); 4333 } else { die $@ } 4334 } else { 4335 my $die="\n FATAL ERROR! - The Local " 4336 ."System $Term::Menus::local_hostname " 4337 ."Conveyed\n" 4338 ." the Following " 4339 ."Unrecoverable Error Condition :\n\n" 4340 ." $@\n line ".__LINE__; 4341 if ($parent_menu && wantarray && !$no_wantarray) { 4342 return '',$FullMenu,$Selected,$Conveyed, 4343 $SavePick,$SaveMMap,$SaveNext, 4344 $Persists,$parent_menu,$die; 4345 } 4346 if (defined $log_handle && 4347 -1<index $log_handle,'*') { 4348 print $log_handle $die; 4349 close($log_handle); 4350 } 4351 if ($Term::Menus::fullauto) { 4352 &Net::FullAuto::FA_Core::handle_error($die); 4353 } else { die $die } 4354 } 4355 } 4356 if (-1<$#resu) { 4357 if ($resu[0] eq '<') { %picks=();next } 4358 if (0<$#resu && wantarray && !$no_wantarray) { 4359 return @resu; 4360 } else { 4361 return return_result($resu[0], 4362 $MenuUnit_hash_ref,$Conveyed); 4363 } 4364 } 4365 $done=1;last 4366 } 4367 eval { 4368 if ($subfile) { 4369 $sub=~s/^[&]//; 4370 if ($Term::Menus::fullauto && (!exists 4371 $MenuUnit_hash_ref->{'NoPlan'} || 4372 !$MenuUnit_hash_ref->{'NoPlan'}) && 4373 defined $Net::FullAuto::FA_Core::makeplan) { 4374#print "IN MAKEPLAN10\n"; 4375 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 4376 'Plan'}} && !exists 4377 $Net::FullAuto::FA_Core::makeplan->{ 4378 'Title'}) { 4379 $Net::FullAuto::FA_Core::makeplan->{'Title'} 4380 =$pn{$numbor}[0]; 4381 } 4382 my $n='Number'; 4383 push @{$Net::FullAuto::FA_Core::makeplan->{ 4384 'Plan'}}, 4385 { Menu => &pw($MenuUnit_hash_ref), 4386 Number => $numbor, 4387 PlanID => 4388 $Net::FullAuto::FA_Core::makeplan->{$n}, 4389 Item => "&$subfile$sub" } 4390 } 4391 eval "\@resu=\&$subfile$sub"; 4392 my $firsterr=$@||''; 4393 if ((-1<index $firsterr,'Undefined subroutine') && 4394 (-1<index $firsterr,$sub)) { 4395 if ($sub!~/::/) { 4396 eval "\@resu=main::$sub"; 4397 } else { 4398 eval "\@resu=$sub"; 4399 } 4400 my $seconderr=$@||'';my $die=''; 4401 if ($seconderr=~/Undefined subroutine/) { 4402 if (${$FullMenu}{$MenuUnit_hash_ref} 4403 [2]{$all_menu_items_array[$numbor-1]}) { 4404 $die="The \"Result15 =>\" Setting" 4405 ."\n\t\t-> " . ${$FullMenu} 4406 {$MenuUnit_hash_ref}[2] 4407 {$all_menu_items_array[$numbor-1]} 4408 ."\n\t\tFound in the Menu Unit -> " 4409 .$MenuUnit_hash_ref->{Name}."\n\t\t" 4410 ."Specifies a Subroutine" 4411 ." that Does NOT Exist" 4412 ."\n\t\tin the User Code File " 4413 .$Term::Menus::fa_code 4414 .",\n\t\tnor was a routine with " 4415 ."that name\n\t\tlocated in the" 4416 ." main:: script.\n"; 4417 } else { $die="$firsterr\n $seconderr" } 4418 } else { $die=$seconderr } 4419 &Net::FullAuto::FA_Core::handle_error($die); 4420 } elsif ($firsterr) { 4421 &Net::FullAuto::FA_Core::handle_error($firsterr); 4422 } 4423 } else { 4424 if ($sub!~/::/) { 4425 $sub=~s/^[&]//; 4426 eval "\@resu=main::$sub"; 4427 } else { 4428 eval "\@resu=$sub"; 4429 } 4430 die $@ if $@; 4431 } 4432 }; 4433 if ($@) { 4434 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 4435 if ($parent_menu && wantarray && !$no_wantarray) { 4436 return '',$FullMenu,$Selected,$Conveyed, 4437 $SavePick,$SaveMMap,$SaveNext, 4438 $Persists,$parent_menu,$@; 4439 } 4440 if (defined $log_handle && 4441 -1<index $log_handle,'*') { 4442 print $log_handle $@; 4443 close($log_handle); 4444 } 4445 if ($Term::Menus::fullauto) { 4446 &Net::FullAuto::FA_Core::handle_error($@); 4447 } else { die $@ } 4448 } else { 4449 my $die="\n FATAL ERROR! - The Local " 4450 ."System $Term::Menus::local_hostname " 4451 ."Conveyed\n" 4452 ." the Following " 4453 ."Unrecoverable Error Condition :\n\n" 4454 ." $@\n line ".__LINE__; 4455 if ($parent_menu && wantarray && !$no_wantarray) { 4456 return '',$FullMenu,$Selected,$Conveyed, 4457 $SavePick,$SaveMMap,$SaveNext, 4458 $Persists,$parent_menu,$die; 4459 } 4460 if (defined $log_handle && 4461 -1<index $log_handle,'*') { 4462 print $log_handle $die; 4463 close($log_handle); 4464 } 4465 if ($Term::Menus::fullauto) { 4466 &Net::FullAuto::FA_Core::handle_error($die); 4467 } else { die $die } 4468 } 4469 } 4470 if (-1<$#resu) { 4471 if ($resu[0] eq '<') { %picks=();next } 4472 if (0<$#resu && wantarray && !$no_wantarray) { 4473 return @resu; 4474 } else { 4475 return return_result($resu[0], 4476 $MenuUnit_hash_ref,$Conveyed); 4477 } 4478 } 4479 } 4480 return 'DONE_SUB'; 4481 } else { return 'DONE' } 4482 } elsif ($menu_output eq '-') { 4483 $return_from_child_menu='-'; 4484 } elsif ($menu_output eq '+') { 4485 $return_from_child_menu='+'; 4486 } elsif ($menu_output) { 4487 return $menu_output; 4488 } 4489 } elsif (($numbor=~/^\</ || $ikey eq 'LEFTARROW') && $FullMenu) { 4490 if ($recurse_level==1) { 4491 print "\n WARNING! - You are at the First Menu!\n"; 4492 sleep 2; 4493 } elsif (grep { /\+|\*/ } values %picks) { 4494 return '+', 4495 $FullMenu,$Selected,$Conveyed, 4496 $SavePick,$SaveMMap,$SaveNext, 4497 $Persists; 4498 } else { 4499 my %sp_copy=%{$SavePick->{$parent_menu}} 4500 if exists $SavePick->{$parent_menu}; 4501 foreach my $key (keys %sp_copy) { 4502 $SavePick->{$parent_menu}->{$key}='-' if 4503 $sp_copy{$key} eq '+'; 4504 } 4505 $parent_menu->{Scroll}->[1]||=0; 4506 $main::maintain_scroll_flag||={}; 4507 if ($parent_menu->{Scroll}->[1]>1 && 4508 !exists $main::maintain_scroll_flag->{$parent_menu}) { 4509 --$parent_menu->{Scroll}->[1]; 4510 $main::maintain_scroll_flag->{$parent_menu}=''; 4511 } 4512 return '-', 4513 $FullMenu,$Selected,$Conveyed, 4514 $SavePick,$SaveMMap,$SaveNext, 4515 $Persists; 4516 } last; 4517 } elsif (($numbor=~/^\>/ || $ikey eq 'RIGHTARROW') && exists 4518 $SaveNext->{$MenuUnit_hash_ref} && 4519 ((grep { /-|\+/ } values %picks) || $show_banner_only)) { 4520 $MenuMap=$SaveMMap->{$MenuUnit_hash_ref}; 4521 my $returned_FullMenu=''; 4522 my $returned_Selected=''; 4523 my $returned_Conveyed=''; 4524 my $returned_SavePick=''; 4525 my $returned_SaveMMap=''; 4526 my $returned_SaveNext=''; 4527 my $returned_Persists=''; 4528 my $menu_result=''; 4529 if (exists $Selected->{$MenuUnit_hash_ref} 4530 {'__FA_Banner__'}) { 4531 $menu_result=$Selected->{$MenuUnit_hash_ref} 4532 {'__FA_Banner__'}; 4533 $menu_result=$menu_result->() if ref 4534 $menu_result eq 'CODE'; 4535 } else { 4536 $menu_result=$FullMenu->{$MenuUnit_hash_ref}[2] 4537 {$all_menu_items_array[(keys %{$SavePick-> 4538 {$MenuUnit_hash_ref}})[0]-1]}; 4539 } 4540 eval { 4541 ($menu_output,$returned_FullMenu, 4542 $returned_Selected,$returned_Conveyed, 4543 $returned_SavePick,$returned_SaveMMap, 4544 $returned_SaveNext,$returned_Persists) 4545 =&Menu($menu_result,$convey, 4546 $recurse_level,$FullMenu, 4547 $Selected,$Conveyed,$SavePick, 4548 $SaveMMap,$SaveNext,$Persists, 4549 $MenuUnit_hash_ref,$no_wantarray); 4550 }; # MENU RETURN MENURETURN 6 4551 print "MENU RETURN 6\n" if $menu_return_debug; 4552 die $@ if $@; 4553 chomp($menu_output) if !(ref $menu_output); 4554 if (ref $menu_output eq 'ARRAY' && 4555 $menu_output->[0]=~/^[{](.*)[}][<]$/) { 4556 delete $Selected->{$MenuUnit_hash_ref}; 4557 delete $Conveyed->{$MenuUnit_hash_ref}; 4558 delete $SavePick->{$MenuUnit_hash_ref}; 4559 delete $SaveMMap->{$MenuUnit_hash_ref}; 4560 delete $SaveNext->{$MenuUnit_hash_ref}; 4561 delete $Persists->{$MenuUnit_hash_ref}; 4562 if ($1 eq $MenuUnit_hash_ref->{Name}) { 4563 delete $FullMenu->{$MenuUnit_hash_ref}[2] 4564 {'__FA_Banner__'}; 4565 %picks=(); 4566 next; 4567 } else { 4568 delete $FullMenu->{$MenuUnit_hash_ref}; 4569 return $menu_output, 4570 $FullMenu,$Selected,$Conveyed, 4571 $SavePick,$SaveMMap,$SaveNext, 4572 $Persists; 4573 } 4574 } else { 4575 $FullMenu=$returned_FullMenu; 4576 $Selected=$returned_Selected; 4577 $Conveyed=$returned_Conveyed; 4578 $SavePick=$returned_SavePick; 4579 $SaveMMap=$returned_SaveMMap; 4580 $SaveNext=$returned_SaveNext; 4581 $Persists=$returned_Persists; 4582 } 4583 if ($menu_output eq 'DONE_SUB') { 4584 return 'DONE_SUB'; 4585 } elsif ($menu_output eq 'DONE') { 4586 if (1==$recurse_level) { 4587 if ($Term::Menus::fullauto && (!exists 4588 $MenuUnit_hash_ref->{'NoPlan'} || 4589 !$MenuUnit_hash_ref->{'NoPlan'}) && 4590 defined $Net::FullAuto::FA_Core::makeplan) { 4591#print "IN MAKEPLAN11\n"; 4592 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{'Plan'}} && 4593 !exists $Net::FullAuto::FA_Core::makeplan->{ 4594 'Title'}) { 4595 $Net::FullAuto::FA_Core::makeplan->{'Title'} 4596 =$pn{$numbor}[0]; 4597 } 4598 unless ($got_default) { 4599 push @{$Net::FullAuto::FA_Core::makeplan->{'Plan'}}, 4600 { Menu => &pw($MenuUnit_hash_ref), 4601 Number => $numbor, 4602 PlanID => 4603 $Net::FullAuto::FA_Core::makeplan->{Number}, 4604 Item => $pn{$numbor}[0] } 4605 } 4606 } 4607 my $subfile=substr($Term::Menus::fa_code,0,-3) 4608 .'::' if $Term::Menus::fa_code; 4609 $subfile||=''; 4610 foreach my $sub (&get_subs_from_menu($Selected)) { 4611 my @resu=(); 4612 if (ref $sub eq 'CODE') { 4613 if ($Term::Menus::fullauto && (!exists 4614 ${$MenuUnit_hash_ref}{'NoPlan'} || 4615 !${$MenuUnit_hash_ref}{'NoPlan'}) && 4616 defined $Net::FullAuto::FA_Core::makeplan) { 4617#print "IN MAKEPLAN12\n"; 4618 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 4619 'Plan'}} && !exists 4620 $Net::FullAuto::FA_Core::makeplan->{ 4621 'Title'}) { 4622 $Net::FullAuto::FA_Core::makeplan->{'Title'} 4623 =$pn{$numbor}[0]; 4624 } 4625 my $n='Number'; 4626 push @{$Net::FullAuto::FA_Core::makeplan->{ 4627 'Plan'}}, 4628 { Menu => &pw($MenuUnit_hash_ref), 4629 Number => $numbor, 4630 PlanID => 4631 $Net::FullAuto::FA_Core::makeplan->{$n}, 4632 Item => 4633 &Data::Dump::Streamer::Dump($sub)->Out() } 4634 } 4635 eval { @resu=$sub->() }; 4636 if ($@) { 4637 if (10<length $@ && unpack('a11',$@) 4638 eq 'FATAL ERROR') { 4639 if ($parent_menu && wantarray && !$no_wantarray) { 4640 return '',$FullMenu,$Selected,$Conveyed, 4641 $SavePick,$SaveMMap,$SaveNext, 4642 $Persists,$parent_menu,$@; 4643 } 4644 if (defined $log_handle && 4645 -1<index $log_handle,'*') { 4646 print $log_handle $@; 4647 close($log_handle); 4648 } 4649 if ($Term::Menus::fullauto) { 4650 &Net::FullAuto::FA_Core::handle_error($@); 4651 } else { die $@ } 4652 } else { 4653 my $die="\n FATAL ERROR! - The Local " 4654 ."System $Term::Menus::local_hostname " 4655 ."Conveyed\n" 4656 ." the Following " 4657 ."Unrecoverable Error Condition :\n\n" 4658 ." $@\n line ".__LINE__; 4659 if ($parent_menu && wantarray && !$no_wantarray) { 4660 return '',$FullMenu,$Selected,$Conveyed, 4661 $SavePick,$SaveMMap,$SaveNext, 4662 $Persists,$parent_menu,$die; 4663 } 4664 if (defined $log_handle && 4665 -1<index $log_handle,'*') { 4666 print $log_handle $die; 4667 close($log_handle); 4668 } 4669 if ($Term::Menus::fullauto) { 4670 &Net::FullAuto::FA_Core::handle_error($die); 4671 } else { die $die } 4672 } 4673 } 4674 if (-1<$#resu) { 4675 if ($resu[0] eq '<') { %picks=();next } 4676 if (0<$#resu && wantarray && !$no_wantarray) { 4677 return @resu; 4678 } else { 4679 return return_result($resu[0], 4680 $MenuUnit_hash_ref,$Conveyed); 4681 } 4682 } 4683 $done=1;last 4684 } 4685 eval { 4686 if ($subfile) { 4687 $sub=~s/^[&]//; 4688 if ($Term::Menus::fullauto && (!exists 4689 ${$MenuUnit_hash_ref}{'NoPlan'} || 4690 !${$MenuUnit_hash_ref}{'NoPlan'}) && 4691 defined $Net::FullAuto::FA_Core::makeplan) { 4692#print "IN MAKEPLAN13\n"; 4693 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 4694 'Plan'}} && !exists 4695 $Net::FullAuto::FA_Core::makeplan->{ 4696 'Title'}) { 4697 $Net::FullAuto::FA_Core::makeplan->{'Title'} 4698 =$pn{$numbor}[0]; 4699 } 4700 my $n='Number'; 4701 push @{$Net::FullAuto::FA_Core::makeplan->{ 4702 'Plan'}}, 4703 { Menu => &pw($MenuUnit_hash_ref), 4704 Number => $numbor, 4705 PlanID => 4706 $Net::FullAuto::FA_Core::makeplan->{$n}, 4707 Item => "&$subfile$sub" } 4708 } 4709 eval "\@resu=\&$subfile$sub"; 4710 my $firsterr=$@||''; 4711 if ((-1<index $firsterr,'Undefined subroutine') && 4712 (-1<index $firsterr,$sub)) { 4713 if ($sub!~/::/) { 4714 eval "\@resu=main::$sub"; 4715 } else { 4716 eval "\@resu=$sub"; 4717 } 4718 my $seconderr=$@||'';my $die=''; 4719 if ($seconderr=~/Undefined subroutine/) { 4720 if (${$FullMenu}{$MenuUnit_hash_ref} 4721 [2]{$all_menu_items_array[$numbor-1]}) { 4722 $die="The \"Result15 =>\" Setting" 4723 ."\n\t\t-> " . ${$FullMenu} 4724 {$MenuUnit_hash_ref}[2] 4725 {$all_menu_items_array[$numbor-1]} 4726 ."\n\t\tFound in the Menu Unit -> " 4727 .$MenuUnit_hash_ref->{Name}."\n\t\t" 4728 ."Specifies a Subroutine" 4729 ." that Does NOT Exist" 4730 ."\n\t\tin the User Code File " 4731 .$Term::Menus::fa_code 4732 .",\n\t\tnor was a routine with " 4733 ."that name\n\t\tlocated in the" 4734 ." main:: script.\n"; 4735 } else { $die="$firsterr\n $seconderr" } 4736 } else { $die=$seconderr } 4737 &Net::FullAuto::FA_Core::handle_error($die); 4738 } elsif ($firsterr) { 4739 &Net::FullAuto::FA_Core::handle_error($firsterr); 4740 } 4741 } else { 4742 if ($sub!~/::/) { 4743 $sub=~s/^[&]//; 4744 eval "\@resu=main::$sub"; 4745 } else { 4746 eval "\@resu=$sub"; 4747 } 4748 die $@ if $@; 4749 } 4750 }; 4751 if ($@) { 4752 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 4753 if ($parent_menu && wantarray && !$no_wantarray) { 4754 return '',$FullMenu,$Selected,$Conveyed, 4755 $SavePick,$SaveMMap,$SaveNext, 4756 $Persists,$parent_menu,$@; 4757 } 4758 if (defined $log_handle && 4759 -1<index $log_handle,'*') { 4760 print $log_handle $@; 4761 close($log_handle); 4762 } 4763 if ($Term::Menus::fullauto) { 4764 &Net::FullAuto::FA_Core::handle_error($@); 4765 } else { die $@ } 4766 } else { 4767 my $die="\n FATAL ERROR! - The Local " 4768 ."System $Term::Menus::local_hostname " 4769 ."Conveyed\n" 4770 ." the Following " 4771 ."Unrecoverable Error Condition :\n\n" 4772 ." $@\n line ".__LINE__; 4773 if ($parent_menu && wantarray && !$no_wantarray) { 4774 return '',$FullMenu,$Selected,$Conveyed, 4775 $SavePick,$SaveMMap,$SaveNext, 4776 $Persists,$parent_menu,$die; 4777 } 4778 if (defined $log_handle && 4779 -1<index $log_handle,'*') { 4780 print $log_handle $die; 4781 close($log_handle); 4782 } 4783 if ($Term::Menus::fullauto) { 4784 &Net::FullAuto::FA_Core::handle_error($die); 4785 } else { die $die } 4786 } 4787 } 4788 if (-1<$#resu) { 4789 if ($resu[0] eq '<') { %picks=();next } 4790 if (0<$#resu && wantarray && !$no_wantarray) { 4791 return @resu; 4792 } else { 4793 return return_result($resu[0], 4794 $MenuUnit_hash_ref,$Conveyed); 4795 } 4796 } 4797 } 4798 return 'DONE_SUB'; 4799 } else { return 'DONE' } 4800 } elsif ($menu_output eq '-') { 4801 $return_from_child_menu='-'; 4802 } elsif ($menu_output eq '+') { 4803 $return_from_child_menu='+'; 4804 } elsif ($menu_output) { 4805 return $menu_output; 4806 } 4807 } elsif ($ikey eq 'ESC' || $numbor=~/^quit|exit|bye$/i) { 4808 print "\n" if $^O ne 'cygwin'; 4809 return ']quit[' 4810 } elsif ($Term::Menus::fullauto and $ikey eq 'F1' || 4811 $numbor=~/^help$/i) { 4812 system('man Net::FullAuto'); 4813 } elsif ($ikey eq 'F1' || $numbor=~/^help$/i) { 4814 system('man Term::Menus'); 4815 } elsif ($Term::Menus::fullauto and $numbor=~/^admin$/i) { 4816 if (!exists $Net::FullAuto::FA_Core::admin_menus{ 4817 &pw($MenuUnit_hash_ref)}) { 4818 while (1) { 4819 my @menu_output=Menu($Net::FullAuto::FA_Core::admin_menu->()) 4820 if $Net::FullAuto::FA_Core::admin_menu; 4821 last if $menu_output[0] ne '-' && $menu_output[0] ne '+'; 4822 } 4823 } else { 4824 return ['{admin}<'],$FullMenu,$Selected,$Conveyed, 4825 $SavePick,$SaveMMap,$SaveNext,$Persists; 4826 } 4827 } elsif (!keys %{$FullMenu->{$MenuUnit_hash_ref}[1]} 4828 && $numbor=~/^[Aa]$/) { 4829 if (!$select_many && !(keys %{$MenuUnit_hash_ref->{Select}})) { 4830 print "\n ERROR: Cannot Select All Items\n". 4831 " When 'Select' is NOT set to 'Many'\n"; 4832 sleep 2;next; 4833 } 4834 if ($filtered_menu) { 4835 foreach my $num (0..$#all_menu_items_array) { 4836 $picks{$num+1}='*'; 4837 } 4838 foreach my $key (keys %{$FullMenu->{$MenuUnit_hash_ref}[8]}) { 4839 $SavePick->{$parent_menu}{$FullMenu-> 4840 {$MenuUnit_hash_ref}[8]{$key}}='*'; 4841 } 4842 } else { 4843 my $nmp=$num_pick-1; 4844 foreach my $pck (0..$nmp) { 4845 if ($select_many || 4846 exists $FullMenu->{$MenuUnit_hash_ref}[6]->{ 4847 $all_menu_items_array[$pck]}) { 4848 $picks{$pck+1}='*' 4849 } 4850 } 4851 } 4852 } elsif ($numbor=~/^[Cc]$/) { 4853 ## CLEAR ALL CLEARALL 4854 foreach my $key (keys %{${$FullMenu}{$MenuUnit_hash_ref}[8]}) { 4855 delete ${$SavePick}{$parent_menu}{${$FullMenu} 4856 {$MenuUnit_hash_ref}[8]{$key}}; 4857 } 4858 foreach my $pick (keys %picks) { 4859 if (exists $picks{$pick}) { 4860 delete $picks{$pick}; 4861 delete $items{$pick}; 4862 delete $Selected->{$MenuUnit_hash_ref}{$pick}; 4863 delete $Selected->{$parent_menu}{$pick}; 4864 delete $SavePick->{$MenuUnit_hash_ref}{$pick}; 4865 delete $SavePick->{$parent_menu}{$pick}; 4866 delete $SaveNext->{$MenuUnit_hash_ref}; 4867 } 4868 } $FullMenu->{$parent_menu}[5]=''; 4869 $return_from_child_menu=0; 4870 $Persists->{$MenuUnit_hash_ref}{defaults}=0; 4871 $Persists->{$parent_menu}{defaults}=0 if defined $parent_menu; 4872 } 4873 if ($numbor=~/^u$/i || $ikey eq 'UPARROW' || $ikey eq 'PAGEUP') { 4874 if ($ikey ne 'PAGEUP' && exists $MenuUnit_hash_ref->{Scroll} 4875 && $MenuUnit_hash_ref->{Scroll}) { 4876 $MenuUnit_hash_ref->{Scroll}->[1]-- if 4877 $MenuUnit_hash_ref->{Scroll}->[1]!=1; 4878 my $remainder=0;my $curscreennum=0; 4879 $remainder=$num_pick % $display_this_many_items if $num_pick; 4880 $curscreennum=($start+$remainder==$num_pick)? 4881 $start+$remainder:$start+$choose_num; 4882 if ($curscreennum-$remainder== 4883 $MenuUnit_hash_ref->{Scroll}->[1] && 4884 $curscreennum==$num_pick) { 4885 $start=$start-$display_this_many_items; 4886 $FullMenu->{$MenuUnit_hash_ref}[11]=$start; 4887 } elsif ($start==$MenuUnit_hash_ref->{Scroll}->[1]) { 4888 if ($display_this_many_items<$num_pick-$start 4889 || $remainder || (!$remainder && 4890 (($num_pick==$start+1) || 4891 ($num_pick==$start+$display_this_many_items)))) { 4892 $start=$start-$display_this_many_items; 4893 $FullMenu->{$MenuUnit_hash_ref}[11]=$start; 4894 } 4895 } else { next } 4896 $numbor=$start+$choose_num+1; 4897 $hidedefaults=0; 4898 last; 4899 } elsif (0<=$start-$display_this_many_items) { 4900 $start=$start-$display_this_many_items; 4901 $MenuUnit_hash_ref->{Scroll}->[1]= 4902 $start+$display_this_many_items 4903 if $ikey eq 'PAGEUP' && 4904 exists $MenuUnit_hash_ref->{Scroll} 4905 && $MenuUnit_hash_ref->{Scroll}; 4906 $FullMenu->{$MenuUnit_hash_ref}[11]=$start; 4907 } else { 4908 $start=$FullMenu->{$MenuUnit_hash_ref}[11]=0; 4909 } 4910 $numbor=$start+$choose_num+1; 4911 $hidedefaults=0; 4912 last; 4913 } elsif ($ikey eq 'END') { 4914 $FullMenu->{$MenuUnit_hash_ref}[11]=$num_pick; 4915 $MenuUnit_hash_ref->{Scroll}->[1]=$num_pick if 4916 $MenuUnit_hash_ref->{Scroll} && 4917 $MenuUnit_hash_ref->{Scroll}; 4918 $hidedefaults=0; 4919 if ($num_pick==$start+$choose_num) { 4920 next; 4921 } 4922 my $remainder=$num_pick % $choose_num; 4923 if ($remainder) { 4924 $start=$num_pick-$remainder; 4925 } else { 4926 $start=$num_pick-$display_this_many_items; 4927 } 4928 last; 4929 } elsif ($ikey eq 'HOME') { 4930 $FullMenu->{$MenuUnit_hash_ref}[11]=0; 4931 $MenuUnit_hash_ref->{Scroll}->[1]=1 if 4932 $MenuUnit_hash_ref->{Scroll} && 4933 $MenuUnit_hash_ref->{Scroll}; 4934 $hidedefaults=0; 4935 $start=0; 4936 last; 4937 } elsif ($numbor && unpack('a1',$numbor) eq '!') { 4938 # SHELLOUT shellout 4939 my $username=getlogin || getpwuid($<); 4940 my $cmd=unpack('x1 a*',$numbor); 4941 print "\n"; 4942 unless ($^O eq 'cygwin') { 4943 system("su -l -c$cmd $username"); 4944 } else { 4945 system($cmd); 4946 } 4947 print "\nPress ENTER to continue";<STDIN>; 4948 next; 4949 } elsif (((!$ikey || $ikey eq 'ENTER') && 4950 ($numbor=~/^()$/ || $numbor=~/^\n/)) || $numbor=~/^d$/i 4951 || $ikey eq 'DOWNARROW' || $ikey eq 'PAGEDOWN') { 4952 $ikey||='ENTER'; 4953 delete $main::maintain_scroll_flag->{$MenuUnit_hash_ref} 4954 if defined $main::maintain_scroll_flag; 4955 if (($ikey eq 'DOWNARROW' || $numbor=~/^d$/i) && 4956 exists $MenuUnit_hash_ref->{Scroll} 4957 && $MenuUnit_hash_ref->{Scroll}) { 4958 my $remainder=0;my $curscreennum=0; 4959 $remainder=$num_pick % $choose_num if $num_pick; 4960 $curscreennum=($start+$remainder==$num_pick)? 4961 $start+$remainder:$start+$choose_num; 4962 $MenuUnit_hash_ref->{Scroll}->[1]++ 4963 if $MenuUnit_hash_ref->{Scroll}->[1]!=$num_pick; 4964 if ($curscreennum<$MenuUnit_hash_ref->{Scroll}->[1]) { 4965 if ($display_this_many_items<$num_pick-$start) { 4966 $start=$start+$display_this_many_items; 4967 $FullMenu->{$MenuUnit_hash_ref}[11]=$start; 4968 } else { 4969 $start=$start+$remainder; 4970 $FullMenu->{$MenuUnit_hash_ref}[11]=$num_pick; 4971 } 4972 } else { next } 4973 $hidedefaults=0; 4974 $numbor=$start+$choose_num+1; 4975 last; 4976 } elsif ($ikey eq 'ENTER' && exists $MenuUnit_hash_ref->{Scroll} 4977 && $MenuUnit_hash_ref->{Scroll} && !$show_banner_only) { 4978 $numbor=$MenuUnit_hash_ref->{Scroll}->[1]; 4979 $MenuUnit_hash_ref->{Scroll}->[1]++ 4980 if $MenuUnit_hash_ref->{Scroll}->[1]!=$num_pick; 4981 } else { 4982 if ($show_banner_only) { 4983 if (exists $MenuUnit_hash_ref->{Result}) { 4984 $numbor='f'; 4985 $picks{'__FA_Banner__'}=''; 4986 my $remainder=0; 4987 $remainder=$choose_num % $num_pick if $num_pick; 4988 my $curscreennum=($start+$remainder==$num_pick)? 4989 $start+$remainder:$start+$choose_num; 4990 my $numpick=0; 4991 if ($parent_menu and exists $parent_menu->{Scroll}) { 4992 if (ref $parent_menu->{Scroll} eq 'ARRAY') { 4993 $numpick=$#{[keys %{$FullMenu->{$parent_menu}[2]}]}; 4994 if ($curscreennum+$display_this_many_items 4995 <$parent_menu->{Scroll}->[1] && 4996 $parent_menu->{Scroll}->[1]<$numpick) { 4997 $FullMenu->{$parent_menu}[11]= 4998 $parent_menu->{Scroll}->[1]; 4999 } 5000 } 5001 $parent_menu->{Scroll}->[1]||=0; 5002 } 5003 } else { 5004 return 'DONE_SUB'; 5005 } 5006 } elsif ($display_this_many_items<$num_pick-$start) { 5007 $start=$start+$display_this_many_items; 5008 $MenuUnit_hash_ref->{Scroll}->[1]=$start+1 if 5009 exists $MenuUnit_hash_ref->{Scroll} 5010 && $MenuUnit_hash_ref->{Scroll}; 5011 $FullMenu->{$MenuUnit_hash_ref}[11]=$start; 5012 } elsif ($ikey ne 'PAGEDOWN') { 5013 $start=$FullMenu->{$MenuUnit_hash_ref}[11]=0; 5014 } 5015 unless ($show_banner_only || $numbor!~/^\d+/) { 5016 $hidedefaults=0; 5017 $numbor=$start+$choose_num+1; 5018 last; 5019 } 5020 } 5021 } chomp $numbor; 5022 if (!((keys %picks) && $numbor=~/^[Ff]$/) && 5023 $numbor!~/^\d+|admin$/ && !$return_from_child_menu) { 5024 delete $main::maintain_scroll_flag->{$MenuUnit_hash_ref} 5025 if defined $main::maintain_scroll_flag; 5026 $numbor=$start+$choose_num+1; 5027 last; 5028 } elsif (exists $pn{$numbor} || ((keys %picks) && $numbor=~/^[Ff]$/)) { 5029 # NUMBOR CHOSEN 5030 delete $main::maintain_scroll_flag->{$MenuUnit_hash_ref} 5031 if defined $main::maintain_scroll_flag; 5032 delete $picks{'__FA_Banner__'} if exists $picks{'__FA_Banner__'}; 5033 %pn=() unless %pn; 5034 my $callertest=__PACKAGE__."::Menu"; 5035 if ($Persists->{$MenuUnit_hash_ref}{defaults} && !$filtered_menu) { 5036 $Persists->{$MenuUnit_hash_ref}{defaults}=0; 5037 $Persists->{$parent_menu}{defaults}=0 if $parent_menu; 5038 foreach my $pick (keys %picks) { 5039 if (exists $picks{$pick} && !$picks{$numbor}) { 5040 if ($picks{$pick} eq '*') { 5041 delete $picks{$pick}; 5042 delete $items{$pick}; 5043 delete $Selected->{$MenuUnit_hash_ref}{$pick}; 5044 } elsif ($picks{$pick} eq '+') { 5045 &delete_Selected($MenuUnit_hash_ref,$pick, 5046 $Selected,$SavePick,$SaveNext,$Persists); 5047 delete $picks{$pick}; 5048 delete $items{$pick}; 5049 } 5050 } 5051 } $FullMenu->{$MenuUnit_hash_ref}[5]=''; 5052 } 5053 $pn{$numbor}[1]||=1; 5054 my $digital_numbor=($numbor=~/^\d+$/) ? $numbor : 1; 5055 $all_menu_items_array[0]||=''; 5056 if (exists $MenuUnit_hash_ref->{Result} && 5057 !defined $MenuUnit_hash_ref->{Result}) { 5058 my $name=$MenuUnit_hash_ref->{Name}; 5059 print "\n\n"; 5060 my $fatal_error=<<END; 5061 5062 FATAL ERROR!: The Menu Block \"$name\" : 5063 5064END 5065 $fatal_error.=<<'END'; 5066 has a Result => undef element defined, but not instantiated. 5067 There may be a couple reasons for this, having to do with scope 5068 and where code blocks are located in relation to each other in 5069 the script. It could also be that you didn't provide a value 5070 for the element. If blocks are locally scoped with "my" than 5071 the result block must exist ABOVE the calling block: 5072 5073 my $block_being_called = { ... }; 5074 my $block_doing_calling = { Result => $block_being_called, }; 5075 5076 However, with more complex menu implementations, this 5077 convenience is not always possible or workable. In this 5078 situation, the approach is different. It will be necessary to 5079 globally scope code blocks, and use full package naming 5080 conventions when calling code blocks: 5081 5082 our $block_doing_calling = { 5083 5084 Result => $Full::Package::Name::Of::block_being_called, 5085 5086 }; 5087 our $block_being_called = { ... }; 5088 5089 --------------------------------------------------------------- 5090 5091 Result => elements MUST have a value. A NULL value will work: 5092 5093 my|our $block_being_called = { Result => '', } 5094 5095END 5096 die $fatal_error; 5097 } 5098 if (($select_many || 5099 (exists ${$MenuUnit_hash_ref}{Select}{$numbor})) 5100 && $numbor!~/^[Ff]$/) { 5101 if ($filtered_menu && (exists 5102 $SavePick->{$parent_menu}{$numbor})) { 5103 if ($Persists->{$parent_menu}{defaults}) { 5104 $Persists->{$parent_menu}{defaults}=0; 5105 $Persists->{$MenuUnit_hash_ref}{defaults}=0; 5106 foreach my $pick (keys %picks) { 5107 if (exists $picks{$pick} && !$picks{$numbor}) { 5108 if ($picks{$pick} eq '*') { 5109 delete $picks{$pick}; 5110 delete $items{$pick}; 5111 delete $Selected->{$parent_menu}{$pick}; 5112 delete $SavePick->{$MenuUnit_hash_ref}{$numbor}; 5113 } elsif ($picks{$pick} eq '+') { 5114 &delete_Selected($parent_menu,$pick, 5115 $Selected,$SavePick,$SaveNext,$Persists); 5116 $SaveNext={%{$SavePick}}; 5117 delete $picks{$pick}; 5118 delete $items{$pick}; 5119 } 5120 } 5121 } $FullMenu->{$MenuUnit_hash_ref}[5]=''; 5122 } 5123 delete $Selected->{$MenuUnit_hash_ref}{$numbor}; 5124 delete $picks{$numbor}; 5125 delete $items{$numbor}; 5126 delete $SaveNext->{$MenuUnit_hash_ref}; 5127 delete $SavePick->{$MenuUnit_hash_ref}{$numbor}; 5128 delete $SavePick->{$parent_menu}{$numbor}; 5129 } elsif (exists $picks{$numbor}) { 5130 if ($picks{$numbor} eq '*') { 5131 delete $picks{$numbor}; 5132 delete $items{$numbor}; 5133 delete $Selected->{$MenuUnit_hash_ref}{$numbor}; 5134 delete $SavePick->{$MenuUnit_hash_ref}{$numbor}; 5135 delete $SavePick->{$parent_menu}{$numbor} 5136 if $filtered_menu; 5137 } else { 5138 &delete_Selected($MenuUnit_hash_ref,$numbor, 5139 $Selected,$SavePick,$SaveNext,$Persists); 5140 delete $picks{$numbor}; 5141 delete $items{$numbor}; 5142 } 5143 } else { 5144 $items{$numbor}=$FullMenu->{$MenuUnit_hash_ref} 5145 [4]{$all_menu_items_array[$numbor-1]}; 5146 $SavePick->{$parent_menu}{$numbor}='*' 5147 if $filtered_menu; 5148 my $skip=0; 5149 foreach my $key (keys %picks) { 5150 if (defined $all_menu_items_array[$key-1] && 5151 exists ${$FullMenu}{$MenuUnit_hash_ref}[1]->{ 5152 $all_menu_items_array[$key-1]} 5153 && (grep { $items{$numbor} eq $_ } 5154 @{${$FullMenu}{$MenuUnit_hash_ref}[1]->{ 5155 $all_menu_items_array[$key-1]}})) { 5156 my $warn="\n WARNING! You Cannot Select "; 5157 $warn.="Line $numbor while Line $key is Selected!\n"; 5158 print "$warn";sleep 2; 5159 $skip=1; 5160 } elsif ($picks{$key} eq '-') { 5161 delete ${$Selected}{$MenuUnit_hash_ref}{$key}; 5162 delete $picks{$key}; 5163 delete $SaveNext->{$MenuUnit_hash_ref}; 5164 } 5165 } 5166 if ($skip==0) { 5167 $picks{$numbor}='*'; 5168 $negate{$numbor}= 5169 ${${$FullMenu}{$MenuUnit_hash_ref}[1]} 5170 {$all_menu_items_array[$numbor-1]}; 5171 %{$SavePick->{$MenuUnit_hash_ref}}=%picks; 5172 } 5173 } 5174 if ($prev_menu && $prev_menu!=$numbor) { 5175 &delete_Selected($MenuUnit_hash_ref,$prev_menu, 5176 $Selected,$SavePick,$SaveNext,$Persists); 5177 delete $picks{$prev_menu}; 5178 delete $items{$prev_menu}; 5179 } 5180 } elsif (($show_banner_only && exists $MenuUnit_hash_ref-> 5181 {Result} and ref $MenuUnit_hash_ref-> 5182 {Result} eq 'HASH') || ($numbor=~/^\d+$/ && 5183 (ref $FullMenu->{$MenuUnit_hash_ref}[2] 5184 {$all_menu_items_array[$digital_numbor-1]|| 5185 $all_menu_items_array[$pn{$digital_numbor}[1]-1]} 5186 eq 'HASH')) || ($numbor=~/^[Ff]$/ && 5187 ref $FullMenu->{$MenuUnit_hash_ref}[2] 5188 {$all_menu_items_array[((keys %picks)[0]||1)-1]} 5189 eq 'HASH')) { 5190 my $numbor_is_eff=0; 5191 if ($numbor=~/^[Ff]$/) { 5192 $numbor=(keys %picks)[0]; 5193 $numbor_is_eff=1; 5194 } 5195 if (grep { /Item_/ } keys %{$MenuUnit_hash_ref}) { 5196 my @items=(); 5197 foreach my $key (keys %{$MenuUnit_hash_ref}) { 5198 next unless $key=~/Item_/; 5199 push @items, $MenuUnit_hash_ref->{$key}; 5200 } 5201 if ($#items==0 && ref $items[0] eq 'HASH' && 5202 (!grep { /Item_/ } keys %{$items[0]}) && 5203 grep { /Banner/ } keys %{$items[0]}) { 5204 $show_banner_only=1; 5205 } 5206 } 5207 if ($show_banner_only || 5208 (grep { /Item_/ } keys %{$FullMenu->{ 5209 $MenuUnit_hash_ref}[2]{$all_menu_items_array[ 5210 $numbor-1]||$all_menu_items_array[ 5211 $pn{$numbor}[1]-1]}})|| exists $labels{ 5212 (keys %{$FullMenu->{$MenuUnit_hash_ref}[2] 5213 {$all_menu_items_array[$digital_numbor-1] 5214 ||''}})[0]or[]}|| 5215 &test_hashref($FullMenu->{$MenuUnit_hash_ref}[2] 5216 {$all_menu_items_array[$numbor-1]|| 5217 $all_menu_items_array[$pn{$numbor}[1]-1]})) { 5218 my $menyou=''; 5219 my $cur_menu=($filtered_menu)?$parent_menu:$MenuUnit_hash_ref; 5220 if ($filtered_menu) { 5221 my @all_copy=@all_menu_items_array; 5222 @all_menu_items_array=(); 5223 my $pstart=0; 5224 my $pstop=0; 5225 foreach my $pik (sort numerically keys %pn) { 5226 $pstop=$pik-2; 5227 foreach my $item ($pstart..$pstop) { 5228 push @all_menu_items_array,''; 5229 } 5230 push @all_menu_items_array, shift @all_copy; 5231 $pstart=$pstop+2; 5232 $pstop=0; 5233 } 5234 while (my $pst=$pstart--) { 5235 if ($pst=~/0$/) { 5236 $FullMenu->{$cur_menu}[11]=$pst; 5237 last; 5238 } 5239 } 5240 delete $SavePick->{$MenuUnit_hash_ref}; 5241 delete $SaveNext->{$MenuUnit_hash_ref}; 5242 } 5243 if (!$filtered_menu) { 5244 if (exists $MenuUnit_hash_ref->{Result}) { 5245 $FullMenu->{$MenuUnit_hash_ref}[2] 5246 {'__FA_Banner__'} 5247 =$MenuUnit_hash_ref->{Result}; 5248 } elsif (exists $labels{(keys %{$FullMenu-> 5249 {$MenuUnit_hash_ref}[2] 5250 {$all_menu_items_array[$digital_numbor-1]}})[0]}) { 5251 my %men_result=%{$FullMenu-> 5252 {$MenuUnit_hash_ref}[2] 5253 {$all_menu_items_array[$digital_numbor-1]}}; 5254 $menyou=&Data::Dump::Streamer::Dump($labels{ 5255 (keys %men_result)[0]})->Out(); 5256#print "MENYOU=$menyou<==\n";<STDIN>; 5257 $menyou=~s/\$HASH\d*\s*=\s*//s; 5258 my $mnyou=eval $menyou; 5259#print "WHAT IS THE CONVEY=$mnyou->{Item_1}->{Convey}<==\n"; 5260 $FullMenu-> 5261 {$MenuUnit_hash_ref}[2] 5262 {$all_menu_items_array[$numbor-1]}=$mnyou; 5263 my $itemnum=$FullMenu->{$MenuUnit_hash_ref}[4] 5264 {$all_menu_items_array[$numbor-1]}; 5265 } 5266 } 5267 chomp($numbor) if $numbor; 5268 unless ($numbor_is_eff) { 5269 if (exists $picks{$numbor}) { 5270 #$FullMenu->{$cur_menu}[5]='ERASE'; 5271 $hidedefaults=0; 5272 foreach my $key (keys %{$SaveNext}) { 5273 delete $SaveNext->{$key}; 5274 } 5275 if ($picks{$numbor} eq '*') { 5276 delete $picks{$numbor}; 5277 delete $items{$numbor}; 5278 delete $Selected->{$cur_menu}{$numbor}; 5279 } elsif ($picks{$numbor} ne ' ') { 5280 &delete_Selected($cur_menu,$numbor, 5281 $Selected,$SavePick,$SaveNext,$Persists); 5282 delete $picks{$numbor}; 5283 delete $items{$numbor}; 5284 } 5285 } 5286 if ($prev_menu && $prev_menu!=$numbor) { 5287 #$FullMenu->{$cur_menu}[5]='ERASE'; 5288 $hidedefaults=0; 5289 &delete_Selected($cur_menu,$prev_menu, 5290 $Selected,$SavePick,$SaveNext,$Persists); 5291 delete $picks{$prev_menu}; 5292 delete $items{$prev_menu}; 5293 } 5294 } elsif (!$show_banner_only) { 5295 foreach my $key (keys %picks) { 5296 if (($start<=$key) || ($key<=$start+$choose_num)) { 5297 $numbor=$key; 5298 last; 5299 } 5300 } 5301 } 5302 my $next_menu_ref=''; 5303 unless ($show_banner_only) { 5304 $next_menu_ref=$FullMenu-> 5305 {$cur_menu}[2] 5306 {$all_menu_items_array[$numbor-1]} 5307 unless $filtered_menu; 5308 $next_menu_ref||=''; 5309 delete $SavePick->{$next_menu_ref} 5310 unless $filtered_menu; 5311 $FullMenu->{$next_menu_ref}[11]=0 5312 unless $filtered_menu; 5313 %picks=() if (!$select_many && 5314 !exists ${$MenuUnit_hash_ref}{Select}{$numbor}); 5315 $picks{$numbor}='-' if !(keys %picks) || $numbor!~/^[Ff]$/; 5316 } 5317 ($FullMenu,$Conveyed,$SaveNext,$Persists,$Selected, 5318 $convey,$parent_menu) 5319 =$get_result->($cur_menu, 5320 \@all_menu_items_array,\%picks, 5321 $picks_from_parent,$FullMenu,$Conveyed,$Selected, 5322 $SaveNext,$Persists,$parent_menu); 5323 %{$SavePick->{$cur_menu}}=%picks; 5324 $Conveyed->{&pw($cur_menu)}=[]; 5325 if (0<$#{[keys %picks]}) { 5326 foreach my $key (sort numerically keys %picks) { 5327 push @{$Conveyed->{&pw($cur_menu)}}, 5328 $all_menu_items_array[$key-1]; 5329 } 5330 } elsif ($numbor) { 5331 $Conveyed->{&pw($cur_menu)}= 5332 $all_menu_items_array[$numbor-1]; 5333 } 5334 my $mcount=0; 5335 unless (exists $SaveMMap->{$cur_menu}) { 5336 if ($filtered_menu) { 5337 my $pmap=[]; 5338 foreach my $kee (keys %{$SaveMMap}) { 5339 my $map=&Data::Dump::Streamer::Dump( 5340 $SaveMMap->{$kee})->Out(); 5341 $map=~s/\$ARRAY\d*\s*=\s*//s; 5342 my $m=eval $map; 5343 $pmap=$m if $#{$pmap}<$#{$m}; 5344 } 5345 $SaveMMap->{$cur_menu}=$pmap; 5346 $mcount=&get_Menu_map_count( 5347 $SaveMMap->{$cur_menu}); 5348 } elsif ($parent_menu) { 5349 my $parent_map=&Data::Dump::Streamer::Dump( 5350 $SaveMMap->{$parent_menu})->Out(); 5351 $parent_map=~s/\$ARRAY\d*\s*=\s*//s; 5352 $SaveMMap->{$cur_menu}=eval $parent_map; 5353 $mcount=&get_Menu_map_count( 5354 $SaveMMap->{$cur_menu}); 5355 } else { 5356 $SaveMMap->{$cur_menu}=[]; 5357 } 5358 } 5359 if (ref $convey eq 'ARRAY') { 5360 push @{$SaveMMap->{$cur_menu}}, 5361 [ ++$mcount, $convey->[0] ]; 5362 } else { 5363 push @{$SaveMMap->{$cur_menu}}, 5364 [ ++$mcount, $convey ]; 5365 } 5366 if ($filtered_menu) { 5367 return $FullMenu-> 5368 {$cur_menu}[2] 5369 {$all_menu_items_array[$numbor-1]},$convey, 5370 $recurse_level,$FullMenu, 5371 $Selected,$Conveyed,$SavePick, 5372 $SaveMMap,$SaveNext,$Persists, 5373 $cur_menu,$no_wantarray; 5374 } 5375 $MenuMap=$SaveMMap->{$cur_menu}; 5376 my $returned_FullMenu=''; 5377 my $returned_Selected=''; 5378 my $returned_Conveyed=''; 5379 my $returned_SavePick=''; 5380 my $returned_SaveMMap=''; 5381 my $returned_SaveNext=''; 5382 my $returned_Persists=''; 5383 my $menu_result=''; 5384 if (exists $Selected->{$cur_menu} 5385 {'__FA_Banner__'}) { 5386 $menu_result=$Selected->{$cur_menu} 5387 {'__FA_Banner__'}; 5388 $menu_result=$menu_result->() if ref 5389 $menu_result eq 'CODE'; 5390 } else { 5391 $menu_result=$FullMenu->{$cur_menu}[2] 5392 {$all_menu_items_array[$numbor-1]}; 5393 } 5394 eval { 5395 ($menu_output,$returned_FullMenu, 5396 $returned_Selected,$returned_Conveyed, 5397 $returned_SavePick,$returned_SaveMMap, 5398 $returned_SaveNext,$returned_Persists) 5399 =&Menu($menu_result,$convey, 5400 $recurse_level,$FullMenu, 5401 $Selected,$Conveyed,$SavePick, 5402 $SaveMMap,$SaveNext,$Persists, 5403 $cur_menu,$no_wantarray); 5404 }; # MENU RETURN MENURETURN 7 5405 print "MENU RETURN 7\n" if $menu_return_debug; 5406 die $@ if $@; 5407 if (ref $menu_output eq 'ARRAY' && 5408 $menu_output->[0]=~/^[{](.*)[}][<]$/) { 5409 delete $Selected->{$MenuUnit_hash_ref}; 5410 delete $Conveyed->{$MenuUnit_hash_ref}; 5411 delete $SavePick->{$MenuUnit_hash_ref}; 5412 delete $SaveMMap->{$MenuUnit_hash_ref}; 5413 delete $SaveNext->{$MenuUnit_hash_ref}; 5414 delete $Persists->{$MenuUnit_hash_ref}; 5415 if ($1 eq $MenuUnit_hash_ref->{Name}) { 5416 %picks=(); 5417 my $remainder=0;my $curscreennum=0; 5418 $remainder=$num_pick % $choose_num if $num_pick; 5419 $curscreennum=($start+$remainder==$num_pick)? 5420 $start+$remainder:$start+$choose_num; 5421 if ($curscreennum<$MenuUnit_hash_ref->{Scroll}->[1] 5422 && $display_this_many_items<$num_pick-$start) { 5423 $start=$start+$display_this_many_items; 5424 $FullMenu->{$MenuUnit_hash_ref}[11]=$start; 5425 if ($start+$remainder==$num_pick) { 5426 $choose_num=$num_pick-$start; 5427 } else { 5428 $choose_num=$display_this_many_items; 5429 } 5430 } 5431 $show_banner_only=0; 5432 next; 5433 } else { 5434 delete $FullMenu->{$MenuUnit_hash_ref}; 5435 return $menu_output, 5436 $FullMenu,$Selected,$Conveyed, 5437 $SavePick,$SaveMMap,$SaveNext, 5438 $Persists; 5439 } 5440 } else { 5441 $FullMenu=$returned_FullMenu; 5442 $Selected=$returned_Selected; 5443 $Conveyed=$returned_Conveyed; 5444 $SavePick=$returned_SavePick; 5445 $SaveMMap=$returned_SaveMMap; 5446 $SaveNext=$returned_SaveNext; 5447 $Persists=$returned_Persists; 5448 } 5449 chomp($menu_output) if !(ref $menu_output); 5450 if ($filtered_menu) { 5451 if (grep { /\+|\*/ } values %picks) { 5452 return '+', 5453 $FullMenu,$Selected,$Conveyed, 5454 $SavePick,$SaveMMap,$SaveNext, 5455 $Persists; 5456 } else { 5457 my %sp_copy=%{$SavePick->{$parent_menu}} 5458 if exists $SavePick->{$parent_menu}; 5459 foreach my $key (keys %sp_copy) { 5460 $SavePick->{$parent_menu}->{$key}='-' if 5461 $sp_copy{$key} eq '+'; 5462 } 5463 return '-', 5464 $FullMenu,$Selected,$Conveyed, 5465 $SavePick,$SaveMMap,$SaveNext, 5466 $Persists; 5467 } 5468 } elsif ($menu_output eq '-') { 5469 $return_from_child_menu='-'; 5470 } elsif ($menu_output eq '+') { 5471 $return_from_child_menu='+'; 5472 } elsif ($menu_output eq 'DONE_SUB') { 5473 return 'DONE_SUB'; 5474 } elsif ($menu_output eq 'DONE' and 1<$recurse_level) { 5475 return 'DONE'; 5476 } elsif ($menu_output) { 5477 return $menu_output; 5478 } else { 5479 if ($Term::Menus::fullauto && (!exists 5480 ${$MenuUnit_hash_ref}{'NoPlan'} || 5481 !${$MenuUnit_hash_ref}{'NoPlan'}) && 5482 defined $Net::FullAuto::FA_Core::makeplan) { 5483#print "IN MAKEPLAN14\n"; 5484 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{'Plan'}} 5485 && !exists 5486 $Net::FullAuto::FA_Core::makeplan->{'Title'}) { 5487 $Net::FullAuto::FA_Core::makeplan->{'Title'} 5488 =$all_menu_items_array[$numbor-1]; 5489 } 5490 unless ($got_default) { 5491 push @{$Net::FullAuto::FA_Core::makeplan->{'Plan'}}, 5492 { Menu => &pw($MenuUnit_hash_ref), 5493 Number => $numbor, 5494 PlanID => 5495 $Net::FullAuto::FA_Core::makeplan->{Number}, 5496 Item => $all_menu_items_array[$numbor-1] } 5497 } 5498 } 5499 my $subfile=substr( 5500 $Term::Menus::fa_code,0,-3).'::' 5501 if $Term::Menus::fa_code; 5502 $subfile||=''; 5503 foreach my $sub (&get_subs_from_menu($Selected)) { 5504 my @resu=(); 5505 if (ref $sub eq 'CODE') { 5506 if ($Term::Menus::fullauto && (!exists 5507 ${$MenuUnit_hash_ref}{'NoPlan'} || 5508 !${$MenuUnit_hash_ref}{'NoPlan'}) && 5509 defined $Net::FullAuto::FA_Core::makeplan) { 5510#print "IN MAKEPLAN15\n"; 5511 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 5512 'Plan'}} && !exists 5513 $Net::FullAuto::FA_Core::makeplan->{ 5514 'Title'}) { 5515 $Net::FullAuto::FA_Core::makeplan->{'Title'} 5516 =$all_menu_items_array[$numbor-1]; 5517 } 5518 my $n='Numbor'; 5519 push @{$Net::FullAuto::FA_Core::makeplan->{ 5520 'Plan'}}, 5521 { Menu => &pw($MenuUnit_hash_ref), 5522 Number => $numbor, 5523 PlanID => 5524 $Net::FullAuto::FA_Core::makeplan->{$n}, 5525 Item => 5526 &Data::Dump::Streamer::Dump($sub)->Out() 5527 } 5528 } 5529 eval { @resu=$sub->() }; 5530 if ($@) { 5531 if (10<length $@ && unpack('a11',$@) eq 5532 'FATAL ERROR') { 5533 if ($parent_menu && wantarray && 5534 !$no_wantarray) { 5535 return '',$FullMenu,$Selected,$Conveyed, 5536 $SavePick,$SaveMMap,$SaveNext, 5537 $Persists,$parent_menu,$@; 5538 } 5539 if (defined $log_handle && 5540 -1<index $log_handle,'*') { 5541 print $log_handle $@; 5542 close($log_handle); 5543 } 5544 if ($Term::Menus::fullauto) { 5545 &Net::FullAuto::FA_Core::handle_error($@); 5546 } else { die $@ } 5547 } else { 5548 my $die="\n FATAL ERROR! - The Local " 5549 ."System $Term::Menus::local_hostname " 5550 ."Conveyed\n" 5551 ." the Following " 5552 ."Unrecoverable Error Condition :\n\n" 5553 ." $@\n line ".__LINE__; 5554 if ($parent_menu && wantarray && 5555 !$no_wantarray) { 5556 return '',$FullMenu,$Selected,$Conveyed, 5557 $SavePick,$SaveMMap,$SaveNext, 5558 $Persists,$parent_menu,$die; 5559 } 5560 if (defined $log_handle && 5561 -1<index $log_handle,'*') { 5562 print $log_handle $die; 5563 close($log_handle); 5564 } 5565 if ($Term::Menus::fullauto) { 5566 &Net::FullAuto::FA_Core::handle_error($die); 5567 } else { die $die } 5568 } 5569 } 5570 if (-1<$#resu) { 5571 if ($resu[0] eq '<') { 5572 %picks=(); 5573 $show_banner_only=0; 5574 next 5575 } 5576 if (0<$#resu && wantarray && !$no_wantarray) { 5577 return @resu; 5578 } else { 5579 return return_result($resu[0], 5580 $MenuUnit_hash_ref,$Conveyed); 5581 } 5582 } 5583 $done=1;last 5584 } 5585 eval { 5586 if ($subfile) { 5587 $sub=~s/^[&]//; 5588 if ($Term::Menus::fullauto && (!exists 5589 ${$MenuUnit_hash_ref}{'NoPlan'} || 5590 !${$MenuUnit_hash_ref}{'NoPlan'}) && 5591 defined $Net::FullAuto::FA_Core::makeplan) { 5592#print "IN MAKEPLAN16\n"; 5593 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 5594 'Plan'}} && !exists 5595 $Net::FullAuto::FA_Core::makeplan->{ 5596 'Title'}) { 5597 $Net::FullAuto::FA_Core::makeplan->{'Title'} 5598 =$all_menu_items_array[$numbor-1]; 5599 } 5600 my $n='Number'; 5601 push @{$Net::FullAuto::FA_Core::makeplan->{ 5602 'Plan'}}, 5603 { Menu => &pw($MenuUnit_hash_ref), 5604 Number => $numbor, 5605 PlanID => 5606 $Net::FullAuto::FA_Core::makeplan->{$n}, 5607 Item => "&$subfile$sub" } 5608 } 5609 eval "\@resu=\&$subfile$sub"; 5610 my $firsterr=$@||''; 5611 if ((-1<index $firsterr,'Undefined subroutine') && 5612 (-1<index $firsterr,$sub)) { 5613 if ($sub!~/::/) { 5614 eval "\@resu=main::$sub"; 5615 } else { 5616 eval "\@resu=$sub"; 5617 } 5618 my $seconderr=$@||'';my $die=''; 5619 my $c=$Term::Menus::fa_code; 5620 if ($seconderr=~/Undefined subroutine/) { 5621 if (${$FullMenu}{$MenuUnit_hash_ref}[2] 5622 {$all_menu_items_array[$numbor-1]}) { 5623 $die="The \"Result15 =>\" Setting" 5624 ."\n\t\t-> " . ${$FullMenu} 5625 {$MenuUnit_hash_ref}[2] 5626 {$all_menu_items_array[$numbor-1]} 5627 ."\n\t\tFound in the Menu Unit -> " 5628 .$MenuUnit_hash_ref->{Name}."\n\t\t" 5629 ."Specifies a Subroutine" 5630 ." that Does NOT Exist" 5631 ."\n\t\tin the User Code File " 5632 .$c.",\n\t\tnor was a routine with " 5633 ."that name\n\t\tlocated in the" 5634 ." main:: script.\n"; 5635 } else { 5636 $die="$firsterr\n $seconderr" 5637 } 5638 } else { $die=$seconderr } 5639 if ($Term::Menus::fullauto) { 5640 &Net::FullAuto::FA_Core::handle_error($die); 5641 } else { 5642 die $die; 5643 } 5644 } elsif ($firsterr) { 5645 if ($Term::Menus::fullauto) { 5646 &Net::FullAuto::FA_Core::handle_error( 5647 $firsterr); 5648 } else { 5649 die $firsterr; 5650 } 5651 } 5652 } else { 5653 if ($sub!~/::/) { 5654 $sub=~s/^[&]//; 5655 eval "\@resu=main::$sub"; 5656 } else { 5657 eval "\@resu=$sub"; 5658 } 5659 die $@ if $@; 5660 } 5661 }; 5662 if ($@) { 5663 if (10<length $@ && unpack('a11',$@) eq 5664 'FATAL ERROR') { 5665 if ($parent_menu && wantarray && !$no_wantarray) { 5666 return '',$FullMenu,$Selected,$Conveyed, 5667 $SavePick,$SaveMMap,$SaveNext, 5668 $Persists,$parent_menu,$@; 5669 } 5670 if (defined $log_handle && 5671 -1<index $log_handle,'*') { 5672 print $log_handle $@; 5673 close($log_handle); 5674 } 5675 if ($Term::Menus::fullauto) { 5676 &Net::FullAuto::FA_Core::handle_error($@); 5677 } else { die $@ } 5678 } else { 5679 my $die="\n FATAL ERROR! - The Local " 5680 ."System $Term::Menus::local_hostname " 5681 ."Conveyed\n" 5682 ." the Following " 5683 ."Unrecoverable Error Condition :\n\n" 5684 ." $@\n line ".__LINE__; 5685 if ($parent_menu && wantarray && !$no_wantarray) { 5686 return '',$FullMenu,$Selected,$Conveyed, 5687 $SavePick,$SaveMMap,$SaveNext, 5688 $Persists,$parent_menu,$die; 5689 } 5690 if (defined $log_handle && 5691 -1<index $log_handle,'*') { 5692 print $log_handle $die; 5693 close($log_handle); 5694 } 5695 if ($Term::Menus::fullauto) { 5696 &Net::FullAuto::FA_Core::handle_error($die); 5697 } else { die $die } 5698 } 5699 } 5700 if (-1<$#resu) { 5701 if ($resu[0] eq '<') { 5702 %picks=(); 5703 $show_banner_only=0; 5704 next 5705 } 5706 if (0<$#resu && wantarray && !$no_wantarray) { 5707 return @resu; 5708 } else { 5709 return return_result($resu[0], 5710 $MenuUnit_hash_ref,$Conveyed); 5711 } 5712 } 5713 } 5714 return 'DONE_SUB'; 5715 } 5716 } 5717 } elsif ($FullMenu && $caller eq $callertest && 5718 ($select_many || (keys %{$MenuUnit_hash_ref->{Select}}))) { 5719 if ($numbor!~/^[Ff]$/ && exists $picks{$numbor}) { 5720 if ($picks{$numbor} eq '*') { 5721 delete $picks{$numbor}; 5722 delete $items{$numbor}; 5723 delete ${$Selected}{$MenuUnit_hash_ref}{$numbor}; 5724 } else { 5725 &delete_Selected($MenuUnit_hash_ref,$numbor, 5726 $Selected,$SavePick,$SaveNext,$Persists); 5727 $SaveNext={%{$SavePick}}; 5728 delete $picks{$numbor}; 5729 delete $items{$numbor}; 5730 } last; 5731 } 5732 if (keys %{$FullMenu->{$MenuUnit_hash_ref}[2]}) { 5733 $numbor=(keys %picks)[0] if $numbor=~/^[Ff]$/; 5734 my $test_result= 5735 $FullMenu->{$MenuUnit_hash_ref}[2] 5736 {$all_menu_items_array[$numbor-1]}; 5737 if (ref $test_result eq 'CODE') { 5738 my $cd=''; 5739 my $sub=$FullMenu->{$MenuUnit_hash_ref}[2] 5740 {$all_menu_items_array[$picknum-1]}; 5741 my $select_ed=[]; 5742 if (0<$#{[keys %picks]}) { 5743 foreach my $key (keys %picks) { 5744 push @{$select_ed}, $pn{$key}[0]; 5745 } 5746 } else { 5747 $select_ed=$pn{$numbor}[0]; 5748 } 5749 if ($Term::Menus::data_dump_streamer) { 5750 $cd=&Data::Dump::Streamer::Dump($sub)->Out(); 5751 $cd=&transform_sicm($cd,$numbor, 5752 \@all_menu_items_array,\%picks,'', 5753 $return_from_child_menu,$log_handle, 5754 $MenuUnit_hash_ref->{Name}); 5755#print "CD3=$cd\n<=CD\n";<STDIN>; 5756 $cd=&transform_pmsi($cd, 5757 $Conveyed,$SaveMMap, 5758 $picks_from_parent); 5759#print "CD4=$cd\n<=CD2\n";<STDIN>; 5760 } 5761 $cd=~s/\$CODE\d*\s*=\s*//s; 5762 $sub=eval $cd; 5763 my @resu=(); 5764 eval { @resu=$sub->() }; 5765 if ($@) { 5766 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 5767 if ($parent_menu && wantarray && !$no_wantarray) { 5768 return '',$FullMenu,$Selected,$Conveyed, 5769 $SavePick,$SaveMMap,$SaveNext, 5770 $Persists,$parent_menu,$@; 5771 } 5772 if (defined $log_handle && 5773 -1<index $log_handle,'*') { 5774 print $log_handle $@; 5775 close($log_handle); 5776 } 5777 if ($Term::Menus::fullauto) { 5778 &Net::FullAuto::FA_Core::handle_error($@); 5779 } else { die $@ } 5780 } else { 5781 my $die="\n FATAL ERROR! - The Local " 5782 ."System $Term::Menus::local_hostname " 5783 ."Conveyed\n" 5784 ." the Following " 5785 ."Unrecoverable Error Condition :\n\n" 5786 ." $@\n line ".__LINE__; 5787 if ($parent_menu && wantarray && !$no_wantarray) { 5788 return '',$FullMenu,$Selected,$Conveyed, 5789 $SavePick,$SaveMMap,$SaveNext, 5790 $Persists,$parent_menu,$die; 5791 } 5792 if (defined $log_handle && 5793 -1<index $log_handle,'*') { 5794 print $log_handle $die; 5795 close($log_handle); 5796 } 5797 if ($Term::Menus::fullauto) { 5798 &Net::FullAuto::FA_Core::handle_error($die); 5799 } else { die $die } 5800 } 5801 } 5802 if (-1<$#resu) { 5803 if ($resu[0] eq '<') { %picks=();next } 5804 if (0<$#resu && wantarray && !$no_wantarray) { 5805 return @resu; 5806 } else { 5807 return return_result($resu[0], 5808 $MenuUnit_hash_ref,$Conveyed); 5809 } 5810 } 5811 } elsif ($test_result && 5812 ($test_result!~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ || 5813 (!grep { $1 eq $_ } list_module('main', 5814 $Term::Menus::fa_code) && $picks{$numbor} ne '*'))) { 5815 my $die="The \"Result12 =>\" Setting\n -> " 5816 ."$test_result\n Found in the Menu " 5817 ."Unit -> ".$MenuUnit_hash_ref 5818 ."\n is NOT a Menu Unit\," 5819 ."\ and it is NOT a Valid Subroutine.\n\n" 5820 ."\n Cannot Determine " 5821 ."if it is a Valid SubRoutine.\n\n"; 5822 die $die; 5823 } elsif (!defined $pn{$numbor}[0] || 5824 !exists ${$FullMenu}{$MenuUnit_hash_ref}[2]{ 5825 $pn{$numbor}[0]}) { 5826 my @resu=map { $all_menu_items_array[$_-1] } 5827 sort numerically keys %picks; 5828 push @resu,\%picks,$MenuUnit_hash_ref; 5829 if (wantarray && !$no_wantarray) { 5830 return @resu; 5831 } elsif ($#resu==0) { 5832 return @resu; 5833 } else { 5834 return \@resu; 5835 } 5836 } 5837 if (${$FullMenu}{$MenuUnit_hash_ref}[2] 5838 {$pn{$numbor}[0]}) { } 5839 ($FullMenu,$Conveyed,$SaveNext, 5840 $Persists,$Selected,$convey,$parent_menu) 5841 =$get_result->($MenuUnit_hash_ref, 5842 \@all_menu_items_array,\%picks,$picks_from_parent, 5843 $FullMenu,$Conveyed,$Selected,$SaveNext, 5844 $Persists,$parent_menu); 5845 my %pick=(); 5846 $pick{$numbor}='*'; 5847 %{$SavePick->{$MenuUnit_hash_ref}}=%pick; 5848 if ($Term::Menus::fullauto && (!exists 5849 $MenuUnit_hash_ref->{'NoPlan'} || 5850 !$MenuUnit_hash_ref->{'NoPlan'}) && 5851 defined $Net::FullAuto::FA_Core::makeplan) { 5852#print "IN MAKEPLAN17\n"; 5853 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{'Plan'}} && 5854 !exists 5855 $Net::FullAuto::FA_Core::makeplan->{'Title'}) { 5856 $Net::FullAuto::FA_Core::makeplan->{'Title'} 5857 =$pn{$numbor}[0]; 5858 } 5859 unless ($got_default) { 5860 push @{$Net::FullAuto::FA_Core::makeplan->{'Plan'}}, 5861 { Menu => &pw($MenuUnit_hash_ref), 5862 Number => $numbor, 5863 PlanID => 5864 $Net::FullAuto::FA_Core::makeplan->{Number}, 5865 Item => $pn{$numbor}[0] } 5866 } 5867 } 5868 my $subfile=substr($Term::Menus::fa_code,0,-3) 5869 .'::' if $Term::Menus::fa_code; 5870 $subfile||=''; 5871 foreach my $sub (&get_subs_from_menu($Selected)) { 5872 my @resu=(); 5873 if (ref $sub eq 'CODE') { 5874 if ($Term::Menus::fullauto && (!exists 5875 ${$MenuUnit_hash_ref}{'NoPlan'} || 5876 !${$MenuUnit_hash_ref}{'NoPlan'}) && 5877 defined $Net::FullAuto::FA_Core::makeplan) { 5878#print "IN MAKEPLAN18\n"; 5879 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 5880 'Plan'}} && !exists 5881 $Net::FullAuto::FA_Core::makeplan->{ 5882 'Title'}) { 5883 $Net::FullAuto::FA_Core::makeplan->{'Title'} 5884 =$pn{$numbor}[0]; 5885 } 5886 my $n='Number'; 5887 push @{$Net::FullAuto::FA_Core::makeplan->{ 5888 'Plan'}}, 5889 { Menu => &pw($MenuUnit_hash_ref), 5890 Number => $numbor, 5891 PlanID => 5892 $Net::FullAuto::FA_Core::makeplan->{$n}, 5893 Item => 5894 &Data::Dump::Streamer::Dump($sub)->Out() 5895 } 5896 } 5897 eval { @resu=$sub->() }; 5898 if ($@) { 5899 if (10<length $@ && unpack('a11',$@) 5900 eq 'FATAL ERROR') { 5901 if ($parent_menu && wantarray && !$no_wantarray) { 5902 return '',$FullMenu,$Selected,$Conveyed, 5903 $SavePick,$SaveMMap,$SaveNext, 5904 $Persists,$parent_menu,$@; 5905 } 5906 if (defined $log_handle && 5907 -1<index $log_handle,'*') { 5908 print $log_handle $@; 5909 close($log_handle); 5910 } 5911 if ($Term::Menus::fullauto) { 5912 &Net::FullAuto::FA_Core::handle_error($@); 5913 } else { die $@ } 5914 } else { 5915 my $die="\n FATAL ERROR! - The Local " 5916 ."System $Term::Menus::local_hostname " 5917 ."Conveyed\n" 5918 ." the Following " 5919 ."Unrecoverable Error Condition :\n\n" 5920 ." $@\n line ".__LINE__; 5921 if ($parent_menu && wantarray && !$no_wantarray) { 5922 return '',$FullMenu,$Selected,$Conveyed, 5923 $SavePick,$SaveMMap,$SaveNext, 5924 $Persists,$parent_menu,$die; 5925 } 5926 if (defined $log_handle && 5927 -1<index $log_handle,'*') { 5928 print $log_handle $die; 5929 close($log_handle); 5930 } 5931 if ($Term::Menus::fullauto) { 5932 &Net::FullAuto::FA_Core::handle_error($die); 5933 } else { die $die } 5934 } 5935 } 5936 if (-1<$#resu) { 5937 if ($resu[0] eq '<') { %picks=();next } 5938 if (0<$#resu && wantarray && !$no_wantarray) { 5939 return @resu; 5940 } else { 5941 return return_result($resu[0], 5942 $MenuUnit_hash_ref,$Conveyed); 5943 } 5944 } 5945 $done=1;last 5946 } 5947 eval { 5948 if ($subfile) { 5949 $sub=~s/^[&]//; 5950 if ($Term::Menus::fullauto && (!exists 5951 ${$MenuUnit_hash_ref}{'NoPlan'} || 5952 !${$MenuUnit_hash_ref}{'NoPlan'}) && 5953 defined $Net::FullAuto::FA_Core::makeplan) { 5954#print "IN MAKEPLAN19\n"; 5955 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 5956 'Plan'}} && !exists 5957 $Net::FullAuto::FA_Core::makeplan->{ 5958 'Title'}) { 5959 $Net::FullAuto::FA_Core::makeplan->{'Title'} 5960 =$pn{$numbor}[0]; 5961 } 5962 my $n='Number'; 5963 push @{$Net::FullAuto::FA_Core::makeplan->{ 5964 'Plan'}}, 5965 { Menu => &pw($MenuUnit_hash_ref), 5966 Number => $numbor, 5967 PlanID => 5968 $Net::FullAuto::FA_Core::makeplan->{$n}, 5969 Item => "&$subfile$sub" } 5970 } 5971 eval "\@resu=\&$subfile$sub"; 5972 my $firsterr=$@||''; 5973 if ((-1<index $firsterr,'Undefined subroutine') && 5974 (-1<index $firsterr,$sub)) { 5975 if ($sub!~/::/) { 5976 eval "\@resu=main::$sub"; 5977 } else { 5978 eval "\@resu=$sub"; 5979 } 5980 my $seconderr=$@||'';my $die=''; 5981 if ($seconderr=~/Undefined subroutine/) { 5982 if (${$FullMenu}{$MenuUnit_hash_ref} 5983 [2]{$all_menu_items_array[$numbor-1]}) { 5984 $die="The \"Result15 =>\" Setting" 5985 ."\n\t\t-> " . ${$FullMenu} 5986 {$MenuUnit_hash_ref}[2] 5987 {$all_menu_items_array[$numbor-1]} 5988 ."\n\t\tFound in the Menu Unit -> " 5989 .$MenuUnit_hash_ref->{Name}."\n\t\t" 5990 ."Specifies a Subroutine" 5991 ." that Does NOT Exist" 5992 ."\n\t\tin the User Code File " 5993 .$Term::Menus::fa_code 5994 .",\n\t\tnor was a routine with " 5995 ."that name\n\t\tlocated in the" 5996 ." main:: script.\n"; 5997 } else { $die="$firsterr\n $seconderr" } 5998 } else { $die=$seconderr } 5999 &Net::FullAuto::FA_Core::handle_error($die); 6000 } elsif ($firsterr) { 6001 &Net::FullAuto::FA_Core::handle_error($firsterr); 6002 } 6003 } else { 6004 if ($sub!~/::/) { 6005 $sub=~s/^[&]//; 6006 eval "\@resu=main::$sub"; 6007 } else { 6008 eval "\@resu=$sub"; 6009 } 6010 die $@ if $@; 6011 } 6012 }; 6013 if ($@) { 6014 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 6015 if ($parent_menu && wantarray && !$no_wantarray) { 6016 return '',$FullMenu,$Selected,$Conveyed, 6017 $SavePick,$SaveMMap,$SaveNext, 6018 $Persists,$parent_menu,$@; 6019 } 6020 if (defined $log_handle && 6021 -1<index $log_handle,'*') { 6022 print $log_handle $@; 6023 close($log_handle); 6024 } 6025 if ($Term::Menus::fullauto) { 6026 &Net::FullAuto::FA_Core::handle_error($@); 6027 } else { die $@ } 6028 } else { 6029 my $die="\n FATAL ERROR! - The Local " 6030 ."System $Term::Menus::local_hostname " 6031 ."Conveyed\n" 6032 ." the Following " 6033 ."Unrecoverable Error Condition :\n\n" 6034 ." $@\n line ".__LINE__; 6035 if ($parent_menu && wantarray && !$no_wantarray) { 6036 return '',$FullMenu,$Selected,$Conveyed, 6037 $SavePick,$SaveMMap,$SaveNext, 6038 $Persists,$parent_menu,$die; 6039 } 6040 if (defined $log_handle && 6041 -1<index $log_handle,'*') { 6042 print $log_handle $die; 6043 close($log_handle); 6044 } 6045 if ($Term::Menus::fullauto) { 6046 &Net::FullAuto::FA_Core::handle_error($die); 6047 } else { die $die } 6048 } 6049 } 6050 if (-1<$#resu) { 6051 if ($resu[0] eq '<') { %picks=();next } 6052 if (0<$#resu && wantarray && !$no_wantarray) { 6053 return @resu; 6054 } else { 6055 return return_result($resu[0], 6056 $MenuUnit_hash_ref,$Conveyed); 6057 } 6058 } 6059 $done=1;last 6060 } 6061 } else { $done=1;last } 6062 return 'DONE_SUB'; 6063 } elsif (($show_banner_only && exists $MenuUnit_hash_ref-> 6064 {Result} && ref $MenuUnit_hash_ref->{Result} 6065 eq 'CODE')||(keys %{$FullMenu->{$MenuUnit_hash_ref}[2]} 6066 && exists $FullMenu->{$MenuUnit_hash_ref}[2] 6067 {$pn{$numbor}[0]})) { 6068 my $test_result=''; 6069 if ($show_banner_only) { 6070 $test_result=$MenuUnit_hash_ref->{Result}; 6071 $numbor=1; 6072 } else { 6073 $test_result= 6074 $FullMenu->{$MenuUnit_hash_ref}[2]{$pn{$numbor}[0]}; 6075 } 6076 if (ref $test_result eq 'CODE') { 6077 my @resu=(); 6078 my $test_result_loop=$test_result; 6079 while (1) { 6080 my $look_at_test_result= 6081 &Data::Dump::Streamer::Dump( 6082 $test_result_loop)->Out(); 6083 my $tspmi_regex=qr/\](!)?t(?:e+st[-_]*)*[p|s]* 6084 (?:r+vious[-_]*|e+lected[-_]*) 6085 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 6086 my $sicm_regex= 6087 qr/\](!)?s(?:e+lected[-_]*)*i*(?:t+ems[-_]*) 6088 *c*(?:u+rrent[-_]*)*m*(?:e+nu[-_]*)*\[/xi; 6089 my $tbii_regex=qr/\](!)?i(?:n+put[-_]*)*b*(?:a+nner[-_]*) 6090 *m*(?:e+nu[-_]*)*i*(?:t+ems[-_]*)*\[/xi; 6091 my $trim_look=$look_at_test_result; 6092 $trim_look=~s/^.*(\$CODE\d+\s*=\s*.*$)/$1/s; 6093 if ((($trim_look!~/Item_/s && 6094 $trim_look!~/[']Result['][,]/s) || 6095 $trim_look=~/=\s*[']Item_/s) || 6096 $look_at_test_result=~/$tspmi_regex/ || 6097 $trim_look=~/$sicm_regex/ || 6098 $trim_look=~/$tbii_regex/) { 6099 %picks=() unless $select_many; 6100 $picks{$numbor}=''; 6101 ($FullMenu,$Conveyed,$SaveNext,$Persists, 6102 $Selected,$convey,$parent_menu) 6103 =$get_result->($MenuUnit_hash_ref, 6104 \@all_menu_items_array,\%picks,$picks_from_parent, 6105 $FullMenu,$Conveyed,$Selected,$SaveNext, 6106 $Persists,$parent_menu); 6107 my $item=($show_banner_only)?'__FA_Banner__':$numbor; 6108 $test_result_loop= 6109 $Selected->{$MenuUnit_hash_ref}->{$item} 6110 if $Selected->{$MenuUnit_hash_ref}->{$item}; 6111 my $cd=&Data::Dump::Streamer::Dump( 6112 $test_result_loop)->Out(); 6113 $cd=&transform_sicm($cd,$numbor, 6114 \@all_menu_items_array,\%picks,\%pn, 6115 $return_from_child_menu,$log_handle, 6116 $MenuUnit_hash_ref->{Name}); 6117 $cd=&transform_pmsi($cd, 6118 $Conveyed,$SaveMMap, 6119 $picks_from_parent); 6120 $cd=&transform_mbir($cd,$Conveyed,$MenuUnit_hash_ref, 6121 $log_handle); 6122 $cd=~s/\$CODE\d*\s*=\s*//s; 6123 eval { $test_result_loop=eval $cd }; 6124 } 6125 eval { @resu=$test_result_loop->() }; 6126 if ($@) { 6127 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 6128 if ($parent_menu && wantarray && !$no_wantarray) { 6129 return '',$FullMenu,$Selected,$Conveyed, 6130 $SavePick,$SaveMMap,$SaveNext, 6131 $Persists,$parent_menu,$@; 6132 } 6133 if (defined $log_handle && 6134 -1<index $log_handle,'*') { 6135 print $log_handle $@; 6136 close($log_handle); 6137 } 6138 if ($Term::Menus::fullauto) { 6139 &Net::FullAuto::FA_Core::handle_error($@); 6140 } else { die $@ } 6141 } else { 6142 my $die="\n FATAL ERROR! - The Local " 6143 ."System $Term::Menus::local_hostname " 6144 ."Conveyed\n" 6145 ." the Following " 6146 ."Unrecoverable Error Condition :\n\n" 6147 ." $@\n line ".__LINE__; 6148 if ($parent_menu && wantarray && !$no_wantarray) { 6149 return '',$FullMenu,$Selected,$Conveyed, 6150 $SavePick,$SaveMMap,$SaveNext, 6151 $Persists,$parent_menu,$die; 6152 } 6153 if (defined $log_handle && 6154 -1<index $log_handle,'*') { 6155 print $log_handle $die; 6156 close($log_handle); 6157 } 6158 if ($Term::Menus::fullauto) { 6159 &Net::FullAuto::FA_Core::handle_error($die); 6160 } else { die $die } 6161 } 6162 } 6163 if (0==$#resu && ref $resu[0] eq 'CODE') { 6164 $test_result_loop=$resu[0]; 6165 $SaveNext->{$MenuUnit_hash_ref}=$resu[0]; 6166 next; 6167 } else { 6168 last; 6169 } 6170 } 6171 if (-1<$#resu) { 6172 if ($resu[0] eq '<') { %picks=();next } 6173 if (0<$#resu && wantarray && !$no_wantarray) { 6174 if (1==$recurse_level) { 6175 return \@resu; 6176 } else { 6177 return @resu; 6178 } 6179 } elsif (ref $resu[0] eq 'HASH') { 6180 if (grep { /Item_/ } keys %{$resu[0]} && $parent_menu) { 6181 if (exists $FullMenu->{$parent_menu}[2] 6182 {'__FA_Banner__'}) { 6183 $FullMenu->{$MenuUnit_hash_ref}[2] 6184 {'__FA_Banner__'}=$resu[0]; 6185 } else { 6186 $FullMenu->{$MenuUnit_hash_ref}[2] 6187 {$pn{$numbor}[0]}=$resu[0]; 6188 } 6189 } else { 6190 $FullMenu->{$MenuUnit_hash_ref}[2]{'__FA_Banner__'}= 6191 $resu[0]; 6192 } 6193 } else { 6194 return return_result($resu[0], 6195 $MenuUnit_hash_ref,$Conveyed); 6196 } 6197 } 6198 } elsif ($test_result!~/^&?(?:.*::)*(\w+)\s*[(]?.*[)]?\s*$/ || 6199 !grep { $1 eq $_ } list_module( 6200 'main',$Term::Menus::fa_code)) { 6201 my $die="The \"Result14 =>\" Setting\n -> " 6202 .$test_result 6203 ."\n Found in the Menu Unit -> " 6204 .$MenuUnit_hash_ref 6205 ."\n is not a Menu Unit\," 6206 ." and not a Valid SubRoutine.\n\n"; 6207 die $die; 6208 } 6209 %picks=() unless $select_many; 6210 $picks{$numbor}=''; 6211 ($FullMenu,$Conveyed,$SaveNext,$Persists, 6212 $Selected,$convey,$parent_menu) 6213 =$get_result->($MenuUnit_hash_ref, 6214 \@all_menu_items_array,\%picks,$picks_from_parent, 6215 $FullMenu,$Conveyed,$Selected,$SaveNext, 6216 $Persists,$parent_menu); 6217 my $show_banner_only=0; 6218 my $test_item=''; 6219 if (exists $Selected->{$MenuUnit_hash_ref}{'__FA_Banner__'}) { 6220 $test_item=$Selected->{$MenuUnit_hash_ref}{'__FA_Banner__'}; 6221 $show_banner_only=1; 6222 } else { 6223 $test_item=$FullMenu->{$MenuUnit_hash_ref}[2] 6224 {$pn{$numbor}[0]}; 6225 } 6226 $test_item||=''; 6227 if ((ref $test_item eq 'HASH' && 6228 grep { /Item_/ } keys %{$test_item}) || 6229 $show_banner_only) { 6230 $Conveyed->{&pw($MenuUnit_hash_ref)}=[]; 6231 if (0<$#{[keys %picks]}) { 6232 foreach my $key (sort numerically keys %picks) { 6233 push @{$Conveyed->{&pw($MenuUnit_hash_ref)}}, 6234 $all_menu_items_array[$key-1]; 6235 } 6236 } else { 6237 $Conveyed->{&pw($MenuUnit_hash_ref)}= 6238 $all_menu_items_array[$numbor-1]; 6239 } 6240 my $mcount=0; 6241 unless (exists $SaveMMap->{$MenuUnit_hash_ref}) { 6242 if ($filtered_menu) { 6243 my $pmap=[]; 6244 foreach my $kee (keys %{$SaveMMap}) { 6245 my $map=&Data::Dump::Streamer::Dump( 6246 $SaveMMap->{$kee})->Out(); 6247 $map=~s/\$ARRAY\d*\s*=\s*//s; 6248 my $m=eval $map; 6249 $pmap=$m if $#{$pmap}<$#{$m}; 6250 } 6251 $SaveMMap->{$MenuUnit_hash_ref}=$pmap; 6252 $mcount=&get_Menu_map_count( 6253 $SaveMMap->{$MenuUnit_hash_ref}); 6254 } elsif ($parent_menu) { 6255 my $parent_map=&Data::Dump::Streamer::Dump( 6256 $SaveMMap->{$parent_menu})->Out(); 6257 $parent_map=~s/\$ARRAY\d*\s*=\s*//s; 6258 $SaveMMap->{$MenuUnit_hash_ref}=eval $parent_map; 6259 $mcount=&get_Menu_map_count( 6260 $SaveMMap->{$MenuUnit_hash_ref}); 6261 } else { 6262 $SaveMMap->{$MenuUnit_hash_ref}=[]; 6263 } 6264 } 6265 if (ref $convey eq 'ARRAY') { 6266 push @{$SaveMMap->{$MenuUnit_hash_ref}}, 6267 [ ++$mcount, $convey->[0] ]; 6268 } else { 6269 push @{$SaveMMap->{$MenuUnit_hash_ref}}, 6270 [ ++$mcount, $convey ]; 6271 } 6272 $MenuMap=$SaveMMap->{$MenuUnit_hash_ref}; 6273 my $returned_FullMenu=''; 6274 my $returned_Selected=''; 6275 my $returned_Conveyed=''; 6276 my $returned_SavePick=''; 6277 my $returned_SaveMMap=''; 6278 my $returned_SaveNext=''; 6279 my $returned_Persists=''; 6280 my $menu_result=''; 6281 if ($show_banner_only) { 6282 $menu_result=$test_item; 6283 } else { 6284 $menu_result=$FullMenu->{$MenuUnit_hash_ref}[2] 6285 {$all_menu_items_array[$numbor-1]}; 6286 } 6287 $SaveNext->{$MenuUnit_hash_ref}=$menu_result 6288 unless exists $SaveNext->{$MenuUnit_hash_ref}; 6289 eval { 6290 ($menu_output,$returned_FullMenu, 6291 $returned_Selected,$returned_Conveyed, 6292 $returned_SavePick,$returned_SaveMMap, 6293 $returned_SaveNext,$returned_Persists) 6294 =&Menu($menu_result,$convey, 6295 $recurse_level,$FullMenu, 6296 $Selected,$Conveyed,$SavePick, 6297 $SaveMMap,$SaveNext,$Persists, 6298 $MenuUnit_hash_ref,$no_wantarray); 6299 }; # MENU RETURN MENURETURN 8 6300 print "MENU RETURN 8\n" if $menu_return_debug; 6301 die $@ if $@; 6302 chomp($menu_output) if !(ref $menu_output); 6303 my $test_for_menu_name=$MenuUnit_hash_ref->{Name}; 6304 if ($menu_output eq '-') { 6305 $return_from_child_menu='-'; 6306 next; 6307 } elsif ($menu_output eq '+') { 6308 $return_from_child_menu='+'; 6309 next; 6310 } elsif ($menu_output eq 'DONE_SUB') { 6311 return 'DONE_SUB'; 6312 } elsif ($menu_output eq 'DONE' and 1<$recurse_level) { 6313 return 'DONE'; 6314 } elsif (ref $menu_output eq 'ARRAY' && 6315 $menu_output->[0]=~ 6316 /^[{]$test_for_menu_name[}][<]$/) { 6317 delete $Selected->{$MenuUnit_hash_ref}; 6318 delete $Conveyed->{$MenuUnit_hash_ref}; 6319 delete $SavePick->{$MenuUnit_hash_ref}; 6320 delete $SaveMMap->{$MenuUnit_hash_ref}; 6321 delete $SaveNext->{$MenuUnit_hash_ref}; 6322 delete $Persists->{$MenuUnit_hash_ref}; 6323 delete $FullMenu->{$MenuUnit_hash_ref}[2] 6324 {'__FA_Banner__'}; 6325 %picks=(); 6326 $start=$FullMenu->{$MenuUnit_hash_ref}[11]-1 if 6327 $start+$choose_num<$FullMenu->{$MenuUnit_hash_ref}[11]; 6328 $choose_num=$num_pick-$start if 6329 $display_this_many_items>=$num_pick-$start; 6330 next; 6331 } elsif ($menu_output) { 6332 return $menu_output; 6333 } else { 6334 $FullMenu=$returned_FullMenu; 6335 $Selected=$returned_Selected; 6336 $Conveyed=$returned_Conveyed; 6337 $SavePick=$returned_SavePick; 6338 $SaveMMap=$returned_SaveMMap; 6339 $SaveNext=$returned_SaveNext; 6340 $Persists=$returned_Persists; 6341 } 6342 } 6343 my %pick=(); 6344 $pick{$numbor}='*'; 6345 %{$SavePick->{$MenuUnit_hash_ref}}=%pick; 6346 my $subfile=($Term::Menus::fullauto) 6347 ?substr($Term::Menus::fa_code,0,-3).'::' 6348 :''; 6349 foreach my $sub (&get_subs_from_menu($Selected)) { 6350 my @resu=(); 6351 if (ref $sub eq 'CODE') { 6352 if ($Term::Menus::fullauto && (!exists 6353 $MenuUnit_hash_ref->{'NoPlan'} || 6354 !$MenuUnit_hash_ref->{'NoPlan'}) && 6355 defined $Net::FullAuto::FA_Core::makeplan) { 6356#print "IN MAKEPLAN20\n"; 6357 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 6358 'Plan'}} && !exists 6359 $Net::FullAuto::FA_Core::makeplan->{ 6360 'Title'}) { 6361 $Net::FullAuto::FA_Core::makeplan->{'Title'} 6362 =$pn{$numbor}[0]; 6363 } 6364 push @{$Net::FullAuto::FA_Core::makeplan->{ 6365 'Plan'}}, 6366 { Menu => &pw($MenuUnit_hash_ref), 6367 Number => $numbor, 6368 PlanID => 6369 $Net::FullAuto::FA_Core::makeplan->{Number}, 6370 Item => 6371 &Data::Dump::Streamer::Dump($sub)->Out() } 6372 } 6373 eval { @resu=$sub->() }; 6374 if ($@) { 6375 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 6376 if ($parent_menu && wantarray && !$no_wantarray) { 6377 return '',$FullMenu,$Selected,$Conveyed, 6378 $SavePick,$SaveMMap,$SaveNext, 6379 $Persists,$parent_menu,$@; 6380 } 6381 if (defined $log_handle && 6382 -1<index $log_handle,'*') { 6383 print $log_handle $@; 6384 close($log_handle); 6385 } 6386 if ($Term::Menus::fullauto) { 6387 &Net::FullAuto::FA_Core::handle_error($@); 6388 } else { die $@ } 6389 } else { 6390 my $die="\n FATAL ERROR! - The Local " 6391 ."System $Term::Menus::local_hostname " 6392 ."Conveyed\n" 6393 ." the Following " 6394 ."Unrecoverable Error Condition :\n\n" 6395 ." $@\n line ".__LINE__; 6396 if ($parent_menu && wantarray && !$no_wantarray) { 6397 return '',$FullMenu,$Selected,$Conveyed, 6398 $SavePick,$SaveMMap,$SaveNext, 6399 $Persists,$parent_menu,$die; 6400 } 6401 if (defined $log_handle && 6402 -1<index $log_handle,'*') { 6403 print $log_handle $die; 6404 close($log_handle); 6405 } 6406 if ($Term::Menus::fullauto) { 6407 &Net::FullAuto::FA_Core::handle_error($die); 6408 } else { die $die } 6409 } 6410 } 6411 if (-1<$#resu) { 6412 if ($resu[0] eq '<') { %picks=();next } 6413 if ($resu[0]=~/^[{](.*)[}][<]$/) { 6414 if ($1 eq $MenuUnit_hash_ref->{Name}) { 6415 %picks=();next; 6416 } else { 6417 return $resu[0]; 6418 } 6419 } 6420 if (0<$#resu && wantarray && !$no_wantarray) { 6421 return @resu; 6422 } else { 6423 return return_result($resu[0], 6424 $MenuUnit_hash_ref,$Conveyed); 6425 } 6426 } 6427 $done=1;last 6428 } 6429 eval { 6430 if ($subfile) { 6431 $sub=~s/^[&]//; 6432 if ($Term::Menus::fullauto && (!exists 6433 ${$MenuUnit_hash_ref}{'NoPlan'} || 6434 !${$MenuUnit_hash_ref}{'NoPlan'}) && 6435 defined $Net::FullAuto::FA_Core::makeplan) { 6436#print "IN MAKEPLAN21\n"; 6437 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{ 6438 'Plan'}} && !exists 6439 $Net::FullAuto::FA_Core::makeplan->{ 6440 'Title'}) { 6441 $Net::FullAuto::FA_Core::makeplan->{'Title'} 6442 =$pn{$numbor}[0]; 6443 } 6444 my $n='Number'; 6445 push @{$Net::FullAuto::FA_Core::makeplan->{ 6446 'Plan'}}, 6447 { Menu => &pw($MenuUnit_hash_ref), 6448 Number => $numbor, 6449 PlanID => 6450 $Net::FullAuto::FA_Core::makeplan->{$n}, 6451 Item => "&$subfile$sub" } 6452 } 6453 $sub=&transform_sicm($sub,$numbor, 6454 \@all_menu_items_array,\%picks,\%pn, 6455 $return_from_child_menu,$log_handle, 6456 $MenuUnit_hash_ref->{Name}); 6457 $sub=&transform_pmsi($sub, 6458 $Conveyed,$SaveMMap, 6459 $picks_from_parent); 6460 eval "\@resu=\&$subfile$sub"; 6461 my $firsterr=$@||''; 6462 if ((-1<index $firsterr,'Undefined subroutine') && 6463 (-1<index $firsterr,$sub)) { 6464 if ($sub!~/::/) { 6465 eval "\@resu=main::$sub"; 6466 } else { 6467 eval "\@resu=$sub"; 6468 } 6469 my $seconderr=$@||'';my $die=''; 6470 if ($seconderr=~/Undefined subroutine/) { 6471 if (${$FullMenu}{$MenuUnit_hash_ref} 6472 [2]{$all_menu_items_array[$numbor-1]}) { 6473 $die="The \"Result15 =>\" Setting" 6474 ."\n\t\t-> " . ${$FullMenu} 6475 {$MenuUnit_hash_ref}[2] 6476 {$all_menu_items_array[$numbor-1]} 6477 ."\n\t\tFound in the Menu Unit -> " 6478 .$MenuUnit_hash_ref->{Name}."\n\t\t" 6479 ."Specifies a Subroutine" 6480 ." that Does NOT Exist" 6481 ."\n\t\tin the User Code File " 6482 .$Term::Menus::fa_code 6483 .",\n\t\tnor was a routine with " 6484 ."that name\n\t\tlocated in the" 6485 ." main:: script.\n"; 6486 } else { $die="$firsterr\n $seconderr" } 6487 } else { $die=$seconderr } 6488 &Net::FullAuto::FA_Core::handle_error($die. 6489 "\n\n line ".__LINE__); 6490 } elsif ($firsterr) { 6491 if ($Term::Menus::fullauto) { 6492 &Net::FullAuto::FA_Core::handle_error($firsterr. 6493 "\n\n line ".__LINE__); 6494 } else { 6495 die "$firsterr\n\n line ".__LINE__; 6496 } 6497 } 6498 } else { 6499 $sub=&transform_sicm($sub,$numbor, 6500 \@all_menu_items_array,\%picks,\%pn, 6501 $return_from_child_menu,$log_handle, 6502 $MenuUnit_hash_ref->{Name}); 6503 $sub=&transform_pmsi($sub, 6504 $Conveyed,$SaveMMap, 6505 $picks_from_parent); 6506 if ($sub!~/::/) { 6507 $sub=~s/^[&]//; 6508 eval "\@resu=main::$sub"; 6509 } else { 6510 eval "\@resu=$sub"; 6511 } 6512 if ($@) { 6513 my $er=$@."\n line "; 6514 die $er.__LINE__; 6515 } 6516 } 6517 }; 6518 if ($@) { 6519 if (10<length $@ && unpack('a11',$@) eq 'FATAL ERROR') { 6520 if ($parent_menu && wantarray && !$no_wantarray) { 6521 return '',$FullMenu,$Selected,$Conveyed, 6522 $SavePick,$SaveMMap,$SaveNext, 6523 $Persists,$parent_menu,$@; 6524 } 6525 if (defined $log_handle && 6526 -1<index $log_handle,'*') { 6527 print $log_handle $@; 6528 close($log_handle); 6529 } 6530 if ($Term::Menus::fullauto) { 6531 &Net::FullAuto::FA_Core::handle_error($@); 6532 } else { die $@ } 6533 } else { 6534 my $die="\n FATAL ERROR! - The Local " 6535 ."System $Term::Menus::local_hostname " 6536 ."Conveyed\n" 6537 ." the Following " 6538 ."Unrecoverable Error Condition :\n\n" 6539 ." $@\n line ".__LINE__; 6540 if ($parent_menu && wantarray && !$no_wantarray) { 6541 return '',$FullMenu,$Selected,$Conveyed, 6542 $SavePick,$SaveMMap,$SaveNext, 6543 $Persists,$parent_menu,$die; 6544 } 6545 if (defined $log_handle && 6546 -1<index $log_handle,'*') { 6547 print $log_handle $die; 6548 close($log_handle); 6549 } 6550 if ($Term::Menus::fullauto) { 6551 &Net::FullAuto::FA_Core::handle_error($die); 6552 } else { die $die } 6553 } 6554 } 6555 if (-1<$#resu) { 6556 if ($resu[0] eq '<') { %picks=();next } 6557 if ($resu[0]=~/^[{](.*)[}][<]$/) { 6558 if ($1 eq $MenuUnit_hash_ref->{Name}) { 6559 %picks=();next; 6560 } else { 6561 return $resu[0]; 6562 } 6563 } 6564 if (0<$#resu && wantarray && !$no_wantarray) { 6565 return @resu; 6566 } else { 6567 return return_result($resu[0], 6568 $MenuUnit_hash_ref,$Conveyed); 6569 } 6570 } 6571 $done=1;last 6572 } 6573 return 'DONE_SUB'; 6574 } elsif ($return_from_child_menu && 6575 !exists $SavePick->{$MenuUnit_hash_ref}->{$pn{$numbor}}) { 6576 delete_Selected($MenuUnit_hash_ref); 6577 $done=1;last; 6578 } else { $done=1 } 6579 last if !$return_from_child_menu; 6580 } 6581 } last if $done; 6582 } 6583 if ($select_many || 6584 (exists ${$MenuUnit_hash_ref}{Select}{(keys %picks)[0]||''})) { 6585 my @picks=(); 6586 foreach (sort numerically keys %picks) { 6587 my $pik=$all_menu_items_array[$_-1]; 6588 push @picks, $pik; 6589 } undef @all_menu_items_array; 6590 if ($MenuUnit_hash_ref) { 6591 push @picks,\%picks; 6592 push @picks,$MenuUnit_hash_ref; 6593 return \@picks, 6594 $FullMenu,$Selected,$Conveyed, 6595 $SavePick,$SaveMMap,$SaveNext, 6596 $Persists,$parent_menu; 6597 } else { 6598 return @picks; 6599 } 6600 } 6601 my $pick=''; 6602 if ($filtered_menu) { 6603 $pick=${$FullMenu}{$MenuUnit_hash_ref}[10]->[$numbor-1]; 6604 } elsif ($numbor=~/^\d+$/) { 6605 $pick=$all_menu_items_array[$numbor-1]; 6606 } 6607 undef @all_menu_items_array; 6608 if ($Term::Menus::fullauto && (!exists ${$MenuUnit_hash_ref}{'NoPlan'} || 6609 !${$MenuUnit_hash_ref}{'NoPlan'}) && 6610 defined $Net::FullAuto::FA_Core::makeplan) { 6611#print "IN MAKEPLAN23\n"; 6612 if (-1==$#{$Net::FullAuto::FA_Core::makeplan{'Plan'}} && 6613 !exists $Net::FullAuto::FA_Core::makeplan->{'Title'}) { 6614 $Net::FullAuto::FA_Core::makeplan->{'Title'}=$pick; 6615 } 6616 unless ($got_default) { 6617 push @{$Net::FullAuto::FA_Core::makeplan->{'Plan'}}, 6618 { Menu => &pw($MenuUnit_hash_ref), 6619 Number => $numbor, 6620 PlanID => 6621 $Net::FullAuto::FA_Core::makeplan->{Number}, 6622 Item => $pick } 6623 } 6624 } 6625 if (wantarray) { 6626 return $pick, 6627 $FullMenu,$Selected,$Conveyed, 6628 $SavePick,$SaveMMap,$SaveNext, 6629 $Persists,$parent_menu; 6630 } else { 6631 return $pick; 6632 } 6633 6634} 6635 6636sub return_result { 6637 6638 my $result_string=$_[0]; 6639 my $MenuUnit_hash_ref=$_[1]; 6640 my $Conveyed=$_[2]; 6641 $Conveyed->{&pw($MenuUnit_hash_ref)}=$result_string; 6642 my $result_array=[]; 6643 if ((-1<index $result_string,'][[') && 6644 (-1<index $result_string,']][')) { 6645 $result_string=~s/^\s*\]\[\[\s*//s; 6646 $result_string=~s/\s*\]\]\[\s*$//s; 6647 my @elems=split /\s*\]\|\[\s*/,$result_string; 6648 foreach my $elem (@elems) { 6649 if (unpack('a5',$elem) eq 'eval ') { 6650 $elem=unpack('x5 a*',$elem); 6651 push @{$result_array}, eval $elem; 6652 } else { 6653 push @{$result_array}, $elem; 6654 } 6655 } 6656 } return [ $result_string ]; 6657 6658} 6659 6660sub escape_quotes { 6661 6662 my $sub=$_[0]; 6663 return $sub if -1==index $sub,'"'; 6664 my $routine=substr($sub,0,(index $sub,'(')+1); 6665 my $args=substr($sub,(index $sub,'(')+1,-1); 6666 $args=~s/[']/!%!'%!%/g; 6667 $args=~s/^\s*(["]|!%!)//;$args=~s/(["]|%!%)\s*$//; 6668 my @args=split /(?:["]|%!%)\s*,\s*(?:["]|!%!)/, $args; 6669 my @newargs=(); 6670 foreach my $arg (@args) { 6671 $arg=~s/(!%!|%!%)//g; 6672 if ($arg=~/^[']/) { 6673 push @newargs, $arg; 6674 } else { 6675 $arg=~s/["]/\\"/g; 6676 push @newargs, '"'.$arg.'"'; 6677 } 6678 } 6679 $sub=$routine; 6680 foreach my $arg (@newargs) { 6681 $sub.=$arg.","; 6682 } 6683 chop $sub; 6684 $sub.=')'; 6685 return $sub; 6686 6687} 6688 66891; 6690 6691package TMMemHandle; 6692 6693use strict; 6694sub TIEHANDLE { 6695 my $class = shift; 6696 bless [], $class; 6697} 6698 6699sub PRINT { 6700 my $self = shift; 6701 push @$self, join '', @_; 6702} 6703 6704sub PRINTF { 6705 my $self = shift; 6706 my $fmt = shift; 6707 push @$self, sprintf $fmt, @_; 6708} 6709 6710sub READLINE { 6711 my $self = shift; 6712 shift @$self; 6713} 6714 67151; 6716 6717__END__; 6718 6719######################## User Documentation ########################## 6720 6721 6722## To format the following documentation into a more readable format, 6723## use one of these programs: perldoc; pod2man; pod2html; pod2text. 6724## For example, to nicely format this documentation for printing, you 6725## may use pod2man and groff to convert to postscript: 6726## pod2man Term/Menus.pm | groff -man -Tps > Term::Menus.ps 6727 6728=head1 NAME 6729 6730Term::Menus - Create Powerful Terminal, Console and CMD Enviroment Menus 6731 6732=head1 SYNOPSIS 6733 6734C<use Term::Menus;> 6735 6736see METHODS section below 6737 6738=head1 DESCRIPTION 6739 6740Term::Menus allows you to create powerful Terminal, Console and CMD environment 6741menus. Any perl script used in a Terminal, Console or CMD environment can 6742now include a menu facility that includes sub-menus, forward and backward 6743navigation, single or multiple selection capabilities, dynamic item creation 6744and customized banners. All this power is simple to implement with a straight 6745forward and very intuitive configuration hash structure that mirrors the actual 6746menu architechture needed by the application. A separate configuration file is 6747optional. Term::Menus is cross platform compatible. 6748 6749Term::Menus was initially conceived and designed to work seemlessly 6750with the perl based Network Process Automation Utility Module called 6751Net::FullAuto (Available in CPAN :-) - however, it is not itself dependant 6752on other Net::FullAuto components, and will work with *any* perl 6753script/application. 6754 6755 6756Reasons to use this module are: 6757 6758=over 2 6759 6760=item * 6761 6762You have a list (or array) of items, and wish to present the user a simple 6763CMD enviroment menu to pick a single item and return that item as a scalar 6764(or simple string). Example: 6765 6766 use Term::Menus; 6767 6768 my @list=('First Item','Second Item','Third Item'); 6769 my $banner=" Please Pick an Item:"; 6770 my $selection=&pick(\@list,$banner); 6771 print "SELECTION = $selection\n"; 6772 6773The user sees ==> 6774 6775 6776 Please Pick an Item: 6777 6778 1 First Item 6779 2 Second Item 6780 3 Third Item 6781 6782 (Press [F1] for HELP) 6783 6784 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6785 6786--< 2 >-<ENTER>---------------------------------- 6787 6788The user sees ==> 6789 6790 SELECTION = Second Item 6791 6792=item * 6793 6794You have a large list of items and need scrolling capability: 6795 6796 use Term::Menus; 6797 6798 my @list=`ls -1 /bin`; 6799 my $banner=" Please Pick an Item:"; 6800 my $selection=&pick(\@list,$banner); 6801 print "SELECTION = $selection\n"; 6802 6803The user sees ==> 6804 6805 Please Pick an Item: 6806 6807 1 arch 6808 2 ash 6809 3 awk 6810 4 basename 6811 5 bash 6812 6 cat 6813 7 chgrp 6814 8 chmod 6815 9 chown 6816 10 cp 6817 6818 a. Select All f. FINISH 6819 ___ 6820 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 6821 6822 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6823 6824--<ENTER>-------------------------------------- 6825 6826 Please Pick an Item: 6827 6828 11 cpio 6829 12 csh 6830 13 cut 6831 14 date 6832 15 dd 6833 16 df 6834 17 echo 6835 18 ed 6836 19 egrep 6837 20 env 6838 6839 a. Select All f. FINISH 6840 ___ 6841 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 6842 6843 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6844 6845--< 14 >-<ENTER>---------------------------------- 6846 6847The user sees ==> 6848 6849 SELECTION = date 6850 6851=item * 6852 6853You need to select multiple items and return the selected list: 6854 6855 use Term::Menus; 6856 6857 my %Menu_1=( 6858 6859 Item_1 => { 6860 6861 Text => "/bin Utility - ]Convey[", 6862 Convey => [ `ls -1 /bin` ], 6863 6864 }, 6865 6866 Select => 'Many', 6867 Banner => "\n Choose a /bin Utility :" 6868 ); 6869 6870 my @selections=&Menu(\%Menu_1); 6871 print "SELECTIONS = @selections\n"; 6872 6873The user sees ==> 6874 6875 Choose a /bin Utility : 6876 6877 1 /bin Utility - arch 6878 2 /bin Utility - ash 6879 3 /bin Utility - awk 6880 4 /bin Utility - basename 6881 5 /bin Utility - bash 6882 6 /bin Utility - cat 6883 7 /bin Utility - chgrp 6884 8 /bin Utility - chmod 6885 9 /bin Utility - chown 6886 10 /bin Utility - cp 6887 6888 a. Select All c. Clear All f. FINISH 6889 ___ 6890 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 6891 6892 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6893 6894--< 3 >-<ENTER>---------------------------------- 6895 6896--< 7 >-<ENTER>---------------------------------- 6897 6898The user sees ==> 6899 6900 Choose a /bin Utility : 6901 6902 1 /bin Utility - arch 6903 2 /bin Utility - ash 6904 * 3 /bin Utility - awk 6905 4 /bin Utility - basename 6906 5 /bin Utility - bash 6907 6 /bin Utility - cat 6908 * 7 /bin Utility - chgrp 6909 8 /bin Utility - chmod 6910 9 /bin Utility - chown 6911 10 /bin Utility - cp 6912 6913 a. Select All c. Clear All f. FINISH 6914 ___ 6915 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 6916 6917 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6918 6919--< f >-<ENTER>---------------------------------- 6920 6921The user sees ==> 6922 6923 SELECTIONS = /bin Utility - awk /bin Utility - chgrp 6924 6925 6926=item * 6927 6928You need sub-menus: 6929 6930 use Term::Menus; 6931 6932 my %Menu_2=( 6933 6934 Name => 'Menu_2', 6935 Item_1 => { 6936 6937 Text => "]Previous[ is a ]Convey[ Utility", 6938 Convey => [ 'Good','Bad' ] 6939 6940 }, 6941 6942 Select => 'One', 6943 Banner => "\n Choose an Answer :" 6944 ); 6945 6946 my %Menu_1=( 6947 6948 Name => 'Menu_1', 6949 Item_1 => { 6950 6951 Text => "/bin/Utility - ]Convey[", 6952 Convey => [ `ls -1 /bin` ], 6953 Result => \%Menu_2, 6954 6955 }, 6956 6957 Select => 'One', 6958 Banner => "\n Choose a /bin Utility :" 6959 ); 6960 6961 my $selection=&Menu(\%Menu_1); 6962 print "\n SELECTION=$selection\n"; 6963 6964The user sees ==> 6965 6966 Choose a /bin Utility : 6967 6968 1. /bin Utility - arch 6969 2. /bin Utility - ash 6970 3. /bin Utility - awk 6971 4. /bin Utility - basename 6972 5. /bin Utility - bash 6973 6. /bin Utility - cat 6974 7. /bin Utility - chgrp 6975 8. /bin Utility - chmod 6976 9. /bin Utility - chown 6977 10. /bin Utility - cp 6978 6979 a. Select All c. Clear All f. FINISH 6980 ___ 6981 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 6982 6983 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6984 6985--< 5 >-<ENTER>---------------------------------- 6986 6987 Choose an Answer : 6988 6989 1 bash is a Good Utility 6990 2 bash is a Bad Utility 6991 6992 (Press [F1] for HELP) 6993 6994 ([ESC] to Quit) PLEASE ENTER A CHOICE: 6995 6996--< 1 >-<ENTER>---------------------------------- 6997 6998The user sees ==> 6999 7000 SELECTIONS = bash is a Good Utility 7001 7002=item * 7003 7004You have a large amount of text, or instructional information, and want 7005a I<banner only screen> that displays the banner only (no selections) and 7006that moves to the next screen/menu with just a press of the ENTER key. 7007Yet, you want to preserve selections from earlier menus, and/or return 7008to more menus after user completes reading the banner only screens. 7009You can also navigate backwards and forwards through these screens. 7010 7011 use Term::Menus: 7012 7013 my %Menu_1=( 7014 7015 Name => 'Menu_1', 7016 Banner => "\n This is a BANNER ONLY display." 7017 7018 ); 7019 7020 &Menu(\%Menu_1); 7021 7022The user sees ==> 7023 7024 This is a BANNER ONLY display. 7025 7026 ([ESC] to Quit) Press ENTER to continue ... 7027 7028=item * 7029 7030You want to use perl subroutines to create the text items and/or banner: 7031 7032 use Term::Menus; 7033 7034 sub create_items { 7035 7036 my $previous=shift; 7037 my @textlines=(); 7038 push @textlines, "$previous is a Good Utility"; 7039 push @textlines, "$previous is a Bad Utility"; 7040 return @textlines; 7041 ## return value must be an array 7042 ## NOT an array reference 7043 7044 } 7045 7046 sub create_banner { 7047 7048 my $previous=shift; 7049 return "\n Choose an Answer for $previous :" 7050 ## return value MUST be a string for banner 7051 7052 } 7053 7054 my %Menu_2=( 7055 7056 Name => 'Menu_2', 7057 Item_1 => { 7058 7059 Text => "]Convey[", 7060 Convey => "create_items(]Previous[)", 7061 7062 }, 7063 7064 Select => 'One', 7065 Banner => "create_banner(]Previous[)", 7066 7067 ); 7068 7069 my %Menu_1=( 7070 7071 Name => 'Menu_1', 7072 Item_1 => { 7073 7074 Text => "/bin/Utility - ]Convey[", 7075 Convey => [ `ls -1 /bin` ], 7076 Result => \%Menu_2, 7077 7078 }, 7079 7080 Select => 'One', 7081 Banner => "\n Choose a /bin Utility :" 7082 ); 7083 7084 my @selection=&Menu(\%Menu_1); 7085 print "\n SELECTION=@selection\n"; 7086 7087The user sees ==> 7088 7089 Choose a /bin Utility : 7090 7091 1 /bin Utility - arch 7092 2 /bin Utility - ash 7093 3 /bin Utility - awk 7094 4 /bin Utility - basename 7095 5 /bin Utility - bash 7096 6 /bin Utility - cat 7097 7 /bin Utility - chgrp 7098 8 /bin Utility - chmod 7099 9 /bin Utility - chown 7100 10 /bin Utility - cp 7101 7102 a. Select All c. Clear All f. FINISH 7103 ___ 7104 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 7105 7106 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7107 7108--< 5 >-<ENTER>---------------------------------- 7109 7110 Choose an Answer for bash : 7111 7112 1 bash is a Good Utility 7113 2 bash is a Bad Utility 7114 7115 (Press [F1] for HELP) 7116 7117 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7118 7119--< 1 >-<ENTER>---------------------------------- 7120 7121The user sees ==> 7122 7123 SELECTION = bash is a Good Utility 7124 7125=item * 7126 7127You want to use anonymous subroutines to create the text items and/or banner 7128(see the more detailed treatment of anonymous subroutines and Term::Menus 7129macros in a later section of this documentation): 7130 7131 use Term::Menus; 7132 7133 my $create_items = sub { 7134 7135 my $previous=shift; 7136 my @textlines=(); 7137 push @textlines, "$previous is a Good Utility"; 7138 push @textlines, "$previous is a Bad Utility"; 7139 return \@textlines; 7140 ## return value must an array reference 7141 7142 }; 7143 7144 my $create_banner = sub { 7145 7146 my $previous=shift; 7147 return "\n Choose an Answer for ]Previous[ :" 7148 ## return value MUST be a string for banner 7149 7150 }; 7151 7152 my %Menu_2=( 7153 7154 Name => 'Menu_2', 7155 Item_1 => { 7156 7157 Text => "]Convey[", 7158 Convey => $create_items->(']Previous['), # Subroutine executed 7159 # at runtime by Perl 7160 # and result is passed 7161 # to Term::Menus. 7162 7163 # Do not use this argument 7164 # construct with Result => 7165 # elements because only Menu 7166 # blocks or subroutines can 7167 # be passed. (Unless the 7168 # return item is itself 7169 # a Menu configuration 7170 # block [HASH] or an 7171 # anonymous subroutine 7172 # [CODE]) 7173 7174 }, 7175 7176 Select => 'One', 7177 Banner => $create_banner, # Perl passes sub itself at runtime and 7178 # execution is carried out by Term::Menus. 7179 7180 ); 7181 7182 my %Menu_1=( 7183 7184 Name => 'Menu_1', 7185 Item_1 => { 7186 7187 Text => "/bin/Utility - ]Convey[", 7188 Convey => [ `ls -1 /bin` ], 7189 Result => \%Menu_2, 7190 7191 }, 7192 7193 Select => 'One', 7194 Banner => "\n Choose a /bin Utility :" 7195 ); 7196 7197 my @selection=&Menu(\%Menu_1); 7198 print "\n SELECTION=@selection\n"; 7199 7200The user sees ==> 7201 7202 Choose a /bin Utility : 7203 7204 1 /bin Utility - arch 7205 2 /bin Utility - ash 7206 3 /bin Utility - awk 7207 4 /bin Utility - basename 7208 5 /bin Utility - bash 7209 6 /bin Utility - cat 7210 7 /bin Utility - chgrp 7211 8 /bin Utility - chmod 7212 9 /bin Utility - chown 7213 10 /bin Utility - cp 7214 7215 a. Select All c. Clear All f. FINISH 7216 ___ 7217 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 7218 7219 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7220 7221--< 5 >-<ENTER>---------------------------------- 7222 7223 Choose an Answer for bash : 7224 7225 1 bash is a Good Utility 7226 2 bash is a Bad Utility 7227 7228 (Press [F1] for HELP) 7229 7230 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7231 7232--< 1 >-<ENTER>---------------------------------- 7233 7234The user sees ==> 7235 7236 SELECTION = bash is a Good Utility 7237 7238=back 7239 7240Usage questions should be directed to the Usenet newsgroup 7241comp.lang.perl.modules. 7242 7243Contact me, Brian Kelly <Brian.Kelly@fullautosoftware.net>, 7244if you find any bugs or have suggestions for improvements. 7245 7246=head2 What To Know Before Using 7247 7248=over 2 7249 7250=item * 7251 7252There are two methods available with Term::Menus - &pick() and &Menu(). 7253C<&Menu()> uses C<&pick()> - you can get the same results using 7254only 7255C<&Menu()>. However, if you need to simply pick one item from a single 7256list - use C<&pick()>. The syntax is simpler, and you'll write less code. 7257;-) 7258 7259=item * 7260 7261You'll need to be running at least Perl version 5.002 to use this 7262module. 7263 7264=back 7265 7266=head1 METHODS 7267 7268=over 4 7269 7270=item B<pick> - create a simple menu 7271 7272 $pick = &pick ($list|\@list|['list',...],[$Banner]); 7273 7274Where I<$list> is a variable containing an array or list reference. 7275This argument can also be a escaped array (sending a reference) or 7276an anonymous array (which also sends a reference). 7277 7278I<$Banner> is an optional argument sending a customized Banner to 7279top the simple menu - giving instructions, descriptions, etc. 7280The default is "Please Pick an Item:" 7281 7282=item B<Menu> - create a complex Menu 7283 7284 $pick = &Menu ($list|\@list|['list',...],[$Banner]); 7285 7286Where I<$pick> is a variable containing an array or list reference 7287of the pick or picks. 7288 7289 @picks = &Menu ($Menu_1|\%Menu_1|{ Name => 'Menu_1' }); 7290 7291Where I<$Menu_1> is a hash reference to the top level Menu 7292Configuration Hash Structure. 7293 7294=back 7295 7296=head2 Menu Configuration Hash Structures 7297 7298=over 4 7299 7300These are the building blocks of the overall Menu architecture. Each 7301hash structure represents a I<menu screen>. A single menu layer, has 7302only one hash structure defining it. A menu with a single sub-menu 7303will have two hash structures. The menus connect via the C<Result> 7304element of an I<Item> - C<Item_1> - hash structure in parent menu 7305C<%Menu_1>: 7306 7307 7308 my %Menu_2=( 7309 7310 Name => 'Menu_2', 7311 Item_1 => { 7312 7313 Text => "]Previous[ is a ]Convey[ Utility", 7314 Convey => [ 'Good','Bad' ] 7315 }, 7316 7317 Select => 'One', 7318 Banner => "\n Choose an Answer :" 7319 ); 7320 7321 my %Menu_1=( 7322 7323 Name => 'Menu_1', 7324 Item_1 => { 7325 7326 Text => "/bin/Utility - ]Convey[", 7327 Convey => [ `ls -1 /bin` ], 7328 Result => \%Menu_2, 7329 7330 }, 7331 7332 Select => 'One', 7333 Banner => "\n Choose a /bin Utility :" 7334 ); 7335 7336=back 7337 7338=head3 Menu Component Elements 7339 7340Each Menu Configuration Hash Structure consists of elements that define 7341and control it's behavior, appearance, constitution and purpose. An 7342element's syntax is as you would expect it to be in perl - a key string 7343pointing to an assocaited value: C<key =E<gt> value>. The following 7344items 7345list supported key names and ther associated value types: 7346 7347=over 4 7348 7349=item 7350 7351B<Display> => 'Integer' 7352 7353=over 2 7354 7355 7356The I<Display> key is an I<optional> key that determines the number 7357of Menu 7358Items that will be displayed on each screen. This is useful when the items 7359are multi-lined, or the screen size is bigger or smaller than the default 7360number utilizes in the most practical fashion. The default number is 10. 7361 7362 Display => 15, 7363 7364=back 7365 7366=item 7367 7368B<Name> => 'Char String consisting of ASCII Characters' 7369 7370=over 2 7371 7372 7373The I<Name> key provides a unique identifier to each Menu Structure. 7374This element is not "strictly" required for most Menu construts to 7375function properly. Term::Menus goes to great lengths to discover and 7376utilize the Menu's name provided on the left side of the equals 7377character of a Menu block using the following construct: 7378 7379 my %MenuName=( 7380 7381 [ Menu Contents Here ] 7382 7383 ); 7384 7385In the above example, the Menu name is "MenuName". Most of the time 7386Term::Menus will discover this name successfully, affording the user 7387or Menu developer one less requirement to worry about. Allowing 7388Term::Menus to discover this name will cut down on opportunities for 7389coding errors (and we all have enough of those already). HOWEVER, 7390there are "edge cases" and more complex Menu constructs that will 7391prevent Term::Menus from accurately discovering this name. Therefore, 7392it is recommended and is considered a "best practice" to always 7393explicitly "Name" Menu blocks as follows: 7394 7395 my %MenuName=( 7396 7397 Name => 'MenuName', 7398 7399 [ Menu Contents Here ] 7400 7401 ); 7402 7403Be careful to always use the SAME NAME for the Name element as for 7404the Menu block itself. This can be a source of error, especially 7405when one is using Macros that reference Menu Names explicitly (So 7406be CAREFUL!) One case where the Name element must ALWAYS be used 7407(if one wishes to reference that Menu with an explicit Named Macro) 7408is when creating anonymous Menu blocks to feed directly to Result 7409elements: 7410 7411 my %ContainingMenu=( 7412 7413 Name => 'ContainingMenu', 7414 Item_1 => { 7415 7416 Text => "Some Text", 7417 Result => { 7418 7419 Name => "Anonymous_Menu", # MUST use "Name" element 7420 # if planning to use 7421 # explicit Macros 7422 7423 [ Menu Contents Here ] 7424 7425 }, 7426 }, 7427 7428 ); 7429 7430 7431=back 7432 7433=item 7434 7435B<Item_E<lt>intE<gt>> => { Item Configuration Hash 7436Structure } 7437 7438=over 2 7439 7440 7441The I<Item_E<lt>intE<gt>> elements define customized menu items. 7442There are 7443essentially two methods for creating menu items: The I<Item_E<lt>intE<gt>> 7444elements, and the C<]Convey[> macro (described later). The difference being 7445that the C<]Convey[> macro turns an Item Configuration Hash into an Item 7446I<Template> -> a B<powerful> way to I<Item>-ize large lists 7447or quantities 7448of data that would otherwise be difficult - even impossible - to anticipate 7449and cope with manually. 7450 7451 Item_1 => { Text => 'Item 1' }, 7452 Item_2 => { Text => 'Item 2' }, 7453 7454Items created via C<]Convey[> macros have two drawbacks: 7455 7456=over 2 7457 7458=item * 7459 7460They all have the same format. 7461 7462=item * 7463 7464They all share the same C<Result> element. 7465 7466=back 7467 7468The syntax and usage of I<Item_E<lt>intE<gt>> elements is important 7469and 7470extensive enough to warrant it's own section. See B<I<Item Configuration 7471Hash Structures>> below. 7472 7473=back 7474 7475=item 7476 7477B<Select> => 'One' --or-- 'Many' 7478 7479=over 2 7480 7481 7482The MENU LEVEL I<Select> element determines whether this particular menu 7483layer allows the selection of multiple items - or a single item. The 7484default is 'One'. 7485 7486 Select => 'Many', 7487 7488=back 7489 7490=item 7491 7492B<Banner> => 'Char String consisting of ASCII Characters' or 7493anonymous subroutine or subroutine reference for generating 7494dynamic banners. 7495 7496=over 2 7497 7498 7499The I<Banner> element provides a customized descriptive header to the menu. 7500I<$Banner> is an optional element - giving instructions, descriptions, etc. 7501The default is "Please Pick an Item:" 7502 7503 Banner => "The following items are for selection,\n". 7504 "\tEnjoy the Experience!", 7505 7506--or-- 7507 7508 Banner => sub { <generate dynamic banner content here> }, 7509 7510--or-- 7511 7512 my $create_banner = sub { <generate dynamic banner content here> }, 7513 7514 Banner => $create_banner, 7515 7516Creating a reference to a Banner subroutine enables the sharing of 7517Banner generation code between multiple Menus. 7518 7519 7520B<NOTE:> Macros (like C<]Previous[> ) I<can> be used in Banners! :-) ( See Item Configuration Macros below ) 7521 7522=back 7523 7524=back 7525 7526=head3 Item Configuration Hash Structures 7527 7528Each Menu Item can have an independant configurtion. Each Menu Configuration 7529Hash Structure consists of elements that define and control it's behavior, 7530appearance, constitution and purpose. An element's syntax is as you would 7531expect it to be in perl - a key string pointing to an assocaited value: key 7532=> value. The following items list supported key names and ther associated 7533value types: 7534 7535=over 4 7536 7537=item 7538 7539B<Text> => 'Char String consisting of ASCII Characters' 7540 7541=over 2 7542 7543 7544The I<Text> element provides a customized descriptive string for the Item. 7545It is the text the user will see displayed, describing the selection. 7546 7547 Text => 'This is Item_1', 7548 7549=back 7550 7551=item 7552 7553B<Convey> => [ List ] --or-- @List --or-- $Scalar --or-- 'ASCII String' --or-- Anonymous Subroutine --or-- Subroutine Reference --or-- Ordinary Subroutine (*Ordinary* subroutine calls need to be surrounded by quotes. DO NOT use quotes with anonymous subroutine calls or ones called with a reference!) 7554 7555=over 2 7556 7557 7558The I<Convey> element has a twofold purpose; it provides for the contents 7559of the C<]Convey[> macro, and defines or contains the string or result that 7560is passed on to child menus - if any. Use of this configuration element is 7561I<optional>. If C<Convey> is not a list, then it's value is passed onto child 7562menus. If C<Convey> I<is> a list, then the Item selected is passed onto the 7563children - if any. It is important to note, I<when used>, that only the 7564resulting I<Convey> string - B<I<NOT>> the the Item C<Text> value or string, 7565is conveyed to child menus. When the C<Convey> element is not used, the 7566full Item C<Text> value B<is> conveyed to the children - if any. However, the 7567full contents of the C<Text> element is I<returned> as the I<Result> of the 7568operation when the user completes all menu activity. See the I<Macro> section 7569below for more information. 7570 7571 Convey => [ `ls -1` ], 7572 7573B<NOTE:> When using anonymous subroutines or subroutine references, there may be situations where code populating the Convey item encounters an error or gets data that is empty or unsatisfactory for some reason, and there is a need to print a message or write to a log or send an alert, and then return from this routine to an earlier menu. To force a return to a parent menu (assuming there is one) from a subroutine assigned to a Convey element, just return '<' from the subroutine. To return to any ancestor Menu in the stack, return this macro from the subroutine: C<{Menu_Name}<> :-) 7574 7575=back 7576 7577=item 7578 7579B<Default> => 'Char String' --or-- Perl regular expression - qr/.../ 7580 7581=over 2 7582 7583 7584The I<Default> element provides a means to pre-select certain elements, 7585as if the items were selected by the user. This can be done with two 7586constructs - simple string or pre-compiled regular expression. 7587Note: The C<Default> element is available only when the C<Select> element 7588is set to C<'Many'> - C<Select => 'Many',> 7589 7590 Default => 'base|chown', 7591 7592 Default => qr/base|chown/i, 7593 7594The user sees ==> 7595 7596 Choose a /bin Utility : 7597 7598 1 /bin Utility - arch 7599 2 /bin Utility - ash 7600 3 /bin Utility - awk 7601 * 4 /bin Utility - basename 7602 5 /bin Utility - bash 7603 6 /bin Utility - cat 7604 7 /bin Utility - chgrp 7605 8 /bin Utility - chmod 7606 * 9 /bin Utility - chown 7607 10 /bin Utility - cp 7608 7609 a. Select All c. Clear All f. FINISH 7610 ___ 7611 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 7612 7613 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7614 7615=back 7616 7617=item 7618 7619B<Select> => 'One' --or-- 'Many' 7620 7621=over 2 7622 7623 7624The ITEM LEVEL I<Select> element provides a means to inform Term::Menus 7625that the specific items of a single ITEM BLOCK (as opposed to full menu) 7626are subject to multiple selecting - or just single selection. This is 7627useful in particular for Directory Tree navigation - where files can 7628be multi-selected (or tagged), yet when a directory is selectedi, it 7629forces an immediate navigation and new menu - showing the contents of 7630the just selected directory. 7631 7632B<NOTE:> See the B<RECURSIVELY CALLED MENUS> section for more information. 7633 7634 Select => 'More', 7635 7636The user sees ==> 7637 7638 d 1 bin 7639 d 2 blib 7640 d 3 dist 7641 d 4 inc 7642 d 5 lib 7643 d 6 Module 7644 d 7 t 7645 8 briangreat2.txt 7646 * 9 ChangeLog 7647 10 close.perl 7648 7649 a. Select All f. FINISH 7650 ___ 7651 49 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 7652 7653 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7654 7655=back 7656 7657=item 7658 7659B<Exclude> => 'Char String' --or-- Perl regular expression - qr/.../ 7660 7661=over 2 7662 7663 7664The I<Exclude> element provides a means to remove matching elements 7665from the Menu seen by the user. This element is useful only when the 7666C<]Convey[> macro is used to populate items. This can be done with two 7667constructs - simple string or pre-compiled regular expression. 7668 7669 Exclude => 'base|chown', 7670 7671 Exclude => qr/base|chown/i, 7672 7673=back 7674 7675=item 7676 7677B<Include> => 'Char String' --or-- Perl regular expression - qr/.../ 7678 7679=over 2 7680 7681 7682The I<Include> element provides a means to create items filtered from a larger 7683list of potential items available via the C<]Convey[> macro. This element is 7684useful only when the C<]Convey[> macro is used to populate items. The 7685C<Exclude> element can be used in conjunction with C<Include> to further 7686refine the final list of items used to construct the menu. The C<Include> 7687element - when used - always takes presidence, and the C<Exclude> will be used 7688only on the C<Include> filtered results. This element can be used with 7689two value constructs - simple string or pre-compiled regular expression. 7690 7691 Include => 'base|chown', 7692 7693 Include => qr/base|chown/i, 7694 7695=back 7696 7697=item 7698 7699B<Result> => \%Menu_2 --or -- "&any_method()", 7700 7701=over 2 7702 7703=item 7704 7705I<Result> is an I<optional> element that also has two important uses: 7706 7707=item 7708 7709For selecting the child menu next in the chain of operation and conveyance, 7710 7711 Result => \%Menu_2, 7712 7713--or-- 7714 7715=item 7716 7717For building customized method arguements using C<&Menu()>'s built-in 7718macros. 7719 7720=item 7721 7722 Result => "&any_method($arg1,\"]Selected[\",\"]Previous[\")", 7723 7724B<NOTE:> I<ALWAYS> be sure to surround the subroutine or method calling 7725syntax with DOUBLE QUOTES. (You can use single quotes if you don't want 7726interpolation). Quotes are necessary because you're telling C<&Menu()> - 7727I<not> Perl - what method you want invoked. C<&Menu()> won't invoke the method 7728until after all other processing - where Perl will try to invoke it the first 7729time it encounters the line during runtime - lo----ng before a user gets a 7730chance to see or do I<anything>. B<BUT> - be sure I<B<NOT>> to use quotes 7731when assigning a child menu reference to the C<Result> value. 7732 7733Again, I<Result> is an I<optional> element. The default behavior when 7734C<Result> is omitted from the Item Configuration element, is for the selection 7735to be returned to the C<&Menu()>'s calling script/module/app. If the C<Select> 7736element was set to C<'One'>, then that item is returned regardless of whether 7737the Perl structure receiving the output is an array or scalar. If there were 7738multiple selections - i.e., C<Select> is set to C<'Many'> - then, depending 7739on what structure is set for receiving the output, will determine whether 7740C<&Menu()> returns a list (i.e. - array), or I<reference> to an array. 7741 7742=back 7743 7744=item 7745 7746B<Input> => 1 --or -- 0, 7747 7748=over 2 7749 7750=item 7751 7752I<Input> is an I<optional> element that that is used with Term::Menus L<FORMS|/FORMS>: 7753 7754=item 7755 7756For indicating to Term::Menus that the configuration hash is for a FORMS page. 7757 7758 Input => 1, 7759 7760=back 7761 7762=back 7763 7764=head3 Item Configuration Macros 7765 7766Each Menu Item can utilize a very powerful set of configuration I<Macros>. 7767These constructs principally act as purveyors of information - from one 7768menu to another, from one element to another. There are currently three 7769available Macros: 7770 7771=over 4 7772 7773=item 7774 7775B<]Convey[> 7776 7777 7778=over 2 7779 7780 7781C<]Convey[> is used in conjunction with the I<Convey> element (described) 7782earlier. It's purpose to "convey" or transport or carry a list item associated 7783with the C<Convey> element - and replace the C<]Convey[> Macro in the C<Text> 7784element value with that list item. The I<Convey> mechanism utilizing the 7785C<Convey> Macro is essentially an I<Item multiplier>. The entire contents of 7786the list associated with the I<Convey> element will be turned into it's own 7787C<Item> when the menu is displayed. Both ordinary and anonymous subroutines can be use to dynamically generate I<Convey> lists. (With I<]Convey[>, macros can be used only as subroutine arguments or in the body of anonymous subroutines - see other examples.) 7788 7789 use Term::Menus; 7790 7791 my %Menu_1=( 7792 7793 Name => 'Menu_1', 7794 Item_1 => { 7795 7796 Text => "/bin/Utility - ]Convey[", 7797 Convey => [ `ls -1 /bin` ], 7798 Result => \%Menu_2, 7799 7800 }, 7801 7802 Select => 'One', 7803 Banner => "\n Choose a /bin Utility :" 7804 ); 7805 7806 my @selections=&Menu(\%Menu_1); 7807 print "SELECTIONS=@selections\n"; 7808 7809The user sees ==> 7810 7811 Choose a /bin Utility : 7812 7813 1 /bin Utility - arch 7814 2 /bin Utility - ash 7815 3 /bin Utility - awk 7816 4 /bin Utility - basename 7817 5 /bin Utility - bash 7818 6 /bin Utility - cat 7819 7 /bin Utility - chgrp 7820 8 /bin Utility - chmod 7821 9 /bin Utility - chown 7822 10 /bin Utility - cp 7823 7824 a. Select All c. Clear All f. FINISH 7825 ___ 7826 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 7827 7828 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7829 7830B<NOTE:> C<]C[> can be used as a shorthand for C<]Convey[>. 7831 7832=back 7833 7834=item 7835 7836B<]Previous[> 7837 7838 7839=over 2 7840 7841 7842C<]Previous[> can be used in child menus. The C<]Previous[> Macro contains 7843the I<Selection> of the parent menu. Unlike the C<]Convey[> Macro, the 7844C<]Previous[> Macro can be used in both the C<Text> element value, and the 7845C<Result> element values (when constructing method calls): 7846 7847The C<]Previous[> Macro can also be used in the Banner. 7848 7849 use Term::Menus; 7850 7851 my %Menu_2=( 7852 7853 Name => 'Menu_2', 7854 Item_1 => { 7855 7856 Text => "]Previous[ is a ]Convey[ Utility", 7857 Convey => [ 'Good','Bad' ] 7858 }, 7859 7860 Select => 'One', 7861 Banner => "\n Choose an Answer :" 7862 ); 7863 7864 my %Menu_1=( 7865 7866 Name => 'Menu_1', 7867 Item_1 => { 7868 7869 Text => "/bin/Utility - ]Convey[", 7870 Convey => [ `ls -1 /bin` ], 7871 Result => \%Menu_2, 7872 7873 }, 7874 7875 Select => 'One', 7876 Banner => "\n Choose a /bin Utility :" 7877 ); 7878 7879 my @selections=&Menu(\%Menu_1); 7880 print "SELECTIONS=@selections\n"; 7881 7882The user sees ==> 7883 7884 Choose a /bin Utility : 7885 7886 1 /bin Utility - arch 7887 2 /bin Utility - ash 7888 3 /bin Utility - awk 7889 4 /bin Utility - basename 7890 5 /bin Utility - bash 7891 6 /bin Utility - cat 7892 7 /bin Utility - chgrp 7893 8 /bin Utility - chmod 7894 9 /bin Utility - chown 7895 10 /bin Utility - cp 7896 7897 a. Select All c. Clear All f. FINISH 7898 7899 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 7900 7901 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7902 7903--< 5 >-<ENTER>---------------------------------- 7904 7905 Choose an Answer : 7906 7907 1 bash is a Good Utility 7908 2 bash is a Bad Utility 7909 7910 (Press [F1] for HELP) 7911 7912 ([ESC] to Quit) PLEASE ENTER A CHOICE: 7913 7914--< 1 >-<ENTER>---------------------------------- 7915 7916The user sees ==> 7917 7918 SELECTIONS = bash is a Good Utility 7919 7920B<NOTE:> C<]P[> can be used as a shorthand for C<]Previous[>. 7921 7922=back 7923 7924=item 7925 7926B<]Previous[{> <I<Menu_Name>> B<}> i.e. Explicit Named Macro 7927 7928 7929=over 2 7930 7931 7932C<]Previous[{Menu_Name}> (i.e. Explicit Named Macros) can be used in child menus. 7933The C<]Previous[{Menu_Name}> Macro contains the I<Selection> of any preceding menu 7934specified with the C<Menu_Name> string. The C<]Previous[{Menu_Name}> follows the 7935same conventions as the C<]Previous[> Macro - but enables access to the selection 7936of i<any> preceding menu. This is very useful for Menu trees more than two levels 7937deep. 7938 7939The C<]Previous[{Menu_Name}> Macro can also be used in the Banner. 7940 7941 use Term::Menus; 7942 7943 my %Menu_3=( 7944 7945 Name => 'Menu_3', 7946 Item_1 => { 7947 7948 Text => "]Convey[ said ]P[{Menu_1} is a ]Previous[ Utility!", 7949 Convey => [ 'Bob','Mary' ] 7950 }, 7951 7952 Select => 'One', 7953 Banner => "\n Who commented on ]Previous[{Menu_1}? :" 7954 ); 7955 7956 my %Menu_2=( 7957 7958 Name => 'Menu_2', 7959 Item_1 => { 7960 7961 Text => "]Previous[ is a ]C[ Utility", 7962 Convey => [ 'Good','Bad' ], 7963 Result => \%Menu_3, 7964 }, 7965 7966 Select => 'One', 7967 Banner => "\n Is ]P[ Good or Bad? :" 7968 ); 7969 7970 my %Menu_1=( 7971 7972 Name => 'Menu_1', 7973 Item_1 => { 7974 7975 Text => "/bin/Utility - ]Convey[", 7976 Convey => [ `ls -1 /bin` ], 7977 Result => \%Menu_2, 7978 7979 }, 7980 7981 Select => 'One', 7982 Banner => "\n Choose a /bin Utility :" 7983 ); 7984 7985 my @selections=&Menu(\%Menu_1); 7986 print "SELECTIONS=@selections\n"; 7987 7988The user sees ==> 7989 7990 Choose a /bin Utility : 7991 7992 1 /bin Utility - arch 7993 2 /bin Utility - ash 7994 3 /bin Utility - awk 7995 4 /bin Utility - basename 7996 5 /bin Utility - bash 7997 6 /bin Utility - cat 7998 7 /bin Utility - chgrp 7999 8 /bin Utility - chmod 8000 9 /bin Utility - chown 8001 10 /bin Utility - cp 8002 8003 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8004 8005--< 5 >-<ENTER>---------------------------------- 8006 8007 Is bash Good or Bad? : 8008 8009 1 bash is a Good Utility 8010 2 bash is a Bad Utility 8011 8012 (Press [F1] for HELP) 8013 8014 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8015 8016--< 1 >-<ENTER>---------------------------------- 8017 8018 Who commented on bash? : 8019 8020 1 Bob said bash is a Good Utility! 8021 2 Mary said bash is a Good Utility! 8022 8023 (Press [F1] for HELP) 8024 8025 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8026 8027--< 2 >-<ENTER>---------------------------------- 8028 8029 8030The user sees ==> 8031 8032 SELECTIONS = Mary said bash is a Good Utility! 8033 8034B<NOTE:> C<]P[> can be used as a shorthand for C<]Previous[>. 8035 8036C<]P[{Menu_Name}> can be used as a shorthand for C<]Previous[{Menu_Name}>. 8037 8038C<]C[> can be used as a shorthand for C<]Convey[>. 8039 8040 8041=back 8042 8043=item 8044 8045B<]Selected[> 8046 8047 8048=over 2 8049 8050C<]Selected[> can only be used in a I<terminal> menu. B<(> I<A terminal menu is 8051the last menu in the chain, or the last menu the user sees. It is the menu that 8052defines the> C<Result> I<element with a method> C<Result =E<gt> &any_method()>, 8053I<or does not have a> C<Result> I<element included or defined.> B<)> 8054C<]Selected[> is used to pass the selection of the I<current> menu to the 8055C<Result> element method of the current menu: 8056 8057 use Term::Menus; 8058 8059 sub selected { print "\n SELECTED ITEM = $_[0]\n" } 8060 8061 my %Menu_1=( 8062 8063 Name => 'Menu_1', 8064 Item_1 => { 8065 8066 Text => "/bin/Utility - ]Convey[", 8067 Convey => [ `ls -1 /bin` ], 8068 Result => "&selected(]Selected[)", # ]Selected[ macro passed to 8069 # ordinary perl subroutine. 8070 # The '&' characater is optional 8071 # but the quotes are NOT. Ordinary 8072 # subroutine calls MUST be 8073 # surrounded by either double or 8074 # single quotes. (DO NOT use 8075 # quotes around anonymous 8076 # subroutine calls, however!) 8077 8078 }, 8079 8080 Select => 'One', 8081 Banner => "\n Choose a /bin Utility :" 8082 ); 8083 8084 my $selection=&Menu(\%Menu_1); 8085 print "\n SELECTION=$selection\n"; 8086 8087B<NOTE:> C<]S[> can be used as a shorthand for C<]Selected[>. 8088 8089B<NOTE:> It is possible to use the same Result subroutine in 8090 different B<Item_E<lt>intE<gt>> blocks, and even in 8091 other Menu blocks within the same script. Furthermore, 8092 when complex Menu structures are created using lots 8093 of anonymous subroutines with generous subroutine 8094 reuse, it can be difficult to prevent early substitution 8095 of this Macro by a parent Menu. To prevent this, use 8096 the Explicit Named Macro construct with this Macro as 8097 well - C<]Selected[{Menu_Name}> 8098 8099 Also, if the same Result subroutine is to be used by 8100 multiple nested menus, all the Menu_Names of those Menu 8101 blocks should be included in the Named section 8102 separated by the vertical bar symbol - C<]S[{Menu1_Name|Menu2_Name}> 8103 8104B<NOTE:> B<Stepchild and Grandchild Menus> - While on the topic 8105 of multiple nested menus, one of the more challenging 8106 aspects is preventing child menus from having their 8107 macros expanded or populated too "early" during runtime. 8108 Using the "Explict Name" convention (C<]Selected[{Menu_Name}>) 8109 helps, but there is another issue to be aware of. It is 8110 extremely useful (and powerful!) to use previous menu 8111 selections to dynamically build and return child menus 8112 for some results, but not for others. Code to reflect 8113 this goal would ordinarly look like this: 8114 8115 $result_code = sub { 8116 8117 my $selection=']S[{current_menu_name}'; 8118 if ($selection eq 'Return to Main Menu') { 8119 8120 return '{main}<'; 8121 8122 } else { 8123 8124 my %next_menu=( 8125 8126 Name => 'next_menu', 8127 Item_1 => { 8128 8129 Text => ']C[', 8130 Convey => [ ... ], 8131 8132 }, 8133 Item_2 => { ... }, 8134 8135 ); 8136 8137 } 8138 8139 }; 8140 8141 But this may not work correctly. The reason is that 8142 Term::Menus identifies menus in result blocks by 8143 explicitly looking for the 'Item_' (Item underscore) 8144 string in the block. If it finds one it will treat 8145 the result as a child menu to be I<immediately> 8146 created - not a routine to be evaluated first! So, 8147 in this scenario, the routine is acting as a kind 8148 of surrogate or "step" parent, since it is not a 8149 "real" parent menu. Hence, the "stepchild" menu. In 8150 this situation it may be necessary to "trick" 8151 Term::Menus into not recognizing the embedded menu 8152 (yet) that is part of a conditional structure that 8153 will be returned, only if the conditional is true. 8154 To do that, you can code this scenario like this: 8155 8156 $result_code = sub { 8157 8158 my $selection=']S[{current_menu_name}'; 8159 if ($selection eq 'Return to Main Menu') { 8160 8161 return '{main}<'; 8162 8163 } else { 8164 8165 my %next_menu=( # This is a "stepchild" menu 8166 8167 Name => 'next_menu', 8168 8169 ); 8170 my $key = 'Item'.'_1'; 8171 $next_menu{$key}={ 8172 8173 Text => ']C[', 8174 Convey => [ ... ], 8175 8176 }; 8177 $key = 'Item'.'_2'; 8178 $next_menu{$key}={ 8179 8180 Text => '. . .', 8181 8182 }; 8183 return \%next_menu; 8184 8185 } 8186 8187 }; 8188 8189 While that works, it is not very elegant (and not 8190 Best Practice!). It is better in these situations 8191 to substitute the Select (C<]Select[>) or Previous 8192 (C<]Previous[>) Macros with a TEST Macro (C<]Test[> 8193 or C<]T[> is shorthand): 8194 8195 $result_code = sub { 8196 8197 my $selection=']T[{current_menu_name}'; # <-- Note the ]T[ 8198 if ($selection eq 'Return to Main Menu') { 8199 8200 return '{main}<'; 8201 8202 } else { 8203 8204 my %next_menu=( # "stepchild" menu 8205 8206 Name => 'next_menu', 8207 Item_1 => { 8208 8209 Text => ']C[', 8210 Convey => [ ... ], 8211 8212 }, 8213 Item_2 => { ... }, 8214 8215 ); 8216 8217 } 8218 8219 }; 8220 8221 The presence of the C<]Test[> macro tells 8222 Term::Menus that it's dealing with stepchild menus, 8223 and not to evaluate them early. 8224 8225 However, there are scenario's where you want to 8226 evaluate on a condition that does not involve a 8227 child or even a step child menu - but a grandchild 8228 or great grandchild menu, etc. (This can certainly 8229 happen when there is menu re-use or recursion). In 8230 these situations Term::Menus will invariably 8231 determine there is an error condition (due to the 8232 explicitly named menu missing in the history stack) 8233 when there isn't - because there is no "obvious" 8234 way for Term::Menus to know that an explicitly named 8235 menu is not yet "supposed" to exist. In these 8236 scenarios the only option will be to suppress the 8237 error message and allow macro expansion to otherwise 8238 continue unabated. To do that, and allow processing 8239 to continue, use a "bang" (or exclamation point) 8240 character in the macro syntax after the starting 8241 bracket: 8242 8243 C<my $selection=']!S[{menu_name}';> 8244 8245 --OR-- 8246 8247 C<my $selection=']!T[{menu_name}';> 8248 8249 Hopefully, one or more of these approaches or 8250 "tricks" will deliver the results you're after. 8251 Whatever works! 8252 8253B<NOTE:> if you want to return output from the Result subroutine, 8254 you must include a 'return' statement. So the sub above: 8255 8256 sub selected { print "\n SELECTED ITEM = $_[0]\n" } 8257 8258 Becomes: 8259 8260 sub selected { print "\n SELECTED ITEM = $_[0]\n";return $_[0] } 8261 8262=back 8263 8264=back 8265 8266=head1 ANONYMOUS SUBROUTINES AND MACROS 8267 8268Term::Menus macros can be used I<directly> in the body of B<anonymous> subroutines! Ordinary subroutines can be used as illustrated above of course, but the macro values can only be passed as arguments to ordinary subroutines. This is much more complicated and less intuitive than using macros directly in the code itself. Below is an example of their usage. The author received a request a while back from a user, asking if it was possible to return the item number rather than it's text value. The answer of course is YES! The code below illustrates this: 8269 8270=over 4 8271 8272 use Term::Menus; 8273 8274 my @list=('One','Two','Three'); 8275 8276 my %Menu_1=( 8277 8278 Item_1 => { 8279 8280 Text => "NUMBER - ]Convey[", 8281 Convey => \@list, 8282 Result => sub { 8283 my $cnt=-1;my $selection=']Selected['; 8284 foreach my $item (@list) { 8285 $cnt++; 8286 chomp($item); 8287 last if -1<index $selection, $item; 8288 } return "$cnt"; 8289 } 8290 # Note use of ]Selected[ macro in 8291 # anonymous subroutine body 8292 8293 }, 8294 8295 Select => 'One', 8296 Banner => "\n Choose a /bin Utility :" 8297 ); 8298 8299 my $selection=Menu(\%Menu_1); 8300 print " \nSELECTION = $selection\n"; 8301 8302=back 8303 8304Anonymous subroutines can be assigned directly to "Item_1" (or Item_2, etc.) elements 'Convey' and 'Result' as well as to the Menu "Banner" element. Use of the these constructs over more traditional subroutines is encouraged because it means writing less code, while enabling the code that is written to be less complex, more intuitive and readable, and certainly easier to maintain. The same anonymous routine can be use in multipe Menus or Items of a single Menu by assigning that routine to a variable, and then assigning the variable instead. 8305 8306B<NOTE:> To force a return to a parent menu (assuming there is one) from a subroutine assigned to a Result element, just return '<' from the subroutine. This is extremely useful when there is a desire to process a selection, and then return to the parent menu when processing is complete. To return to any ancestor Menu in the stack, return this macro from the subroutine: C<{Menu_Name}<> :-) 8307 8308=over 4 8309 8310 use Term::Menus; 8311 8312 my @list=('One','Two','Three'); 8313 8314 my $result = sub { 8315 my $cnt=-1;my $selection=']Selected['; 8316 foreach my $item (@list) { 8317 $cnt++; 8318 chomp($item); 8319 last if -1<index $selection, $item; 8320 } return "$cnt"; 8321 }; 8322 # Anonymous subroutine assigned to "$result" variable 8323 8324 my %Menu_1=( 8325 8326 Item_1 => { 8327 8328 Text => "NUMBER - ]Convey[", 8329 Convey => \@list, 8330 Result => $result, # Anonymous subroutine assisned via 8331 # "$result" variable 8332 8333 }, 8334 8335 Select => 'One', 8336 Banner => "\n Choose a /bin Utility :" 8337 ); 8338 8339 my $selection=Menu(\%Menu_1); 8340 print " \nSELECTION = $selection\n"; 8341 8342=back 8343 8344=head1 RECURSIVELY CALLED MENUS 8345 8346There are occasions where it is desirable to re-use the same Menu template/hash configuration with dynamically discovered data. One obvious example of this is navigating directory trees. Each subsequent directory selection could potentially contain deeper levels of directories. Essentially, any data structured in any kind of relational tree layout is subject to this kind of navigation approach. Be warned however, unlike most other functionality that is handled almost entirely by the Term::Menus module, the code for doing recursive templating is mostly contained in the template/hash configuration itself. There is a "helper routine" (&get_Menu_map) that Term::Menus provides to assist with the creation of recursively-friendly configurations, but given the highly data-centric characteristics of such functionality, most of the working code must be left to the authoring and management of the user. 8347 8348 8349=head2 &get_Menu_map() 8350 8351This is a helper routine that returns a list of ancestor menu results. This is needed when wanting to navigate a directory tree for instance. Imagine a directory path that looks like this: /one/two/three. A call to &get_Menu_map() when processing directory three with return this list: ('one','two'). 8352 8353=over 4 8354 8355The following code is an example of how to use recursion for navigating a directory tree. 8356 8357 use Term::Menus; 8358 8359 my %dir_menu=( 8360 8361 Name => 'dir_menu', 8362 Item_1 => { 8363 8364 Text => "]C[", 8365 Mark => "d", 8366 Convey => sub { 8367 8368 if ("]P[") { 8369 8370 my $dir="]P["; 8371 if ($^O eq 'cygwin') { 8372 $dir='/cygdrive/c/'; 8373 } else { 8374 $dir='/'; 8375 } 8376 my @xfiles=(); 8377 my @return=(); 8378 my @map=get_Menu_map; 8379 my $path=join "/", @map; 8380 opendir(DIR,"$dir$path") || die $!; 8381 @xfiles = readdir(DIR); 8382 closedir(DIR); 8383 foreach my $entry (sort @xfiles) { 8384 next if $entry eq '.'; 8385 next if $entry eq '..'; 8386 if (-1<$#map) { 8387 next unless -d "$dir$path/$entry"; 8388 } else { 8389 next unless -d "$dir/$entry"; 8390 } 8391 push @return, "$entry"; 8392 } 8393 return @return; 8394 8395 } 8396 my @xfiles=(); 8397 my @return=(); 8398 if ($^O eq 'cygwin') { 8399 opendir(DIR,'/cygdrive/c/') || die $!; 8400 } else { 8401 opendir(DIR,'/') || die $!; 8402 } 8403 @xfiles = readdir(DIR); 8404 closedir(DIR); 8405 foreach my $entry (@xfiles) { 8406 next if $entry eq '.'; 8407 next if $entry eq '..'; 8408 next unless -d "$entry"; 8409 push @return, "$entry"; 8410 } 8411 return @return; 8412 8413 }, 8414 Result => { 'dir_menu'=>'recurse' }, 8415 8416 }, 8417 Item_2 => { 8418 8419 Text => "]C[", 8420 Select => 'Many', 8421 Convey => sub { 8422 8423 if ("]P[") { 8424 8425 my $dir="]P["; 8426 if ($^O eq 'cygwin') { 8427 $dir='/cygdrive/c/'; 8428 } else { 8429 $dir='/'; 8430 } 8431 8432 my @xfiles=(); 8433 my @return=(); 8434 my @map=get_Menu_map; 8435 my $path=join "/", @map; 8436 opendir(DIR,"$dir/$path") || die $!; 8437 @xfiles = readdir(DIR); 8438 closedir(DIR); 8439 foreach my $entry (sort @xfiles) { 8440 next if $entry eq '.'; 8441 next if $entry eq '..'; 8442 if (-1<$#map) { 8443 next if -d "$dir/$path/$entry"; 8444 } else { 8445 next if -d "$dir/$entry"; 8446 } 8447 push @return, "$entry"; 8448 } 8449 return @return; 8450 8451 } 8452 my @xfiles=(); 8453 my @return=(); 8454 if ($^O eq 'cygwin') { 8455 opendir(DIR,'/cygdrive/c/') || die $!; 8456 } else { 8457 opendir(DIR,'/') || die $!; 8458 } 8459 @xfiles = readdir(DIR); 8460 closedir(DIR); 8461 foreach my $entry (@xfiles) { 8462 next if $entry eq '.'; 8463 next if $entry eq '..'; 8464 next if -d "$entry"; 8465 push @return, "$entry"; 8466 } 8467 return @return; 8468 8469 }, 8470 }, 8471 Banner => " Current Directory: ]P[\n", 8472 8473 ); 8474 8475 my $selection=Menu(\%dir_menu); 8476 8477 if (ref $selection eq 'ARRAY') { 8478 print "\nSELECTION=",(join " ",@{$selection}),"\n"; 8479 } else { 8480 print "\nSELECTION=$selection\n"; 8481 } 8482 8483=back 8484 8485=head1 FORMS 8486 8487With Term::Menus, you can now create CMD and Terminal environment input forms. 8488Below is an example of a form that works with the program "figlet": 8489 8490 8491 '########:'##::::'##::::'###::::'##::::'##:'########::'##:::::::'########: 8492 ##.....::. ##::'##::::'## ##::: ###::'###: ##.... ##: ##::::::: ##.....:: 8493 ##::::::::. ##'##::::'##:. ##:: ####'####: ##:::: ##: ##::::::: ##::::::: 8494 ######:::::. ###::::'##:::. ##: ## ### ##: ########:: ##::::::: ######::: 8495 ##...:::::: ## ##::: #########: ##. #: ##: ##.....::: ##::::::: ##...:::: 8496 ##:::::::: ##:. ##:: ##.... ##: ##:.:: ##: ##:::::::: ##::::::: ##::::::: 8497 ########: ##:::. ##: ##:::: ##: ##:::: ##: ##:::::::: ########: ########: 8498 ........::..:::::..::..:::::..::..:::::..::..:::::::::........::........:: 8499 8500 ======================================== 8501 [ EXAMPLE ] banner3-D font 8502 ======================================== 8503 8504 The box above is an input box. The [DEL] key will clear the contents. 8505 Type anything you like, and it will appear in the banner3-D FIGlet font! 8506 8507 (Press [F1] for HELP) 8508 8509 ([ESC] to Quit) Press ENTER when finished 8510 8511 8512In this example, input typed in the input field, immediately appears in the 8513output field in the figlet font "banner3-D". Here is the code for this example: 8514 8515 use Term::Menus; 8516 my $path='/usr/share/figlet'; 8517 opendir(my $dh, $path) || die "can't opendir $path: $!"; 8518 while (my $file=readdir($dh)) { 8519 chomp($file); 8520 next unless $file=~s/.flf$//; 8521 push @figletfonts,$file; 8522 } 8523 my $figlet='/usr/bin/'; 8524 my $figban=`${figlet}figlet -f small "FIGlet Fonts"`; 8525 $figban=~s/^/ /mg; 8526 $figban="\n\n$figban ". 8527 "Choose a FIGlet Font (by number) to preview with text \"Example\"". 8528 "\n -OR- continuously scroll and view by repeatedly pressing ENTER". 8529 "\n\n HINT: Typing !figlet -f<fontname> YOUR TEXT\n\n". 8530 " is another way to preview the font of your choice.\n\n"; 8531 8532 $main::figletoutput=sub { 8533 8534 return `figlet -f ]P[{figmenu} $_[0]`; 8535 8536 }; 8537 8538 my $figlet_banner=<<END; 8539 8540 ]O[{1,'figletoutput'} 8541 8542 8543 ]P[{figmenu} font 8544 ]I[{1,'Example',40} 8545 8546 The box above is an input box. The [DEL] key will clear the contents. 8547 Type anything you like, and it will appear in the ]P[{figmenu} FIGlet font! 8548 8549 END 8550 # ^ Be sure the END is at the margin (no spaces from edge) 8551 8552 my %figletoutput=( 8553 8554 Name => 'figletoutput', 8555 Result => sub { return '{figmenu}<' }, 8556 Input => 1, 8557 Banner => $figlet_banner, 8558 8559 ); 8560 8561 my %figmenu=( 8562 8563 Name => 'figmenu', 8564 Item_1 => { 8565 8566 Text => ']C[', 8567 Convey => \@figletfonts, 8568 Result => \%figletoutput, 8569 8570 }, 8571 Display => 8, 8572 Scroll => 1, 8573 Banner => $figban, 8574 8575 ); 8576 my $selection=Menu(\%figmenu); 8577 8578 8579Any number of input fields can be added to a form page, and navigation among 8580 fields is accomplished using the TAB key (as you would use in most GUI applications). 8581 8582 8583 Term::Menus FORM - 3 input fields: 8584 8585 ======================================== 8586 Name [ ] 8587 ======================================== 8588 ---------------------------------------- 8589 Street Address | | 8590 ---------------------------------------- 8591 --------------------------------- ------ 8592 City, State | | | | 8593 --------------------------------- ------ 8594 ---------------- ----------------------- 8595 Zip Code, Phone | | | | 8596 ---------------- ----------------------- 8597 8598 (Press [F1] for HELP) 8599 8600 ([ESC] to Quit) Press ENTER when finished 8601 8602 8603Note how the first field has a thicker border than the other two. This means this 8604field is "highlighted" and is the one chosen for entry. The following keys have 8605special behavior: 8606 8607 [DEL] ==> Clears the selected input field entirely 8608 8609 [BACKSPACE] ==> Deletes one character at time going backwards 8610 8611 [TAB] ==> Navigates among input fields 8612 8613 [ENTER] ==> Submits entire form 8614 8615=head2 Form Assembly 8616 8617Form syntax is used in the C<Banner> that is fed to C<&Menu()> via the Menu 8618Configuration Hash Structure. This is the code for the input fields above: 8619 8620 use Term::Menus; 8621 8622 my $input_fields_banner.=<<END; 8623 8624 my @default_input=('','','','','',''); 8625 8626 Term::Menus FORM - 6 input fields: 8627 8628 8629 Name 8630 ]I[{1,$default_input[0],40} 8631 8632 Street Address 8633 ]I[{2,$default_input[1],40} 8634 8635 City, State 8636 ]I[{3,$default_input[2],33} ]I[{4,$default_input[3],6} 8637 8638 Zip Code, Phone 8639 ]I[{5,$default_input[4],16} ]I[{6,$default_input[5],23} 8640 8641END 8642 my $input_example={ 8643 8644 Name => 'input_example', 8645 Input => 1, 8646 Banner => $input_fields_banner, 8647 Result => sub { return "]I[{'input_example',1}", 8648 "]I[{'input_example',2}", 8649 "]I[{'input_example',3}", 8650 "]I[{'input_example',4}", 8651 "]I[{'input_example',5}", 8652 "]I[{'input_example',6}" }, 8653 8654 }; 8655 8656 my @output=Menu($input_example); 8657 print "\n OUTPUT=@output\n"; 8658 8659=head3 Input Macro -> Banner 8660 8661The Input Macro syntax for Banner is as follows: 8662 8663 ]I[{<identity_number>,'<default_input>',<length_of_input_box>} 8664 8665*NOTE* => Be sure you have a RESULT C<]I[> macro for every BANNER C<]I[> macro you use! 8666 8667=head3 Input Macro -> Result 8668 8669The Input Macro syntax for Result is as follows: 8670 8671 ]I[{'<menu_name>','<identity_number>'} 8672 8673=head3 Output Macro -> Banner 8674 8675The Output Macro syntax for Banner is as follows: 8676 8677 ]O[{<identity_number>,'<name_of_method_to_operate_on_character_input>'} 8678 8679=head1 USAGE and NAVIGATION 8680 8681Usage of C<&pick()> and/or C<&Menu()> during the runtime of a script in which 8682one or both are included, is simple and intuitive. Nearly everything the end 8683user needs in terms of instruction is included on-screen. The 8684script-writer/developer/programmer can also include whatever instructions s/he 8685deems necessary and/or helpful in the customizable C<Banner> (as described 8686above). There is however, one important feature about using C<&Menu()> with 8687sub-menus that's important to know about. 8688 8689=head2 Forward ' B<E<gt>> ' and Backward ' B<E<lt>> ' Navigation 8690 8691When working with more than one C<&Menu()> screen, it's valuable to know how 8692to navigate back and forth between the different C<&Menu()> levels/layers. For 8693example, above was illustrated the output for two layers of menus - a parent 8694and a child: 8695 8696=over 4 8697 8698The user sees ==> 8699 8700 Choose a /bin Utility : 8701 8702 1. /bin Utility - arch 8703 2. /bin Utility - ash 8704 3. /bin Utility - awk 8705 4. /bin Utility - basename 8706 5. /bin Utility - bash 8707 6. /bin Utility - cat 8708 7. /bin Utility - chgrp 8709 8. /bin Utility - chmod 8710 9. /bin Utility - chown 8711 10. /bin Utility - cp 8712 8713 a. Select All c. Clear All f. FINISH 8714 ___ 8715 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8716 8717 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8718 8719--< 5 >-<ENTER>---------------------------------- 8720 8721The user sees ==> 8722 8723 Choose an Answer : 8724 8725 1 bash is a Good Utility 8726 2 bash is a Bad Utility 8727 8728 (Press [F1] for HELP) 8729 8730 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8731 8732 8733In the above example, suppose that the user "fat-fingered" his/her 8734choice, and really didn't want to "bash" bash, but wanted to bash 8735awk instead. Is restarting the whole script/application now necessary? 8736Suppose it was a process that had run overnight, and the user is seeing 8737this menu through fogged glasses from the steam rising out of their 8738morning coffee? Having to run the whole job again would not be welcome news 8739for the BOSS. THANKFULLY, navigation makes this situation avoidable. 8740All the user would have to do is type ' B<E<lt>> ' to go backward to the 8741previous menu, and ' B<E<gt>> ' to go forward to the next menu (assuming there 8742is one in each case): 8743 8744 8745The user sees ==> 8746 8747 Choose an Answer : 8748 8749 1 bash is a Good Utility 8750 2 bash is a Bad Utility 8751 8752 (Press [F1] for HELP) 8753 8754 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8755 8756 --< > >-<ENTER>----------------------------- 8757 8758The user sees ==> 8759 8760 Choose a /bin Utility : 8761 8762 1 /bin Utility - arch 8763 2 /bin Utility - ash 8764 3 /bin Utility - awk 8765 4 /bin Utility - basename 8766 - 5 /bin Utility - bash 8767 6 /bin Utility - cat 8768 7 /bin Utility - chgrp 8769 8 /bin Utility - chmod 8770 9 /bin Utility - chown 8771 10 /bin Utility - cp 8772 8773 a. Select All c. Clear All f. FINISH 8774 ___ 8775 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8776 8777 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8778 8779Note in the above example the Dash ' B<-> ' in front of item B<5.> This informs 8780the user that s/he had previously selected this item. To clear the selection, 8781the user would simply choose item B<5> again. This effectively deletes the 8782previous choice and restores the menu for a new selection. If the user was 8783satisfied with the choice, and was simply double checking thier selection, they 8784simply repeat the navigation process by typing ' B<E<gt>> ' - then <ENTER> 8785- 8786and returning to the child menu they left. 8787 8788If the child menu was a I<multiple-selection> menu, and the user had made some 8789selections before navigating back to the parent menu, the user would see a 8790' B<+> ' rather than a ' B<-> '. This informs the user that selections were 8791made in the child menu. 8792 8793 Choose a /bin Utility : 8794 8795 1. /bin Utility - arch 8796 2. /bin Utility - ash 8797 3. /bin Utility - awk 8798 4. /bin Utility - basename 8799 + 5. /bin Utility - bash 8800 6. /bin Utility - cat 8801 7. /bin Utility - chgrp 8802 8. /bin Utility - chmod 8803 9. /bin Utility - chown 8804 10. /bin Utility - cp 8805 8806 a. Select All c. Clear All f. FINISH 8807 ___ 8808 93 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8809 8810 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8811 8812=back 8813 8814=head2 View Sorted Items ' B<%> ' 8815 8816When working with numerous items in a single menu, it may be desirable to see 8817the set of choices organized in either descending or reverse acscii order. 8818Term::Menus provides this feature with the I<Percent> ' B<%> ' key. Simply 8819type ' B<%> ' and the items will be sorted in descending ascii order. Type 8820' B<%> ' again, and you will see the items reverse sorted. Assume that we have 8821the following menus. 8822 8823=over 4 8824 8825The user sees ==> 8826 8827 Choose a /bin Utility : 8828 8829 * 1 [.exe 8830 * 2 2to3 8831 3 2to3-3.2 8832 * 4 411toppm.exe 8833 5 a2p.exe 8834 6 aaflip.exe 8835 7 aclocal 8836 * 8 aclocal-1.10 8837 9 aclocal-1.11 8838 * 10 aclocal-1.12 8839 8840 a. Select All c. Clear All f. FINISH 8841 ___ 8842 1925 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8843 8844 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8845 8846--< % >-<ENTER>---------------------------------- 8847 8848The user sees ==> 8849 8850 Choose a /bin Utility : 8851 8852 * 2. 2to3 8853 3. 2to3-3.2 8854 * 4. 411toppm.exe 8855 759. FvwmCommand.exe 8856 1650. Ted.exe 8857 1782. WPrefs.exe 8858 1785. X 8859 1889. XWin.exe 8860 1808. Xdmx.exe 8861 1815. Xephyr.exe 8862 8863 a. Select All c. Clear All f. FINISH 8864 8865 (Type '<' to return to previous Menu) 8866 ___ 8867 1925 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8868 8869 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8870 8871And if we choose to enter ' B<%> ' I<again> 8872 8873--< % >-<ENTER>---------------------------------- 8874 8875The user sees ==> 8876 8877 Choose a /bin Utility : 8878 8879 1925 znew 8880 1924 zmore 8881 1923 zless 8882 1922 zipsplit.exe 8883 1921 zipnote.exe 8884 1920 zipinfo.exe 8885 1919 zipgrep 8886 1918 zipcloak.exe 8887 1917 zip.exe 8888 1916 zgrep 8889 8890 a. Select All c. Clear All f. FINISH 8891 8892 (Type '<' to return to previous Menu) 8893 ___ 8894 1925 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8895 8896 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8897 8898This submenu of sorted selections works just like any other menu. The user can 8899deselect an item, clear all items, re-choose all items, etc. The choices made 8900here are preserved when the user navigates back to the original (parent) 8901menu. In other words, if Item 1. is deselected in the sorted menu, Item 1. 8902will also be deselected in the parent menu. Navigating back to the 8903parent is necessary - the menu will not generate results from a sort menu. 8904Use either the B<LEFTARROW> ' B<E<lt>> ' key or FINISH key ' B<F> or B<f> ' to 8905return to the parent menu, and then continue your menu activities there. 8906 8907=back 8908 8909=head2 View Summary of Selected Items ' B<*> ' 8910 8911When working with numerous items in a single menu, it is desirable to see the 8912set of choices made before leaving the menu and committing to a non-returnable 8913forward (perhaps even critical) process. Term::Menus provides this feature 8914with the I<Star> ' B<*> ' key. Assume we have the following menu with 93 Total 8915Choices. Assume further that we have selected items 1,3,9 & 11. Note that we 8916cannot see Item 11 on the first screen since this menu is configured to show 8917only 10 Items at a time. 8918 8919=over 4 8920 8921The user sees ==> 8922 8923 Choose a /bin Utility : 8924 8925 * 1 [.exe 8926 2 2to3 8927 * 3 2to3-3.2 8928 4 411toppm.exe 8929 5 a2p.exe 8930 6 aaflip.exe 8931 7 aclocal 8932 8 aclocal-1.10 8933 * 9 aclocal-1.11 8934 10 aclocal-1.12 8935 8936 a. Select All c. Clear All f. FINISH 8937 ___ 8938 1925 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 8939 8940 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8941 8942--< * >-<ENTER>---------------------------------- 8943 8944The user sees ==> 8945 8946 Choose a /bin Utility : 8947 8948 * 1 [.exe 8949 * 3 2to3-3.2 8950 * 9 aclocal-1.11 8951 * 11 aclocal-1.13 8952 8953 a. Select All c. Clear All f. FINISH 8954 8955 (Type '<' to return to previous Menu) 8956 8957 ([F1] for HELP) 8958 8959 ([ESC] to Quit) PLEASE ENTER A CHOICE: 8960 8961This submenu of summary selections works just like any other menu. The user 8962can deselect an item, clear all items, re-choose all items, etc. The choices 8963made here are preserved when the user navigates back to the original (parent) 8964menu. In other words, if Item 1. is deselected in the summary menu, Item 1. 8965will also be deselected in the parent menu. Navigating back to the 8966parent is necessary - the menu will not generate results from a summary menu. 8967Use either the B<LEFTARROW> ' B<E<lt>> ' key or FINISH key ' B<F> or B<f> ' to 8968return to the parent menu, and then continue your menu activities there. 8969 8970=back 8971 8972=head2 Shell Out to Command Environment ' B<!>I<command> ' 8973 8974Borrowed from the editor vi, users can run any command environment command 8975(typically a shell command) without leaving their Term::Menus session or even 8976context. At anytime, a user can type an exclamation point ' B<!> ' followed 8977by the command they wish to run, and that command will be run and the results 8978returned for viewing. 8979 8980=over 4 8981 8982The user sees ==> 8983 8984 Choose a /bin Utility : 8985 8986 * 1 [.exe 8987 2 2to3 8988 * 3 2to3-3.2 8989 4 411toppm.exe 8990 5 a2p.exe 8991 6 aaflip.exe 8992 7 aclocal 8993 8 aclocal-1.10 8994 * 9 aclocal-1.11 8995 10 aclocal-1.12 8996 8997 a. Select All c. Clear All f. FINISH 8998 ___ 8999 1925 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 9000 9001 ([ESC] to Quit) PLEASE ENTER A CHOICE: 9002 9003--< !hostname >-<ENTER>---------------------------------- 9004 9005The user sees ==> 9006 9007 Choose a /bin Utility : 9008 9009 * 1 [.exe 9010 2 2to3 9011 * 3 2to3-3.2 9012 4 411toppm.exe 9013 5 a2p.exe 9014 6 aaflip.exe 9015 7 aclocal 9016 8 aclocal-1.10 9017 * 9 aclocal-1.11 9018 10 aclocal-1.12 9019 9020 a. Select All c. Clear All f. FINISH 9021 ___ 9022 1925 Total Choices |_v_| Scroll with ARROW keys [F1] for HELP 9023 9024 ([ESC] to Quit) PLEASE ENTER A CHOICE: 9025 9026central_server 9027 9028Press ENTER to continue 9029 9030=back 9031 9032=head1 AUTHOR 9033 9034Brian M. Kelly <Brian.Kelly@fullautosoftware.net> 9035 9036=head1 COPYRIGHT 9037 9038Copyright (C) 2000-2016 9039by Brian M. Kelly. 9040 9041This program is free software; you can redistribute it and/or 9042modify it under the terms of the GNU Affero General Public License. 9043(http://www.gnu.org/licenses/agpl.html). 9044