# 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/'/\<U\+0027\>/g;
$optarg =~ s/"/\\"/g;
}
$optargs = "'" . join("' '",@optargs) . "'";
(scalar @optargs > 0) ?
system "$LSMSG $MSGSET $MSGCAT $msg $optargs | /bin/sed \"s/\<U\+0027\>/'/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/'/\<U\+0027\>/g;
$optarg =~ s/"/\\"/g;
}
$optargs = "'" . join("' '",@optargs) . "'";
(scalar @optargs > 0) ?
system "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME $optargs 1>&2 | /bin/sed \"s/\<U\+0027\>/'/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 (<LPRM_FILE_IN>) {
# 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 (<LPRM_FILE_IN>) {
# 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 (<LPRM_FILE_IN>) {
# 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 (<LPRM_FILE_IN>) {
# 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. #
#--------------------------------------------------------------------#