# IBM_PROLOG_BEGIN_TAG # This is an automatically generated prolog. # # # # Licensed Materials - Property of IBM # # (C) COPYRIGHT International Business Machines Corp. 2004,2019 # All Rights Reserved # # US Government Users Restricted Rights - Use, duplication or # disclosure restricted by GSA ADP Schedule Contract with IBM Corp. # # IBM_PROLOG_END_TAG package LPRM_cli_utils; # sccsid = "@(#)65 1.8 src/rsct/rm/LPRM/cli/pm/LPRM_cli_utils.pm.perl, LPRM, rsct_rady, rady2035a 11/12/15 16:38:16" ###################################################################### # # # Package: LPRM_cli_utils.pm # # # # Description: # # This package contains utility/common subroutines for the # # LPRM CLI commands. # # # # Subroutines Available: # # # # error_exit - performs required cleanup and exits with the # # appropriate ConfigRM CLI error exit code. # # # # printCIMsg - print common informational message to STDOUT. # # Requires the program name and message mnemonic as inputs. # # # # printCEMsg - print common error message to STDERR. # # Requires the program name and message mnemonic as inputs. # # # # process_api_error - extracts and prints errors from the output # # of a c-api command (mkrsrc-api, etc..). # # Requires the command output including STDERR. # # # # process_rmccli_error - extracts and prints errors from the output# # of an rmc cli command (mkrsrc, etc..). # # Requires the command name and its output including STDERR. # # # # remove_api_error - removes error messages from the output of a # # c-api command (mkrsrc-api, etc..). # # Requires the command output including STDERR. # # # # process_exit_code - returns either 0, the signal exit code, # # or the process error code for the called process. # # Requires the exit code to examine. # # # # ispermvalid - returns 0 if the permission string contains all # # valid permission characters. # # Requires the permission string. # # # # get_ids_perms_from_file - reads the file specified and returns # # an array that contains ids and permissions as if they were # # entered on the command line. # # Requires the file name to read. # # # # get_ids_from_file - reads the file specified and returns an # # array that contains ids (to delete) as if they were # # entered on the command line. # # Requires the file name to read. # # # # get_names_ids_perms_from_file - reads the file specified and # # returns an array each for the names, ids and permissions. # # Requires the file name to read. # # # # get_names_ids_from_file - reads the file specified and returns # # an array each for the names and ids. # # Requires the file name to read. # # # # getIMsg - returns the text of a message. Used for NLS. # # Requires the program name and message mnemonic as inputs. # # # # # # Examples: # # printCEMsg("EMsgCUcliBadOperand", $rsrc_class); # # # #--------------------------------------------------------------------# # Inputs: # # /opt/rsct/msgmaps/lprmcli.lprmcli.map - # # message mapping # # # # Outputs: # # stdout - common informational messages that get displayed. # # stderr - common error messages that get displayed. # # # # External References: # # Commands: ctdspmsg # # # # Tab Settings: # # 4 and tabs should be expanded to spaces before saving this file. # # in vi: (:set ts=4 and :%!expand -4) # # # # Change Activity: # # 041222 JAC 112254: Initial design & write. # # 050203 JAC 117535: Replace process_api_error. # # 050304 JAC 118242: Fix ispermvalid to reject 0 with anything. # # 071028 JAC 146726: set delimiters for calling -api commands. # ###################################################################### use Exporter (); @ISA = qw(Exporter); @EXPORT_OK = qw( error_exit printCIMsg printCEMsg process_api_error process_rmccli_error remove_api_error process_exit_code ispermvalid getIMsg get_ids_perms_from_file get_ids_from_file get_names_ids_perms_from_file get_names_ids_from_file ); use lib "/opt/rsct/pm"; use locale; use LPRM_cli_rc qw(LPRM_CLI_RMC_ERROR LPRM_CLI_ERROR LPRM_CLI_BAD_FLAG LPRM_CLI_BAD_OPERAND LPRM_CLI_USER_ERROR LPRM_CLI_NOT_FOUND); use LPRM_cli_include qw($CTBINDIR $CTDIR $TRUE $FALSE $RMC_CLI_USER_ERROR $RMC_SCOPE_ERROR $RMC_CLI_RSRC_NOT_FOUND ); #--------------------------------------------------------------------# # Global Variables # #--------------------------------------------------------------------# $MSGCAT = "lprmcli.cat"; # msg catalogue for these cmds $MSGSET = "lprmcli"; # common message set $LSMSG = "$CTBINDIR/ctdspmsg"; # list / display message rtn $ENV{'MSGMAPPATH'} = "$CTDIR/msgmaps"; # msg maps used by $LSMSG #--------------------------------------------------------------------# # Exported Subroutines (with @EXPORT_OK, -> on demand). # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # Common message handling (error, informational) routines: # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # error_exit - performs required cleanup and exits. # # Parameters: # # $badrc in Bad return code - bad enough to exit # # processing of this command. # # Exit: # # 1 LPRM_CLI_RMC_ERROR Underlying RMC error. # # 2 LPRM_CLI_ERROR Unexpected error in the command script.# # 3 LPRM_CLI_BAD_FLAG Input flag error. # # 4 LPRM_CLI_BAD_OPERAND Input operand error. # # 5 LPRM_CLI_USER_ERROR User error. # # 6 LPRM_CLI_NOT_FOUND Resource not found. # #--------------------------------------------------------------------# sub error_exit { my ($badrc) = @_; SWITCH: { ($badrc == LPRM_CLI_RMC_ERROR) && exit($badrc); ($badrc == LPRM_CLI_ERROR) && exit($badrc); ($badrc == LPRM_CLI_BAD_FLAG) && exit($badrc); ($badrc == LPRM_CLI_BAD_OPERAND) && exit($badrc); ($badrc == LPRM_CLI_USER_ERROR) && exit($badrc); ($badrc == LPRM_CLI_NOT_FOUND) && exit($badrc); # At this point all return codes should have been converted to # a valid LPRM CLI return code. But if one wasn't write an # error message. printCEMsg("EMsglprmcliBadRC", $badrc); exit(LPRM_CLI_ERROR); } # end switch } # end error_exit #--------------------------------------------------------------------# # printCIMsg : Calls $LSMSG to print out the common # # ConfigRM CLI information messages with the required parameters. # # Messages printed to stdout. # # This subroutine is like printIMsg except it is used to print # # the common ConfigRM CLI messages which are in the configrmcli # # message set. # # # # Parameters: # # $msg in Message mnemonic / message number in a sense. # # $optargs in Extra arguments/parameters to send to $LSMSG. # # # # Returns: None. # # # # Global Variables: # # $main::Trace in Prints extra info when trace is on. # # $LSMSG in Path & Command to display messages. # # $MSGCAT in ConfigRM CLI Message catalog. # # $MSGSET in ConfigRM CLI common message set "configrmcli"# #--------------------------------------------------------------------# sub printCIMsg { my ($msg, @optargs) = @_; my ($optarg, $optargs); $main::Trace && print STDERR "$LSMSG $MSGSET $MSGCAT $msg @optargs\n"; # Keep the args to LSMSG separate by separating with single quotes # but must replace internal single quotes with blanks or get an error. # Must escape internal double quotes for the system call. foreach $optarg (@optargs) { $optarg =~ s/'/\/g; $optarg =~ s/"/\\"/g; } $optargs = "'" . join("' '",@optargs) . "'"; (scalar @optargs > 0) ? system "$LSMSG $MSGSET $MSGCAT $msg $optargs | /bin/sed \"s/\/'/g\"" : system "$LSMSG $MSGSET $MSGCAT $msg"; return; } # end printCIMsg #--------------------------------------------------------------------# # printCEMsg : Calls $LSMSG to print out the common # # ConfigRM CLI error messages with the required parameters. # # Messages printed to stderr. # # This subroutine is like printEMsg except it is used to print # # the common ConfigRM CLI messages which are in the configrm # # message set and it prefixes the message with the appropriate # # program name. # # # # Parameters: # # $msg in Message mnemonic / message number in a sense. # # $optargs in Extra arguments/parameters to send to $LSMSG. # # # # Returns: None. # # # # Global Variables: # # $main::PROGNAME in Calling program/command for error message. # # $main::Trace in Prints extra info when trace is on. # # $LSMSG in Path and command to display messages. # # $MSGCAT in ConfigRM CLI Message catalog. # # $MSGSET in ConfigRM CLI common message set "configrmcli"# #--------------------------------------------------------------------# sub printCEMsg { my ($msg, @optargs) = @_; my ($optarg, $optargs); $main::Trace && print STDERR "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME @optargs\n"; # Keep the args to LSMSG separate by separating with single quotes # but must replace internal single quotes with blanks or get an error. # Must escape internal double quotes for the system call. foreach $optarg (@optargs) { $optarg =~ s/'/\/g; $optarg =~ s/"/\\"/g; } $optargs = "'" . join("' '",@optargs) . "'"; (scalar @optargs > 0) ? system "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME $optargs 1>&2 | /bin/sed \"s/\/'/g\"" : system "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME 1>&2"; return; } # end printCEMsg #--------------------------------------------------------------------# # process_api_error - Scans the input varaible for error messages # # found by the c-api command. The c-api command errors are # # found by searching each output line for "ERROR" at the # # beginning of the line. The error message printed is the last # # double colon delimited string. # # # # Parameters: # # $delimiter The delimiter used in the error string. # # $rc The return code from the c-api call. # # @command_output The output from the command. # # # # Returns: # # None. # # # # Global Variables: # #--------------------------------------------------------------------# sub process_api_error { my $delimiter = shift(@_); # output delimiter my $api_rc = shift(@_); # rc from c-api call my @command_output = @_; # command output to scan my $error_count = 0; # number of error messages my $line = ""; my $line2 = ""; # if the delimiter has a "|", escape it so it's not treated as an "or" if ($delimiter =~ /\|/) { $delimiter =~ s/\|/\\\|/g; } # scan each line for ERROR foreach $line (@command_output) { # does it start with ERROR? if ($line =~ /^ERROR.*/) { # split it apart based on double colons # last one should be error message @error_parts = split /$delimiter/, $line; # replace any escaped new lines with new lines $error_parts[$#error_parts] =~ s/\\n/\n/g; # get rid of any beginning/ending quote that comes from # having CT_CLI_QUOTE_STRING turned on (sometimes) if ( defined $ENV{CT_CLI_QUOTE_STRING} && $ENV{CT_CLI_QUOTE_STRING}==1) { $error_parts[$#error_parts] =~ s/^\"//; $error_parts[$#error_parts] =~ s/\"$//; #$error_parts[$#error_parts] =~ s/\\\"/\"/g; $error_parts[$#error_parts] = unescape_chars($error_parts[$#error_parts]); } # last one should be error message. print it to STDERR. print STDERR $error_parts[$#error_parts]; $error_count++; } else { # does it have ERROR in it somewhere (in case STDERR/STDOUT collided) ? if ($line =~ /ERROR${delimiter}/) { # get rid of the beginning part up to ERROR $line =~ s/.*ERROR${delimiter}/ERROR${delimiter}/; # now do same stuff as above for error messages # split it apart based on double colons # last one should be error message @error_parts = split /$delimiter/, $line; # replace any escaped new lines with new lines $error_parts[$#error_parts] =~ s/\\n/\n/g; # get rid of any beginning/ending quote that comes from # having CT_CLI_QUOTE_STRING turned on (sometimes) if ( defined $ENV{CT_CLI_QUOTE_STRING} && $ENV{CT_CLI_QUOTE_STRING}==1) { $error_parts[$#error_parts] =~ s/^\"//; $error_parts[$#error_parts] =~ s/\"$//; #$error_parts[$#error_parts] =~ s/\\\"/\"/g; $error_parts[$#error_parts] = unescape_chars($error_parts[$#error_parts]); } # last one should be error message. print it to STDERR. print STDERR $error_parts[$#error_parts]; $error_count++; } } } # print unexpected error if api rc was not 0 and no messages were displayed if (($error_count == 0) && ($api_rc != 0)) { printCEMsg("EMsgLPRMcliBadRC",$api_rc); } } # end of process_api_error #--------------------------------------------------------------------# # process_rmccli_error - Scans the @command_output varaible for error# # messages found by the rmc cli, but does not extract messages # # generated by the rmc cli itself. The $command parameter is used # # to decide what stays and what goes. # # # # Parameters: # # $commandt The rmc cli command name. # # @command_output The output from the command. # # # # Returns: # # None. # # # # Global Variables: # #--------------------------------------------------------------------# sub process_rmccli_error { my $command = shift(@_); # command that made output my @command_output = @_; # command output to scan # scan each line for the command name foreach $line (@command_output) { # if it doesn't start with the command name, print it if (!($line =~ /^$command.*/)) { # print it to STDERR. print STDERR $line; } } } # end of process_rmccli_error #--------------------------------------------------------------------# # remove_api_error - Scans the input varaible for error messages # # found by the c-api command. The c-api command errors are # # found by searching each output line for "ERROR" at the # # beginning of the line. An array is returned that is the same as # # the input array except that the error messages are removed. # # # # Parameters: # # @command_output The output from the command. # # # # Returns: # # @errorless_output The original @command_output array contents # # with the errors removed. # # # # Global Variables: # #--------------------------------------------------------------------# sub remove_api_error { my @command_output = @_; # command output to scan my @errorless_output = (); # errors removed # scan each line for ERROR foreach $line (@command_output) { # does it start with ERROR? if (!($line =~ /^ERROR.*/)) { # put it in the errorless array push @errorless_output, $line; } } return (@errorless_output); } # end of remove_api_error #--------------------------------------------------------------------# # process_exit_code: returns 0, the signal exit code, or the process # # exit code from the called process. This is used to examine the # # exit codes from perl uses for called processes. # # The exit value of the subprocess is in the high byte (>>8) # # The low byte has the signal the process died from (if any)(& 127)# # To be complete, core dumps are indicated with (& 128) (not used) # # # # Parameters: # # exit_code The exit code to be examined. # # # # Returns: # # process_exit_code 0, signal, or process exit code. # # # # Global Variables: # #--------------------------------------------------------------------# sub process_exit_code { my $exit_code = shift(@_); # the exit code to check my $process_signal_exit_code = 0; # signal exit code, if any my $process_exit_code = 0; # what to return # if it's 0, wonderful. if ($exit_code == 0) { return (0);}; # check for signal process died from, if any $process_signal_exit_code = $exit_code & 127; # if there was a signal, return it if ($process_signal_exit_code > 0) { return ($process_signal_exit_code);} # otherwise return the process exit code $process_exit_code = $exit_code >> 8; return ($process_exit_code); } # end process_exit_code #--------------------------------------------------------------------# # ispermvalid - Determines if the characters in the permission # # string are all valid permissions or not. If they are all # # valid, 0 is returned. # # # # Parameters: # # $perm The permission string. # # # # Returns: # # rc=0 if permissions are all valid. # # -1 if permissions are not all valid. # # # # Global Variables: # #--------------------------------------------------------------------# sub ispermvalid { my $perm = shift(@_); # get permission string my $rc = 0; # return code my $valid_perm = "qlevdcsoxarw0"; # the valid permissions my $len = 0; # length of permission string my $one = ""; # one permission character # get the length of the permission string $len = length $perm; # check each character for ( $i=0; $i<$len; $i++ ) { # get a character $one = substr($perm,$i,1); # check it if ( $one !~ /[$valid_perm]/) { $rc = -1; } } # still ok so far # last check # make sure 0 not combined with anything else if ( ($perm =~ /.*0.*/) && ($len > 1) ) { $rc = -1; } return ($rc); } # end of ispermvalid #--------------------------------------------------------------------# # get_ids_perms_from_file - Reads the first two tokens on a line of # # the specifed file as an id and its permission. The rest of the # # input line is ignored. The output is a character string as if # # the input were entered on the command line. The file is read one# # line at a time. The first string on the line up to a blank is # # used as the id for that line. The second string is the ids # # permission. The rest of the line is ignored. Any line that is # # blank or starts with a "#" is ignored. Text on a line after # # a "#" is ignored. # # # # Input: # # $file_name The name of the file to use. # # # # Returns: # # $input line The input IDs and permission pairs. # # # #--------------------------------------------------------------------# sub get_ids_perms_from_file { my @input_line_split = (); # holds split input my @cmd_input = (); # reformed input my $input_line = ""; # line from file my $one_id = ""; # an id from an input line my $one_perm = ""; # a permission from an input line my $file_error = ""; # when file doesn't open my $i = 0; # file line counter # get the file name passed in my $file_name = shift @_; # open the file. process if it opens ok if ( open (LPRM_FILE_IN,"$file_name") ) { # read until eof while () { # count the line $i++; # get a line from the file $input_line = $_; # get rid of any new line characters chomp($input_line); # get rid of leading spaces $input_line =~ s/^\s+//; # take a line unless it's a comment or empty if ( (!($input_line =~ /^#/)) && ($input_line ne "") ) { # only worry about up to an "#" (anything after is ignored) $input_line =~ s/#.*//; # get the first string on the line @input_line_split = split /\s+/,$input_line; # get the id and permission $one_id = shift @input_line_split; $one_perm = shift @input_line_split; # it's an error if either doesn't exist if ( ($one_id eq "") || ($one_perm eq "") ) { # print error message and exit &printCEMsg("EMsgLPRMcliBadFileInput", $file_name, $i); exit(LPRM_CLI_USER_ERROR); } # save the Ids and Permissions push @cmd_input, $one_id; push @cmd_input, $one_perm; } } # end of "while not eof" loop # close the file close(LPRM_FILE_IN); } # end of "opened ok" block # the file didn't open successfully else { # get the error $file_error = $!; # print error message and exit &printCEMsg("EMsgLPRMcliFileError",$file_name,$file_error); exit(LPRM_CLI_USER_ERROR); } # return the Ids and permissions return(@cmd_input); } # end get_ids_perms_from_file #--------------------------------------------------------------------# # get_ids_from_file - Reads the first token on a line of the # # specifed file as an id, ignoring permission. The rest of the # # input line is ignored. The output is a character string as if # # the input were entered on the command line. The file is read one# # line at a time. The first string on the line up to a blank is # # used as the id for that line. The rest of the line is ignored. # # Any line that is blank or starts with a "#" is ignored. Text on # # a line after a "#" is ignored. # # # # Input: # # $file_name The name of the file to use. # # # # Returns: # # $input line The input IDs and permission pairs. # # # #--------------------------------------------------------------------# sub get_ids_from_file { my @input_line_split = (); # holds split input my @cmd_input = (); # reformed input my $input_line = ""; # line from file my $one_id = ""; # an id from an input line my $file_error = ""; # when file doesn't open my $i = 0; # file line counter # get the file name passed in my $file_name = shift @_; # open the file. process if it opens ok if ( open (LPRM_FILE_IN,"$file_name") ) { # read until eof while () { # count the line $i++; # get a line from the file $input_line = $_; # get rid of any new line characters chomp($input_line); # get rid of leading spaces $input_line =~ s/^\s+//; # take a line unless it's a comment or empty if ( (!($input_line =~ /^#/)) && ($input_line ne "") ) { # only worry about up to an "#" (anything after is ignored) $input_line =~ s/#.*//; # get the first string on the line @input_line_split = split /\s+/,$input_line; # get the id $one_id = shift @input_line_split; # it's an error if it doesn't exist if ( $one_id eq "") { # print error message and exit &printCEMsg("EMsgLPRMcliBadFileInput", $file_name, $i); exit(LPRM_CLI_USER_ERROR); } # save the Ids push @cmd_input, $one_id; } } # end of "while not eof" loop # close the file close(LPRM_FILE_IN); } # end of "opened ok" block # the file didn't open successfully else { # get the error $file_error = $!; # print error message and exit &printCEMsg("EMsgLPRMcliFileError",$file_name,$file_error); exit(LPRM_CLI_USER_ERROR); } # return the Ids return(@cmd_input); } # end get_ids_from_file #--------------------------------------------------------------------# # get_names_ids_perms_from_file - Reads the first three tokens on a # # line of the specifed file as the name, an id and its permission. # # The rest of the input line is ignored. The output is 3 arrays # # for names, ids, and permission. The file is read one line at a # # time. The first string on the line up to a blank is used as the # # name for that line. The second string is the id, and the third # # is the permission. The rest of the line is ignored. Any line # # that is blank or starts with a "#" is ignored. Text on a line # # after a "#" is ignored. # # # # Input: # # $file_name The name of the file to use. # # # # Returns: # # @names An array of names. # # @ids An array of ids. # # @perms An array of permissions. # # # #--------------------------------------------------------------------# sub get_names_ids_perms_from_file { my @input_line_split = (); # holds split input my @cmd_input = (); # reformed input my $input_line = ""; # line from file my $one_name = ""; # a name from an input line my $one_id = ""; # an id from an input line my $one_perm = ""; # a permission from an input line my $file_error = ""; # when file doesn't open my $i = 0; # file line counter my @names = (); # output array of names my @ids = (); # output array of ids my @perms = (); # output array of permissions # get the file name passed in my $file_name = shift @_; # open the file. process if it opens ok if ( open (LPRM_FILE_IN,"$file_name") ) { # read until eof while () { # count the line $i++; # get a line from the file $input_line = $_; # get rid of any new line characters chomp($input_line); # get rid of leading spaces $input_line =~ s/^\s+//; # take a line unless it's a comment or empty if ( (!($input_line =~ /^#/)) && ($input_line ne "") ) { # only worry about up to an "#" (anything after is ignored) $input_line =~ s/#.*//; # get the first string on the line @input_line_split = split /\s+/,$input_line; # get the id and permission $one_name = shift @input_line_split; $one_id = shift @input_line_split; $one_perm = shift @input_line_split; # it's an error if any don't exist if ( ($one_name eq "") || ($one_id eq "") || ($one_perm eq "") ) { # print error message and exit &printCEMsg("EMsgLPRMcliBadFileInput", $file_name, $i); exit(LPRM_CLI_USER_ERROR); } # save the Names, Ids and Permissions push @names, $one_name; push @ids, $one_id; push @perms, $one_perm; } } # end of "while not eof" loop # close the file close(LPRM_FILE_IN); } # end of "opened ok" block # the file didn't open successfully else { # get the error $file_error = $!; # print error message and exit &printCEMsg("EMsgLPRMcliFileError",$file_name,$file_error); exit(LPRM_CLI_USER_ERROR); } # return the Names, Ids and permissions arrays return(\@names, \@ids, \@perms); } # end get_names_ids_perms_from_file #--------------------------------------------------------------------# # get_names_ids_from_file - Reads the first two tokens on a line of # # the specifed file as the name and an id. The rest of the input # # line is ignored. The output is 2 arrays for names and ids. # # The file is read one line at a time. The first string on the # # line up to a blank is used as the name for that line. The # # second string is the id. The rest of the line is ignored. Any # # line that is blank or starts with a "#" is ignored. Text on a # # line after a "#" is ignored. # # # # Input: # # $file_name The name of the file to use. # # # # Returns: # # @names An array of names. # # @ids An array of ids. # # # #--------------------------------------------------------------------# sub get_names_ids_from_file { my @input_line_split = (); # holds split input my @cmd_input = (); # reformed input my $input_line = ""; # line from file my $one_name = ""; # a name from an input line my $one_id = ""; # an id from an input line my $file_error = ""; # when file doesn't open my $i = 0; # file line counter my @names = (); # output array of names my @ids = (); # output array of ids # get the file name passed in my $file_name = shift @_; # open the file. process if it opens ok if ( open (LPRM_FILE_IN,"$file_name") ) { # read until eof while () { # count the line $i++; # get a line from the file $input_line = $_; # get rid of any new line characters chomp($input_line); # get rid of leading spaces $input_line =~ s/^\s+//; # take a line unless it's a comment or empty if ( (!($input_line =~ /^#/)) && ($input_line ne "") ) { # only worry about up to an "#" (anything after is ignored) $input_line =~ s/#.*//; # get the first string on the line @input_line_split = split /\s+/,$input_line; # get the id and permission $one_name = shift @input_line_split; $one_id = shift @input_line_split; # it's an error if any don't exist if ( ($one_name eq "") || ($one_id eq "") ) { # print error message and exit &printCEMsg("EMsgLPRMcliBadFileInput", $file_name, $i); exit(LPRM_CLI_USER_ERROR); } # save the Names, Ids and Permissions push @names, $one_name; push @ids, $one_id; } } # end of "while not eof" loop # close the file close(LPRM_FILE_IN); } # end of "opened ok" block # the file didn't open successfully else { # get the error $file_error = $!; # print error message and exit &printCEMsg("EMsgLPRMcliFileError",$file_name,$file_error); exit(LPRM_CLI_USER_ERROR); } # return the Names, and Ids arrays return(\@names, \@ids); } # end get_names_ids_perms_from_file #--------------------------------------------------------------------# # getIMsg : calls $LSMSG to print out the message with the # # required parameters, like printIMsg, except the message is # # returned instead of printed. Used for NLS. # # # # Parameters: # # msg in Message mnemonic / message number in a sense. # # optargs in Extra arguments/parameters to send to LSMSG. # # # # Returns: # # msgtext out Array of messages. # # # # Global Variables: # # $main::Trace in Print extra info when trace is on. # # $main::PROGNAME in Calling program/command for error message. # # $main::LSMSG in Path & Command to display messages. # # $main::MSGCAT in The calling commands Message catalogue. # #--------------------------------------------------------------------# sub getIMsg { my ($msg, @optargs) = @_; my ($optarg, $optargs); my @msgtext = (); $main::Trace && print STDERR "$main::LSMSG $main::PROGNAME $main::MSGCAT $msg @optargs\n"; # Keep the args to LSMSG separate by separating with single quotes # but must replace internal single quotes with blanks or get an error. # Must escape internal double quotes for the system call. foreach $optarg (@optargs) { $optarg =~ s/'/ /g; $optarg =~ s/"/\\"/g; } $optargs = "'" . join("' '",@optargs) . "'"; if (scalar @optargs > 0) { @msgtext = `$main::LSMSG $main::PROGNAME $main::MSGCAT $msg $optargs`; } else { @msgtext = `$main::LSMSG $main::PROGNAME $main::MSGCAT $msg`; } return (@msgtext); } # end getIMsg #--------------------------------------------------------------------# # End Exported Subroutines (with @EXPORT_OK, -> on demand). # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # End File. # #--------------------------------------------------------------------#