# IBM_PROLOG_BEGIN_TAG # This is an automatically generated prolog. # # # # Licensed Materials - Property of IBM # # (C) COPYRIGHT International Business Machines Corp. 2000,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_display_utils; # sccsid = "@(#)56 1.40 src/rsct/cli/pm/CT_cli_display_utils.pm.perl, ctcli, rsct_rady, rady2035a 11/12/15 16:42:07" ###################################################################### # # # Package: CT_cli_display_utils.pm # # # # Description: # # This package contains common subroutines for the Perl Cluster # # Command Line Interface. This package does not use perl # # extensions and is no longer fully functional. This version is no # # used by rmc/sr commands. # # # # 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: Remove perl extension references. No longer # # used by rmc/sr commands. # # 040406 JAC 105973: Add mblen_substr for column_display. # # 040408 JAC 105863: Call escape_chars for \". # ###################################################################### 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; ###87393use CT::CT qw(:ct_data_type_t); use CT_cli_utils qw( printCEMsg ); ###87393use CT_cli_data_type_utils qw( ###87393 data_type_is_simple ###87393 data_type_is_array ###87393); use CT_cli_rc qw(:return_codes); # such as MC_CLI_USER_ERROR use CT_cli_input_utils qw( escape_chars ); #--------------------------------------------------------------------# # 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_display_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; $temp_str = escape_chars($temp_str); } 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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_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_display_utils::column_display\n"; column_display($no_header, $row_count, $col_count, $data_to_print); $main::Trace5 && print STDERR "Exiting CT_cli_display_utils::column_display\n"; } elsif ($display_type eq "long") { $main::Trace5 && print STDERR "Entering CT_cli_display_utils::long_display(\"long\")\n"; long_display($no_header, $row_count, $col_count, "long", $data_to_print); $main::Trace5 && print STDERR "Exiting CT_cli_display_utils::column_display\n"; } elsif ($display_type eq "file") { $main::Trace5 && print STDERR "Entering CT_cli_display_utils::long_display(\"file\")\n"; long_display($no_header, $row_count, $col_count, "file", $data_to_print); $main::Trace5 && print STDERR "Exiting CT_cli_display_utils::column_display\n"; } elsif ($display_type eq "delim") { $main::Trace5 && print STDERR "Entering CT_cli_display_utils::delim_display\n"; delim_display($no_header, $row_count, $col_count, $delimiter, $data_to_print); $main::Trace5 && print STDERR "Exiting CT_cli_display_utils::delim_display\n"; } else { printCEMsg("EMsgCTcliInvalidDisplayType", $display_type); $local_rc = CT_CLI_USER_ERROR; } $main::Trace5 && print STDERR "Leaving CT_cli_display_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 = &mblen_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). # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # mblen_substr: # # This is a crack at rewriting the substr builtin so that it pays # # attention to multibyte characters. # # # # Input Parameters: # # $string_in the string to be acted upon # # $start where to start from # # $length how many "characters" to take # # # # Output Parameters: # # $string_out result # # # # Globals Altered: # # None # #--------------------------------------------------------------------# sub mblen_substr { use POSIX; use POSIX qw(:stdlib_h); use POSIX qw(mblen); # Gather input parameters my ($string_in, $start, $strlen) = @_; my $string_out = ""; my $string_in2 = ""; my $lenchar = 0; for (my $i=0; $i<$strlen; $i+=$lenchar) { # form the string of where we're at $string_in2 = substr($string_in,$i+$start); # determine if this is a multibyte encoding (mblen>1) $lenchar = mblen ($string_in2, MB_CUR_MAX); # if it's length is less than 1, treat it as 1 character if (!$lenchar >= 1) { $lenchar = 1;} # take the appropriate number of characters $string_out .= substr($string_in2,0,$lenchar); } return ($string_out); } # end mblen_substr #--------------------------------------------------------------------# # End File # #--------------------------------------------------------------------#