# IBM_PROLOG_BEGIN_TAG
# This is an automatically generated prolog.
#
#
#
# Licensed Materials - Property of IBM
#
# (C) COPYRIGHT International Business Machines Corp. 2002,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 CT_cli_displayext_utils;
# sccsid = "@(#)57 1.3 src/rsct/cli/pm/CT_cli_displayext_utils.pm.perl, ctcli, rsct_rady, rady2035a 11/12/15 16:42:12"
######################################################################
# #
# Package: CT_cli_displayext_utils.pm #
# #
# Description: #
# This package contains common subroutines for the Perl Cluster #
# Command Line Interface. This package uses perl extensions. #
# #
# Subroutines Exported: #
# Notes: all routines display to STDOUT except Trace statements, #
# which go to STDERR. #
# - all data types referred to are included in the #
# ct_data_type_t enum in the ct.h file. #
# #
# set_display - pipes an incoming reference to an array #
# of data to be displayed to the appropriate #
# output routine based on display type. #
# array_to_string - converts all array types into appropriate #
# string format for display to screen. #
# value_to_string - converts a single value to the appropriate #
# string format for display to screen. #
# convert_value - converts a value with a data type in the #
# ct_data_type_t enum to a string, so it #
# can be displayed via the CLI. #
# NOTE: in general, this subroutine will be #
# called over the previous two listed here. #
# rsrc_handle_to_string - converts resource handle 6-int array to#
# a single string with correct formatting for#
# display to the command line. #
# make_hex_string - takes packed binary input and converts it #
# to hexadecimal output suitable for display #
# to the command line. #
# #
# Other subroutines in this package: #
# encapsulate_string - puts quotes around a string and returns #
# the quoted string. Strings are values #
# (value_t) that have a ct_char_ptr data #
# type. See subroutine for the quoting rules.#
# int_array_to_string- takes an array with encapsulated entries #
# (already formatted for display) and #
# combines the entries into a single string #
# with spacing based on the display type. #
# column_display - display array data using columns #
# long_display - display array data using long or file #
# format #
# delim_display - display array data using delimiters #
# #
# Examples for exported subroutines: #
# The first set of examples are for using the common create_display #
# function to format the table data. #
# #
# To create a delimited display, where the delimiter is stored #
# in $Opt_Delimiter: #
# set_display('delim', $header_suppress, $row_count, $col_count, #
# \@data_reference, $Opt_Delimiter); #
# #
# To convert an array of data to a string suitable for a cell #
# in the array to be passed to set_display: (*) #
# $output_string = array_to_string($type, \@array_ref); #
# (*) See end of this prolog for array format #
# #
# To convert a single data value to a string suitable for a cell #
# in the array to be passed to set_display: #
# $output_string = value_to_string($data_type, $data_value); #
# #
# To convert a data value to a string (regardless of type, as #
# long as it is in ct_data_type_t): #
# $output_string = convert_value($data_type, $data_value); #
# #
# The next set of examples are for directly using the display #
# routines after having constructed arrays containing the table #
# data. (Information retained for possible future use. As these #
# routines are not exported, they can not be used outside of this #
# package.) #
# #
# To print delimited display - $delim holds a string, @columns #
# is the table data: #
# delim_display($title, $no_header, $row_count, $col_count, #
# $delim, @columns); #
# #
# To print long form display - @columns is the table data: #
# long_display($title, $no_header, $row_count, $col_count, #
# 'long', @columns); #
# #
# To print file format display - @columns is the table data: #
# long_display($title, $no_header, $row_count, $col_count, #
# 'file', @columns); #
# #
# To print column display (this is the default for most displays) #
# - @columns is the table data: #
# column_display($title, $no_header, $row_count, $col_count, #
# 'column', @columns ); #
# #
# Other examples: #
# #
# Converting packed binary from the %binary_hv hash format #
# to a display string: (See CT_cli_input_utils for format of this #
# hash, and how to set it up:) #
# $output_string = make_hex_string(2*$input_value->{length}, #
# $input_value->{image} ); #
# #
# Input array format for column_display, long_display, #
# and delim_display: #
# #
# - Each display method uses a reference to a 2-D array. #
# - 0th row, 0th column contains the title of the data. #
# Usually this will be a keyword specific to the type of input #
# file or display to be used by the calling component, example: #
# TableDefinition, RowData for SR CLI, ResourceDefinition for RMC #
# - 0th row of the table contains header information. #
# If no headers are to be printed, this row is ignored. #
# - 0th column contains row header information (used for long #
# for display.) #
# - Table is otherwise in a basic column format - entries #
# corresponding to the column header are contained in each column #
# for as many rows as necessary. #
# #
# Blank entries ( or undef ) are displayed as follows: #
# - column and delimited format displays a blank in that space #
# - long format does not display that entry for the row #
# #
#--------------------------------------------------------------------#
# Inputs: #
# /opt/rsct/msgmaps/ctcli.ctcli.map - message mapping #
# Currently all messages are hard-coded into this file #
# #
# Outputs: #
# stdout - common informational messages that get displayed. #
# - all display output. #
# stderr - common error messages that get displayed. #
# #
# External References: #
# Extensions: CT::CT.pm #
# Modules: CT_cli_utils - data_type_is_simple, #
# data_type_is_array #
# #
# Tab Settings: #
# 4 and tabs should be expanded to spaces before saving this file. #
# in vi: (:set ts=4 and :%!expand -4) #
# #
# Change Activity: #
# 000900 HGJ xxxxx: Initial delivery. #
# 020722 JAC 84861: Change value_to_string to use CT_NONE as the #
# default type. #
# 020925 JAC 87393: Create from CT_cli_display_utils but keeps #
# perl extensions references. For rmc/sr cli. #
######################################################################
use Exporter ();
@ISA = qw(Exporter);
@EXPORT_OK = qw(
set_display
array_to_string
value_to_string
convert_value
make_hex_string
rsrc_handle_to_string
CT_CLI_MAX_COL_WIDTH
);
use lib "/opt/rsct/pm";
use locale;
##use CT::CT qw(:ct_data_type_t);
use CT_cli_utils qw(
printCEMsg
);
use CT_cli_data_type_utils qw(
data_type_is_simple
data_type_is_array
);
use CT_cli_rc qw(:return_codes); # such as MC_CLI_USER_ERROR
#--------------------------------------------------------------------#
# Global Variables #
#--------------------------------------------------------------------#
# Maximum column width for (column) display
use constant CT_CLI_MAX_COL_WIDTH => 60;
# Default is to enclose strings in quotes.
# When CT_CLI_QUOTE_STRING environment variable is set to 0
# do not enclose strings in quotes in encapsulate_string
$CT_CLI_QUOTE_STRING = $ENV{CT_CLI_QUOTE_STRING};
$UNSUPPORTED = "Data type not yet supported by CLI";
#--------------------------------------------------------------------#
# Begin Exported Subroutines (with @EXPORT_OK, -> on demand). #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# encapsulate_string: #
# Takes a reference to a string and puts quotes around the string. #
# All strings are surrounded with double quotes unless: #
# 1. The string contains double quotes. If it contains double #
# quotes but no single quotes it is surrounded by single #
# quotes. The reason we do this over escaping the double #
# quotes is we prefer that data entered by a user look like #
# the date entered by the user. Also csh users are more #
# likely to use this format. #
# 2. If the string contains both double and single quotes then #
# the string will be surrounded with double quotes and the #
# internal double quotes will be escaped. #
# This is to format the CT_CHAR_PTR type for screen display. #
# #
# Parameters: #
# \$str - string to be scanned for whitespace or \n characters. #
# #
# Returns: #
# $output_string - string enclosed in quotes according to rules #
# described earlier. #
# #
# Globals Used: #
# $main::Trace5 - to print trace information if requested #
# $CT_CLI_QUOTE_STRING - 0 - do not encapsulate string in quotes. #
#--------------------------------------------------------------------#
sub encapsulate_string {
my $str = shift;
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::encapsulate_string($str)\n";
if (defined $CT_CLI_QUOTE_STRING && $CT_CLI_QUOTE_STRING == 0) {
return $str;
}
# Undefined or an empty string return return "".
if (!defined $str || $str eq "") {
return '""';
}
# Check if the string contains double quotes
if ($str =~ /"/) {
# See if the string also contains single quotes
# If it does the internal double quotes will need to be escaped.
# There is an NLS exposure here since scanning for \" a \ can
# appear as a byte in a multi byte chracter.
# No easy way around this until Perl respects the locale whe
# doing regular expressions sometime in Perl6.0 or later.
if ($str =~ /'/) {
my $temp_str = $str;
if ($str =~ /\\"/) {
$temp_str =~ s/\\"/\\\\"/g;
}
else {
$temp_str =~ s/"/\\"/g;
}
$temp_str =~ s/"/\\"/g;
return '"'.$temp_str.'"';
}
# String contains double quotes but no single quotes
# so enclose it in single quotes. We prefer not to change
# the data from how the user may have entered it. That's why
# by default we just don't blindly suround with double quotes
# and escape the internal double quotes.
else {
return "'".$str."'";
}
}
else {
# string does not contain double quotes so
# enclose the whole string in double quotes.
return '"'.$str.'"';
}
return $str;
} # end encapsulate_string
#--------------------------------------------------------------------#
# int_array_to_string: #
# Takes a reference to an array of integers OTHER THAN a resource #
# handle, and prints it to a string with the correct format for #
# display to any of the CT components. #
# This is to format the CT_INT32_ARRAY, CT_UINT32_ARRAY, #
# CT_INT64_ARRAY, CT_UINT64_ARRAY, CT_FLOAT32_ARRAY, #
# CT_FLOAT64_ARRAY correctly for screen display. #
# Format for array output is: {x, x, x, x, x,..} #
# #
# Parameters: #
# $int_array - reference to an array of integers. #
# #
# Returns: #
# $output_string - formatted array. #
# #
# Globals Used: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub int_array_to_string {
my $int_array = shift;
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::int_array_to_string(@$int_array)\n";
my @temp_array = @$int_array;
my $output_string = "";
foreach $entry ( @$int_array ) {
$output_string = $output_string . $entry . ',' ;
}
# Removed the trailing ',' on the array
$output_string = "{".
substr($output_string, 0, length($output_string) - 1)
."}";
$main::Trace5 &&
print STDERR "Leaving CT_cli_displayext_utils::int_array_to_string($output_string)\n";
return $output_string;
} # end int_array_to_string
#--------------------------------------------------------------------#
# array_to_string: #
# Generic routine that handles the array formats, converting them #
# to string formats depending on the display type. Uses individual #
# subroutines for the various array types: #
# CT_INT32_ARRAY, CT_UINT32_ARRAY, CT_INT64_ARRAY, CT_UINT64_ARRAY,#
# CT_FLOAT32_ARRAY, CT_FLOAT64_ARRAY, CT_CHAR_PTR_ARRAY, #
# CT_BINARY_PTR_ARRAY, CT_RSRC_HANDLE_PTR_ARRAY, CT_SD_PTR_ARRAY #
# #
# Parameters: #
# $at_type - data type of the input value. #
# $input_array - reference to an array of data to be translated #
# to the output string. #
# #
# Output: #
# $output_string - array data as a string. If $display_type is #
# 'long' the integers are given 1 per line, spaced#
# according to the size of $attribute_name. #
# Otherwise they are given in a single string, #
# using a single space as delimiter. #
# #
# Global Variables Used: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub array_to_string {
# Grab parameters
my $at_type = shift;
my $input_array = shift;
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::array_to_string($at_type, @$input_array)\n";
# Set up local variables
my $output_string = "";
my $str;
my $index = 0;
my @temp_array = ();
SWITCH: {
# Print the arrays according to type
if ($at_type == CT_CHAR_PTR_ARRAY) {
foreach $str (@$input_array) {
if ($str =~ /[{}\[\],]'"/) {
# Specifically done here because if the string
# is not in an array, it doesn't matter if it
# has commas in it or not. So this check does
# not belong in encapsulate_string
if ($str =~ /"/) { $temp_array[$index] = "'".$str."'";}
else { $temp_array[$index] = '"'.$str.'"'; }
print $temp_array[$index],"\n";
$index++;
}
else {
$temp_array[$index++] = encapsulate_string($str);
}
}
$output_string =
int_array_to_string(\@temp_array);
last SWITCH;
}
if ($at_type == CT_SD_PTR_ARRAY) {
$output_string = "{";
foreach $str (@$input_array) {
$output_string = $output_string . convert_value(CT_SD_PTR, $str).",";
}
chop $output_string if ($output_string =~ /,$/);
$output_string = $output_string ."}";
last SWITCH;
}
if ($at_type == CT_BINARY_PTR_ARRAY) {
foreach $str (@$input_array) {
$temp_array[$index] = make_hex_string(2*$str->{length},
$str->{image} );
$temp_array[$index] = '"'.$temp_array[$index].'"';
$index++;
}
$output_string =
int_array_to_string(\@temp_array);
last SWITCH;
}
if ($at_type == CT_RSRC_HANDLE_PTR_ARRAY) {
foreach $str (@$input_array) {
$temp_array[$index++] = rsrc_handle_to_string($str);
}
$output_string =
int_array_to_string(\@temp_array);
last SWITCH;
}
if ( data_type_is_array($at_type) ) {
$output_string =
int_array_to_string($input_array);
last SWITCH;
}
# This is the default - Shouldn't be reached unless the
# data itself is corrupt somehow.
$output_string = $UNSUPPORTED;
} # end SWITCH
$main::Trace5 &&
print STDERR "Leaving CT_cli_displayext_utils::array_to_string($output_string)\n";
return $output_string;
} # end array_to_string
#--------------------------------------------------------------------#
# value_to_string: #
# Takes a reference to a value and converts it to a string as #
# necessary. #
# display to any of the CT components. #
# This is to format the CT_INT32_ARRAY, CT_UINT32_ARRAY, #
# CT_INT64_ARRAY, CT_UINT64_ARRAY, CT_FLOAT32_ARRAY, #
# CT_FLOAT64_ARRAY correctly for screen display. #
# #
# Parameters: #
# $at_type - data type of the input value. #
# $input_value - reference to a value to be translated to a string#
# #
# Output: #
# $output_string - value as a string. Format depends on the data #
# type provided in the $at_type parameter. #
# #
# Global Variables Used: #
# $main::Trace5 - to print trace information if requested #
# None #
#--------------------------------------------------------------------#
sub value_to_string {
my $at_type = shift;
my $input_value = shift;
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::value_to_string($at_type, $input_value)\n";
my $output_string = "";
my $entry;
my $index = 0;
# if type doesn't exist, use CT_NONE
if (!defined $at_type) { $at_type = CT_NONE };
SWITCH: {
# Print the value according to it's type
if ($at_type == CT_RSRC_HANDLE_PTR) {
$output_string = rsrc_handle_to_string($input_value);
last SWITCH;
}
if ($at_type == CT_CHAR_PTR) {
$output_string = encapsulate_string($input_value);
last SWITCH;
}
if ($at_type == CT_BINARY_PTR) {
$output_string = make_hex_string(2*$input_value->{length},
$input_value->{image} );
$output_string = '"'.$output_string.'"';
last SWITCH;
}
if ($at_type == CT_SD_PTR) {
$output_string = sd_to_string($input_value);
last SWITCH;
}
if ($at_type == CT_SBS_PTR) {
$output_string = $UNSUPPORTED;
last SWITCH;
}
if ($at_type == CT_NONE) {
$output_string = "";
last SWITCH;
}
if ($at_type == CT_UNKNOWN) {
$output_string = "ct_unknown";
last SWITCH;
}
if (data_type_is_simple($at_type) ) {
return $input_value;
}
# Default - Will have to be a standard message - what text?
$output_string = $UNSUPPORTED;
} # end SWITCH
$main::Trace5 &&
print STDERR "Leaving CT_cli_displayext_utils::value_to_string($output_string)\n";
return $output_string;
} # end value_to_string
#--------------------------------------------------------------------#
# convert_value: #
# Takes a reference to a data value and passes it to the correct #
# formatting routine based on the data type. Uses the subroutines #
# value_to_string and array_to_string, depending on the data type #
# to convert the value to a string. #
# #
# Parameters: #
# $data_type - data type passed in (a value in enum #
# ct_data_type_t in ct.h) #
# $data_value - reference to a value (could be an array) to be #
# formatted for screen display. #
# #
# Returns: #
# $output_string - formatted data value. #
# #
# Globals Used: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub convert_value {
my $data_type = shift;
my $data_value = shift;
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::convert_value($data_type, $data_value)\n";
if ( data_type_is_simple($data_type) ){
$output_string =
value_to_string($data_type, $data_value);
}
elsif ( data_type_is_array($data_type) ) {
$output_string =
array_to_string($data_type, $data_value);
}
else {
$output_string = $UNSUPPORTED;
# The idea here is to put 'data type unsupported' into the data to
# be displayed. The return here is a reminder that this could also
# be an error. It's an option.
# return (-1);
}
$main::Trace5 &&
print STDERR "Leaving CT_cli_displayext_utils::convert_value($output_string)\n";
return $output_string;
} # end convert_value
#--------------------------------------------------------------------#
# sd_to_string: #
# Takes a reference to an array of integers that is a resource #
# handle, and prints it to a string with the correct format for #
# display to any of the CT components. #
# This is to format the CT_RSRC_HANDLE_PTR correctly for screen #
# display. #
# #
# Parameters: #
# \@resource_handle - reference to an array containing the handle #
# to be printed out. #
# #
# Returns: #
# $output_string - formatted structured data. #
# #
# Globals Used: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub sd_to_string {
my $sd = shift;
# Should be an array of hashes
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::sd_to_string\n";
my $output_string = "[";
if (scalar(@$sd) > 0 ) {
foreach $de (@$sd) {
my $temp = convert_value($de->{type}, $de->{value});
# Check to see if the string coming back has a comma
# in it, but that it does not contain {.*?} - an array
# or that it has not already been enclosed in single
# or double quotation marks.
# If there is a comma, but not the others, add quotes.
# Note on the patterns below:
# - .*? does a least/minimal match
# - /s allows '.' to match a newline character
# - The \1 in the 3rd pattern refers to the values (['"]).
# It matches whichever one appears, single or double quote,
# and the actual return value of that line is which quote
# was used.
if (($temp =~ /,/) &&
($temp !~ /^{.*?}$/s) &&
($temp !~ /^(['"]).*?\1/s) )
{ $temp = '"'.$temp.'"';}
$output_string = $output_string . $temp.",";
}
chop $output_string;
}
$output_string = $output_string . "]";
$main::Trace5 &&
print STDERR "Leaving CT_cli_displayext_utils::sd_to_string\n";
return $output_string;
} # end sd_to_string
#--------------------------------------------------------------------#
# rsrc_handle_to_string: #
# Takes a reference to an array of integers that is a resource #
# handle, and prints it to a string with the correct format for #
# display to any of the CT components. #
# This is to format the CT_RSRC_HANDLE_PTR correctly for screen #
# display. #
# #
# Parameters: #
# \@resource_handle - reference to an array containing the handle #
# to be printed out. #
# #
# Returns: #
# $output_string - formatted resource handle. #
# Format is currently: #
# "0xNNNN 0xNNNN 0xNNNNNNNN 0xNNNNNNNN 0xNNNNNNNN 0xNNNNNNNN" #
# #
# Globals Used: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub rsrc_handle_to_string {
# Get input parameters
# Reference to resource handle array - should be 6 ints
# (Perl considers them 6 ints at this point. The C API
# considers them 2 ct_uint16_t and 4 ct_uint32_t.)
my $rhandle = shift;
$main::Trace5 && print STDERR "Entered CT_cli_displayext_utils::rsrc_handle_to_string(@$rhandle)\n";
# Set up local parameters
my $num_elements = 0;
my $output = "";
my $i;
$num_elements = scalar(@$rhandle);
if ($num_elements > 6) {
$num_elements = 6;
}
# Format each element of the resource handle
# elements 0-1 2 16 byte headers
# elements 2-5 4 32 byte ids
for ($i = 0; $i < $num_elements; $i++) {
if ($i == 0 || $i == 1) {
$output = $output . sprintf "0x%4.4lx", $$rhandle[$i];
}
else {
$output = $output . sprintf "0x%8.8lx", $$rhandle[$i];
}
$output = $output . " ";
}
# If the resource handle array did not contain 6 elements than
# 0 out what is missing
for ($i = $i; $i < 6; $i++) {
if ($i == 0 || $i == 1) {
$output = $output . sprintf "0x%4.4lx", 0;
}
else {
$output = $output . sprintf "0x%8.8lx", 0;
$output = $output . " ";
}
}
# Remove trailing space
chop $output;
# Add quotes to the line for display
$output = '"'.$output.'"';
$main::Trace5 && print STDERR "Leaving CT_cli_displayext_utils::rsrc_handle_to_string($output)\n";
return ($output);
} # end rsrc_handle_to_string
#--------------------------------------------------------------------#
# make_hex_string: #
# Takes packed input and converts to an unpacked hex string, #
# using unpack. Formatted string is of the form #
# 0x######## 0x######## 0x######## ... #
# #
# Parameters: #
# $input_string - stream of binary numbers #
# #
# Returns: #
# $output_string - string containing hex characters #
# #
# Global Variables: #
# None. #
#--------------------------------------------------------------------#
sub make_hex_string {
# Notes on the 'unpack' routine in this sub:
# 'H' does high nybble first, ${input_length} pulls input_length
# number of characters from the input string
# Refer to the Perl 5 Camel book, p 196 for (a bit) more information
# Grab input parameters
my ($input_length, $input_string) = @_;
# Set up local variables
my @temp_array = ();
my $new_string = "";
my $output_string = "";
# H${input_length} substitutes the value of $input_length and
# extracts that number of hexadecimal 'digits' from $input_string.
# $input_string was previously packed using H*.
$output_string = unpack("H${input_length}", $input_string);
# Split out the unpacked string into 8 character pieces, store
# in a temporary array
# If the length is unevenly divisible by 8, then remember to
# pick up the remaining characters
# What happens if the string is shorter than 8?
if (($input_length)%8) {
@temp_array = unpack("A8" x (1+($input_length/8)), $output_string);
}
else {
@temp_array = unpack("A8" x ($input_length/8), $output_string);
}
# Concatenate the 8-character array entries back together with
# leading '0x' and separating space to create the desired format
foreach (@temp_array) {
if ($_ ne "") {$new_string .= '0x'.$_.' ';}
}
# Remove the trailing space left by the last append in the foreach
chop $new_string;
return $new_string;
} # end make_hex_string
#--------------------------------------------------------------------#
# set_display: #
# Based on the display format, this program calls either #
# column_display, long_display, delim_display. #
# #
# Parameters: #
# $display_type - type of display - column, long or delim #
# $no_header - (boolean) header suppression flag #
# $row_count - number of rows in output data #
# $col_count - number of columns in output data #
# $data_to_print - reference to array of data to print #
# $delimiter - for use with delim display (optional) #
# #
# Returns: #
# $local_rc - 0 if command completes successfully #
# - 1 if invalid display type #
# #
# Globals Used: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub set_display {
# Get input parameters
my $display_type = shift;
my $no_header = shift;
my $row_count = shift;
my $col_count = shift;
# $data_to_print is an array reference
my $data_to_print = shift;
# Optional parameters
my $delimiter = ':';
if (@_) {$delimiter = shift;}
$main::Trace5 &&
print STDERR "Entered CT_cli_displayext_utils::set_display($display_type, $no_header, $row_count, $col_count, $data_to_print, $delimiter )\n";
# Other local variables
my $local_rc = 0;
# Call the appropriate display routine
if ($display_type eq "column") {
$main::Trace5 &&
print STDERR "Entering CT_cli_displayext_utils::column_display\n";
column_display($no_header, $row_count, $col_count,
$data_to_print);
$main::Trace5 &&
print STDERR "Exiting CT_cli_displayext_utils::column_display\n";
}
elsif ($display_type eq "long") {
$main::Trace5 &&
print STDERR "Entering CT_cli_displayext_utils::long_display(\"long\")\n";
long_display($no_header, $row_count, $col_count, "long",
$data_to_print);
$main::Trace5 &&
print STDERR "Exiting CT_cli_displayext_utils::column_display\n";
}
elsif ($display_type eq "file") {
$main::Trace5 &&
print STDERR "Entering CT_cli_displayext_utils::long_display(\"file\")\n";
long_display($no_header, $row_count, $col_count, "file",
$data_to_print);
$main::Trace5 &&
print STDERR "Exiting CT_cli_displayext_utils::column_display\n";
}
elsif ($display_type eq "delim") {
$main::Trace5 &&
print STDERR "Entering CT_cli_displayext_utils::delim_display\n";
delim_display($no_header, $row_count, $col_count, $delimiter,
$data_to_print);
$main::Trace5 &&
print STDERR "Exiting CT_cli_displayext_utils::delim_display\n";
}
else {
printCEMsg("EMsgCTcliInvalidDisplayType", $display_type);
$local_rc = CT_CLI_USER_ERROR;
}
$main::Trace5 && print STDERR "Leaving CT_cli_displayext_utils::set_display($local_rc)\n";
return $local_rc;
} # end set_display
#--------------------------------------------------------------------#
# column_display: #
# Write input array data to STDOUT using column format. #
# See prolog to this file for input array format. #
# #
# Input Parameters: #
# $title - overall title for the display #
# $no_header - if == 1, then no headers are printed #
# if == 0, then headers are printed #
# $row_count - number of rows in the input array #
# $col_count - number of columns in the input array #
# $columns - AV reference to array to be printed #
# See prolog to this file for input array format. #
# #
# Output Parameters: #
# None #
# #
# Globals Altered: #
# None #
#--------------------------------------------------------------------#
sub column_display {
# Gather input parameters
my ($no_header, $row_count, $col_count, $columns) = @_;
# Set up local variables
my ($col, $row);
my $size = 0;
my $new_size = 0;
my $start_row = 1;
# The 0th row is not accounted for in the $row_count, so add
# one to simplify the for statements in this subroutine
$row_count++;
# Set up an array of column widths for the display.
# Check the length of all the row entries to get the largest that
# is less than CT_CLI_MAX_COL_WIDTH characters in length.
# Then compare this to the size of
# the column name itself. Take the largest value of all those
# and store it as the column width for using in the printf
# statements later in the code.
# NLS Note: Since Perl doesn't truly respect locales yet
# a string being displayed in a mbcs locale may be truncated
# in the middle of multi byte character. For now mbcs locales should
# opt to display strings in long or delimiter format - if this is
# a problem.
# Assign this value locally otherwise too much overhead accessing
# within loops
# TODO: In future may want to externalize allowing user to set
# CT_CLI_MAX_COL_WIDTH or dynamically determine if based on the
# width of the screen using one of the standard C header files
# that provide that info (stdio, termio?).
# TODO: to add this to be adjustable to the size of the screen:
# the size of the screen - The width of the largest entry =
# how much space is left for other columns. if it's less than 12,
# say (need SR_CLI_MIN_COL_WIDTH??) then keep it to one
# column... Need more here.
# See the adjustable code of lssr. However, there is still a
# problem of a fixed number of columns to be displayed across
# the screen. What should be done in this case - wrap the line?
# break the table up into pages?
# Compute column widths
# Remember the first column is row header information
for ($col = 1; $col<$col_count; $col++) {
for ($row = 0; $row<$row_count; $row++) {
$new_size = length($columns->[$row][$col]);
if ( $new_size >= CT_CLI_MAX_COL_WIDTH) {
$size = CT_CLI_MAX_COL_WIDTH;
last;
}
if ($size < $new_size) { $size = $new_size; }
}
$column_size[$col] = $size;
$size = 0;
$new_size = 0;
}
if ($no_header == 0) {
# Print headers
if (defined($columns->[0][0]) && $columns->[0][0] ne "") {
print "$columns->[0][0]\n";
}
for ($col = 1; $col<$col_count; $col++) {
$temp = $columns->[0][$col];
if (length($temp) > CT_CLI_MAX_COL_WIDTH) {
$temp = substr($temp, 0, CT_CLI_MAX_COL_WIDTH -1);
}
printf "%-${column_size[$col]}.${column_size[$col]}s ", $temp;
}
print "\n";
}
# Header has already been printed at this point so don't print
# row 0 again.
# If no header was requested, then continue to print
# from the first row anyway.
$start_row = 1;
$col = 1;
# Print out body of data
for ($row=$start_row; $row<$row_count; $row++ ) {
for ($col=1; $col<$col_count; $col++) {
# Check to see if the value is defined at all. if not,
# print a space of the column size (leave blank.)
if (defined($columns->[$row][$col])) {
$temp = $columns->[$row][$col];
if (length($temp) > CT_CLI_MAX_COL_WIDTH) {
# Truncate the value to be printed and add
# notation indicating data is truncated (...)
$temp = substr($temp, 0, CT_CLI_MAX_COL_WIDTH - 3);
$temp = $temp . "...";
}
printf "%-${column_size[$col]}.${column_size[$col]}s ",
$temp;
}
else { printf " " x (1 + $column_size[$col]); }
}
print "\n";
}
} # end column_display
#--------------------------------------------------------------------#
# long_display: #
# Print table data to STDOUT using long or file format. File format#
# is like long format, except the table metadata is not displayed, #
# and a keyword is placed at the top of the display, followed by #
# a double colon '::'. #
# See the CT_cli_input_utils.pm for a description of input file #
# format. #
# #
# Input Parameters: #
# $title - overall title for the display #
# $no_header - if == 1, then no headers are printed #
# if == 0, then headers are printed #
# $row_count - number of rows in the input array #
# $col_count - number of columns in the input array #
# $cols - AV reference to array to be printed #
# See prolog to this file for input array format. #
# #
# Output Parameters: #
# None #
# #
# Globals Altered: #
# None #
#--------------------------------------------------------------------#
sub long_display {
# Grab input parameters
my $no_header = shift;
my $row_count = shift;
my $col_count = shift;
my $format = shift;
my $cols = shift;
# Set up local variables
my $col;
my $start_row = 1;
my $row;
# The 0th row is not accounted for in the $row_count, so add
# one to simplify the for statements in this subroutine
$row_count++;
# This header only printed for file output format
if ($format eq "file") {
if (defined($cols->[0][0]) && $cols->[0][0] ne "") {
print "$cols->[0][0]::\n";
}
}
elsif (!$no_header && defined($cols->[0][0]) && $cols->[0][0] ne "") {
print "$cols->[0][0]\n";
}
# Calculate the spacing for the attributes on the left hand
# side of the display
my $size = 0;
for ($col=1; $col<$col_count; $col++) {
$new_size = length($cols->[0][$col]);
if ($size < $new_size) { $size = $new_size; }
}
# Print out body of data
$col = 0;
for ($row=$start_row; $row<$row_count; $row++ ) {
# Print the row header information
print "$cols->[$row][0]\n";
for ($col=1; $col<$col_count; $col++) {
if (defined($cols->[$row][$col])) {
printf "\t%-${size}.${size}s = %s\n", $cols->[0][$col],
$cols->[$row][$col];
}
} # end inner for loop
} # end outer for loop
} # end long_display
#--------------------------------------------------------------------#
# delim_display: #
# Write input array data to STDOUT using delimited format #
# See prolog to this file for input array format. #
# #
# Parameters: #
# $title - overall title for the display #
# $no_header - if == 1, then no headers are printed #
# $row_count - number of rows in the input array #
# $col_count - number of columns in the input array #
# $delim - delimiter string to use for output #
# $columns - AV reference to array to be printed #
# See prolog to this file for input array format. #
# #
# Globals Altered: #
# None #
#--------------------------------------------------------------------#
sub delim_display {
# Gather input parameters
my $no_header = shift;
my $row_count = shift;
my $col_count = shift;
my $delim = shift;
my $columns = shift;
# Set up local variables
my $header_string = "";
my $row_ind = 0;
my $col_ind = 0;
# The 0th row is not accounted for in the $row_count, so add
# one to simplify the for statements in this subroutine
$row_count++;
# Print out delimited header
if ($no_header == 0) {
if (defined $columns->[0][0] && $columns->[0][0] ne "") {
print $columns->[0][0];
}
for ($col_ind = 1; $col_ind < $col_count; $col_ind++) {
print "$columns->[0][$col_ind]$delim";
}
print "\n"; # no space between header and data
}
# Print out body of data
for ($row_ind = 1; $row_ind < $row_count; $row_ind++ ){
for ($col_ind = 1; $col_ind<$col_count; $col_ind++) {
printf "%s%s", $columns->[$row_ind][$col_ind], $delim;
}
print "\n"; # end of row is and eol
}
} # end delim_display
#--------------------------------------------------------------------#
# End Exported Subroutines (with @EXPORT_OK, -> on demand). #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# End File #
#--------------------------------------------------------------------#