# 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_input_utils; # sccsid = "@(#)51 1.61.1.4 src/rsct/cli/pm/CT_cli_input_utils.pm.perl, ctcli, rsct_rady, rady2035a 1/18/19 16:58:54" ###################################################################### # # # Package: CT_cli_input_utils.pm # # # # Description: # # This package contains utility/common subroutines for PERL # # Cluster Utility CLI commands that reads in data from input files # # and command lines. Also has basic tools for parsing the data # # so it can be converted from input strings into a format suitable # # for passing to an extension/C API. # # # # # # Subroutines Available: # # convert_input_value - takes value from cmdline or file input # # and converts it to a Perl structure/scalar suitable for use # # with the CT and related component extensions. # # # # hex2bin - converts hexadecimal input into packed binary. Use # # with CT_BINARY_PTR data types to convert input (automatically# # used by the previously described subroutine.) # # # # string_to_value - converts an input value to one of the 'simple' # # (ie non-array) types from ct_data_type_t. # # Used by convert_input_value (use that subroutine ideally.) # # # # string_to_array - converts an input value to one of the array # # types from ct_data_type_t. Used by convert_input_value # # (use that subroutine ideally.) # # # # string_to_str_array - converts an input scalar to an array of # # strings. Will support strings containing commas and white # # space. Used by convert_input_value (use that subroutine # # ideally.) # # # # trim_hex_value - trims off any leading '0x' values from # # hexadecimal input and returns the stripped string. # # # # string_to_rsrc_handle - # # Takes a resource handle formatted # # "0x#### 0x#### 0x######## 0x######## 0x######## 0x########" # # # # where: # # # = any hexadecimal digit # # # # The string is split up into a 6-element array, regardless of # # the number of hexadecimal numbers in the string. More than 6 # # are ignored, less than 6 means the array is buffered with # # 00000000. See subroutine header for more details # # # # string_to_binary_hash - # # Takes a hexadecimal input, formatted like a resource handle # # or not: # # "0x######## 0x######## 0x######## 0x######## ..." -OR- # # "0x################" # # # # where: # # # = any hexadecimal digit # # # # the '0x' values are stripped out of the strings, and # # typechecking is done to make sure each number is a valid # # hexadecimal value. The value is then packed as binary, and # # this image and the length of the packed binary is return in # # a hash: %binary_hv = {"length" => $packed_length, # # "image" => $packed_binary_image ); # # # # string_to_sd - converts an input scalar to a Perl SD structure - # # an array of hashes that are each data elements. An input # # array of data types is required as input to this subroutine # # so it can be used to convert individual SD entries. # # Format of the output structure: # # @output_sd = (\{"type"=>,"value"=>}, # # ...); # # # # string_to_sd_array - converts a string representing an array of # # SDs to an array of Perl SD structures (see string_to_sd # # description above for format of this structure.) Requires # # an array of references to arrays of data types, where each # # array is the definition for one of the SDs. This array is # # expected to be in the same order as the array of SDs. # # # # Notes on entering SDs on the command line: # # - SD definitions must be contained in double quotation marks # # unless the SD contains a double quoted string, in which case # # single quotation marks should be placed around the SD. # # - See in the examples section for format of the SD definition# # arrays to be passed into these subroutines. # # # # parse_complex_input: # # does a basic syntax check on all strings containing {}[]"'. # # # # parse_nested_input: # # gets an entire line of data (up to the next control value # # or 'valid' line of data) then calls parse_complex_input # # to attempt to parse the line. # # # # check_input_file: # # tries to open an input file and returns an error if it fails # # to do so. # # # # get_next_line_from_input: # # subroutine called from parse_input_file to pass out the next # # usable line of data from the file - skipping comments, blank # # lines, and lines with specific expected structures. # # Not exported. # # # # escape_chars: # # scans through a string respecting mulitbyte encoding to # # escape backslashes (\) and double quotes ("). # # # # unescape_chars: # # scans through a string respecting mulitbyte encoding to # # change escaped double quote (\") to double quote ("). # # # # The remaining subroutines (process_cmdline_input and # # process_input_file) create and return references to arrays # # of the form: # # # #\@data = ([$row_header,[@row_data]], [$row_header,[@row_data]],...) # # where # # $row_header = string description of row header # # ie "ResourceVariableClass" or "Column 1:" # # @row_data = ([$attribute,\$value],[$attribute,\$value], ...) # # $attribute = string (see RMC/SR documentation for limitations# # on characters - alphanumeric and underscore # # only.) # # \$value = SV* to the value associated with $attribute - can # # be any valid ct_value_type, including an array # # (NOTE: SD and SBS not # # supported at this time - 27/01/00) # # # # See 'Input for subroutines' below for expected input to # # each subroutine. # # # # Example of how best to access the array structure: # # # # foreach $entry (@$data) { # # $row_header = $entry->[0]; # # foreach $element (@{$entry->[1]}) { # # $attribute = $element->[0]; # # $value = $element->[1]; # # } # # } # # # # # # Input for the subroutines is as follows: # # # # process_cmdline_input - # # using command line input structured (passing \@ARGV to the # # subroutine is the best method. It could be any array of data,# # for that matter): # # attribute_name=value ... ^^ attribute_name=value ... # # # # Reserved characters must be enclosed in double quotation # # marks if they will be part of a value: # # () ^^ # # # # where: # # ^^ is the end of row marker # # (NOTE: At this point, using ';' as an end of row marker # # would require using \; on the command line, which is 2 # # characters. I'm leaving this in to prompt a discussion on # # what else could be used for an end of row data marker for # # the cmdline.)-TODO # # # # attribute_name - a string value # # value - a simple value, a string (strings with spaces must # # be enclosed in double quotation marks, or an array of the # # following form: # # \(value,value,value,value\) # # (The backslashes are necessary on the command line # # for the braces to be taken literally.) # # # # Since there is no row header information given in this # # format the $row_header slot is filled with a default line # # (TODO - at this present time! This could change to # # utilise the format header attribute=value attribute=value ; # # header attribute=value ... An assumption is being made here # # about the order of the data coming in, but there has to be # # an assumption made somewhere!) # # # # Example input: # # key=32 array={2,3,4,5} sd="[1,2,{34,45}]" ^^ key=44 # # string="a long string with spaces" ^^ key=45 # # rsrc_handle="0xaaaa 0xbbbb 0xcccccccc 0xdddddddd ..." # # sd_array='{[1,2],[{string1,"string two"},34]}' # # # # Note: # # # # process_input_file - # # using input files structured: # # target_name:: # # item: # # attribute_name = value # # attribute_name = value # # ... # # item: # # ... # # target_name_2:: # # ... # # # # Reserved characters must be enclosed in double quotation # # marks if they will be part of a value: # # : :: # # # # where: # # target_name:: - initial value to scan for beginning of # # data to be read in. Data is read in until # # the next target_name:: line (a line that ends # # in ::) - See Reserved characters above for how # # to handle :: within a value. # # attribute_name - a string value, alphanumeric or underscore # # only (see RMC/SR Specs for more detail.) # # value can be: # # - a value with no whitespace # # - a string value containing whitespace and/or \n (eol) # # provided it is enclosed in double quotation marks. # # - an array of values described above. # # # # Please note that this routine does no typechecking to see # # what the nature of the data is that is passed in, beyond # # recognizing arrays and strings that go on for more than one # # line. (ex - VarietyRange=1,1 is allowed in the exmaple # # below.) # # # # # # Example input file: # # # #DynamicData:: # #DynamicClassAttribute: # # Name="ResourceDefined" # # VariableType=Quantum # # DataType=None # # VarietyRange=1,1 # # DataArray={1,2,3,4,5} # # # Here is a comment # # Description=3 # # DisplayName=4 # # GroupID=0 # # Properties=Public # # GroupName=5 # # # ## Here is a comment # #DynamicClassAttribute: # # Name="ResourceUndefined # # another name # # and another" # # Id=1 # # VariableType=Quantum # # DataType=None # # VarietyRange=1,1 # # Description=6 # # DisplayName=7 # # GroupID=0 # # ResourceHandle="0xaaaa 0xbbbb 0xcccccccc 0xdddddddd 0xeeeeeeee # # 0xffffffff" # #:: # # # # NOTE: the final :: in this file could be any line that ends in :: # # # # Examples: # # Some examples of expected input values are supplied below. # # These examples are confined to subroutines that are EXPORTed # # from this module. # # # # ($rc, $value) = convert_input_value($data_type, $data_value, # # sd_definition_array); # # where: # # $data_type = CT_INT32_ARRAY # # $data_value = "{1,23,45,64,999}" # # $sd_definition_array = undef, because $data_type is not # # CT_SD_PTR or CT_SD_PTR_ARRAY. # # # # or where: # # $data_type = CT_SD_PTR # # $data_value = '["string value",1,{130}]' # # $sd_definition_array = [CT_CHAR_PTR, CT_INT32, # # CT_INT32_ARRAY] # # # # ($rc, $value) = string_to_value($data_type, $data_value, # # $sd_definition_array); # # # # ($rc, $array_ref) = string_to_array($data_type, $data_value, # # $sd_definition_array); # # # # ($rc, @string_array) = # # string_to_str_array($data_value); # # where: # # $data_value = '{string1,"string two",stringThree}' # # # # # # ($rc, $hv_ref) = # # string_to_binary_hash($value); # # # # ($length, $packed_binary) = hex2bin($hex_value); # # # # ($rc, $rsrc_handle_array) = # # string_to_rsrc_handle($handle_string); # # # # # # ($rc, $sd) = string_to_sd($sd_string, \@sd_definition); # # where: # # $sd_string = '["string value",1,{130}]' # # \@sd_definition = (CT_CHAR_PTR, CT_INT32, CT_INT32_ARRAY) # # # # ($rc, $sd_array) = string_to_sd_array($sd_string, # # \@array_of_sd_definitions) # # where: # # $sd_string = '{[1,2,fred,{130}],[10,20,barney,{330}]}" # # \@sd_definitions = (CT_INT32, CT_UINT32, CT_CHAR_PTR, # # CT_INT32_ARRAY) # # # # # # ($rc, $trimmed_value) = trim_hex_values($value); # # # # ($rc, $data) = process_input_file($filename, $target_name, # # $optional); # # where: # # $optional is 1 - if the $target_name is not required to # # be in the input file. # # # # ($rc, $data) = process_input_file($filename, $target_name); # # # # ($rc, $cmdline_data) = process_cmdline_input(\@ARGV); # # # #--------------------------------------------------------------------# # Inputs: # # # # Outputs: # # stderr - all error messages # # stdout - Verbose messages (for debugging) # # # # External References: # # Perl Modules: FileHandle, Carp # # CT cli Modules: CT_cli_utils: printCEMsg, :return_codes, # # 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: Initial delivery. # # 001107 67131 GTM: Made internal msg dependent on trace state # # 001219 69956 GTM: parse_complex_input - fixed handling of # # single quoted arrays; fixed curly brackets{} # # processing # # 010102 69731 GTM: fix corruption of strings containing quotes # # 010119 68752 SAB: rsrc handle format change to # # 0x0000 0x0000 0x00000000 0x00000000 ... # # 010615 72970 JAC: add/remove some quoting # # 010622 75144 JAC: fix string_to_array error from 72970 # # 020115 78199 JAC: Allow for empty stanzas in argument definitions# # so not all resources have to have args. # # 030115 84694 JAC: Change process_cmdline_input processing of # # repeated attribute specifications # # 040406 105863 JAC: Add escape_chars and unescape_chars functions.# # 040409 106478 MR : In parse_complex_input use substr and mblen to# # process the string. # # 050915 108692 JAC: Modify parse_complex_input for escaping the # # the escape character. # # 050919 127193 JAC: Allow []{} in strings (partially). # ###################################################################### use Exporter (); @ISA = qw(Exporter); @EXPORT_OK = qw(trim_hex_value process_input_file process_cmdline_input convert_input_value string_to_value string_to_array string_to_str_array string_to_binary_hash string_to_rsrc_handle string_to_sd string_to_sd_array strip_quotes hex2bin escape_chars unescape_chars check_input_file ); #--------------------------------------------------------------------# # Included libraries and extensions # #--------------------------------------------------------------------# use lib "/opt/rsct/pm"; use locale; use FileHandle; ####use CT::CT qw(:ct_data_type_t); use CT_cli_rc qw(:return_codes); use CT_cli_utils qw(printCEMsg); ####use CT_cli_data_type_utils qw( #### data_type_is_simple #### data_type_is_array #### string_to_data_type ####); #--------------------------------------------------------------------# # convert_input_value: # # Takes a scalar value and converts it into a format suited for # # passing to the CT (or SR or RMC...) extensions. # # Calls string_to_array or string_to_value as appropriate based on # # the data type passed in. # # # # Parameters: # # $data_type - type of the data to be converted. # # $input_scalar - data value (scalar) to be converted. # # $sd_definitions - reference to an array of SD definitions. Used # # only if $data_type is an SD_PTR or # # SD_PTR_ARRAY. # # # # Returns: # # $local_rc - 0 if ok, non-zero otherwise. # # $output_value - converted data value - could be an HV or AV ref, # # or a 'normal' value (int, float, etc...) # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub convert_input_value { my $data_type = shift; my $input_scalar = shift; # This could be either a single SD definition, # or an array of definitions, and is only used for SD_PTR or # SD_PTR_ARRAY my $sd_definitions = shift; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::convert_input_value($data_type, $input_scalar)\n"; my $local_rc = 0; my $output_value = 0; if ( data_type_is_simple($data_type) ){ ($local_rc, $output_value) = string_to_value($data_type, $input_scalar, $sd_definitions); } elsif ( data_type_is_array($data_type) ) { ($local_rc, $output_value) = string_to_array($data_type, $input_scalar, $sd_definitions); } else { if (!defined($data_type)) {$data_type = "";} printCEMsg("EMsgCTcliInvalidDataType", '"'.$data_type.'"'); return CT_CLI_USER_ERROR; } $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::convert_input_value($output_value)\n"; return ($local_rc, $output_value); } # end convert_input_value #--------------------------------------------------------------------# # strip_quotes: # # Small sub to strip off the outmost pair of quotes off the scalar # # passed in. # # # # Parameters: # # $in_str - input string to be scanned for quotes. # # # # Returns: # # $in_str - the input string with the quotes removed. # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub strip_quotes { my $in_str = shift; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::strip_quotes($in_str)\n"; # If: # the string has spaces or escape sequences AND # the string has a single or double quote at the beginning AND # the string has a single or double quote at the end # then # strip off the outermost quotation marks if (($in_str =~ /[ ]/) && ($in_str =~ /^['"]/) && ($in_str =~ /['"]\s*$/)) { $in_str =~ s/^['"]//; $in_str =~ s/['"]\s*$//; } $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::strip_quotes($in_str)\n"; print "$in_str \n"; return $in_str; } # end strip_quotes #--------------------------------------------------------------------# # string_to_str_array: # # Takes a scalar and converts it to an array of strings. # # Parsing is simple at this time - strings with spaces, commas are # # allowed. # # # # Parameters: # # $in_scalar - scalar value to be converted to the string array. # # # # Returns: # # @output_array - array of strings. # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub string_to_str_array { # Note: take from Camel Book, p 31. my $string = shift; use Text::ParseWords; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_str_array($string)\n"; my @output_array = parse_line(",", 1, $string); return @output_array; } # end string_to_str_array #--------------------------------------------------------------------# # string_to_array: # # Takes a scalar and converts it to one of the array # # ct_data_type_t types. # # # # Parameters: # # $data_type - type of scalar to be converted. # # $in_scalar - scalar to be converted. # # $sd_definition_array - array of SD definitions, only used if # # $data_type is a CT_SD_PTR_ARRAY. # # # # Returns: # # $local_rc - 0 if success, nonzero otherwise. # # \@output_array - array from converted scalar input. # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub string_to_array { my ($data_type, $in_scalar, $sd_definition_array) = @_; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_array($data_type)\n"; my $local_rc = 0; my $work_scalar; my @work_array = (); my @output_array = (); my @output_array2 = (); # 72970 my $ind = 0; my $split_up = 1; my $new_entry = ""; # 72970 my $strlen = 0; # 72970 # Check to see if an array or single string was passed in if (($in_scalar =~ /^{/) && ($in_scalar =~ /}$/)) { # Strip off the outer braces: $in_scalar =~ s/\s*$//; $work_scalar = substr($in_scalar, 1, length($in_scalar) - 2); } else { $split_up = 0; } SWITCH: { # Convert the value according to it's type if ($data_type == CT_RSRC_HANDLE_PTR_ARRAY) { # Can split on the comma still, then pass the if ($split_up == 1) { @work_array = split /\s*,\s*/, $work_scalar; } else { # Values are coming in array format already @work_array = @$in_scalar; } $ind = 0; foreach $entry (@work_array) { ($local_rc, $output_array[$ind++]) = string_to_rsrc_handle($entry); # Return immediately if there was an error # Error messages handled in string_to_rsrc_handle if ($local_rc != 0) { return $local_rc; } } last SWITCH; } if ($data_type == CT_BINARY_PTR_ARRAY) { if ($split_up == 1) { @work_array = split /\s*,\s*/, $work_scalar; } else { # Values are coming in array format already @work_array = @$in_scalar; } foreach $entry (@work_array) { ($local_rc, $output_array[$ind++]) = string_to_binary_hash($entry); # Return immediately if there was an error if ($local_rc != 0) { return $local_rc; } } last SWITCH; } if ($data_type == CT_CHAR_PTR_ARRAY) { # @output_array = string_to_str_array($work_scalar); if ($split_up == 1) { # @output_array = parse_line(",", 1, $work_scalar); @output_array2 = parse_line(",", 1, $work_scalar); # 72970 foreach $entry (@output_array2) { # 72970 $strlen = length $entry; # 72970 # remove leading/trailing double quotes # 72970 if (($entry =~ /^\"/) && ($entry =~ /\"$/)) { # 72970 $new_entry = substr($entry,1,$strlen-2); # 72970 push (@output_array, $new_entry); # 72970 } # 72970 else { # 72970 push (@output_array, $entry); # 75144 } # 72970 } # end foreach # 72970 } else { @output_array = @$in_scalar; } last SWITCH; } if ($data_type == CT_SD_PTR_ARRAY) { # This will never come in as an array. ($local_rc, @output_array) = string_to_sd_array( $work_scalar, $sd_definition_array); last SWITCH; } # if ($data_type == CT_SBS_PTR_ARRAY) { # $local_rc = CT_CLI_ERROR; # $main::Trace5 && print "$main::PROGNAME: CT_SBS_PTR_ARRAY not supported by the CLI\n"; # last SWITCH; # } # Default - this will work for any type that doesn't # contain nested braces, brackets or double quotation marks # For int, uint, float 32/64 types. if ($split_up == 1) { @output_array = split /\s*,\s*/, $work_scalar; } else { if (scalar(@$in_scalar) > 0) { # Values are coming in array format already @output_array = @$in_scalar; } else { # Have single entry array @output_array = $in_scalar; } } my $ind = 0; # Check the UINT status if (($data_type == CT_UINT32_ARRAY) || ($data_type == CT_UINT64_ARRAY) ){ for ($ind = 0; $ind < (scalar(@output_array)); $ind++) { if ($output_array[$ind] < 0) { printCEMsg("EMsgCTcliInvalidUnsignedNum", $output_array[$ind]); return CT_CLI_USER_ERROR; } } } } $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_array($local_rc)\n"; # Return only the $local_rc if it's set to something other than 0. ($local_rc == 0) ? return ($local_rc, \@output_array): return ($local_rc); } # end string_to_array #--------------------------------------------------------------------# # string_to_value: # # Takes a scalar and converts it to one of the simple # # ct_data_type_t types. # # # # Parameters: # # $data_type - type of scalar to be converted. # # $in_scalar - scalar to be converted. # # $sd_definition - array of SD definitions, only used if # # $data_type is a CT_SD_PTR. # # # # Returns: # # $local_rc - 0 if success, nonzero otherwise. # # $output_value - converted scalar or reference to converted value.# # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub string_to_value { my ($data_type, $in_scalar, $sd_definition) = @_; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_value($data_type, $in_scalar)\n"; my $local_rc = 0; my $output_value; my $strlen = 0; # 72970 SWITCH: { # Convert the value according to it's type if ($data_type == CT_RSRC_HANDLE_PTR) { ($local_rc, $output_value) = string_to_rsrc_handle($in_scalar); last SWITCH; } if ($data_type == CT_BINARY_PTR) { ($local_rc, $output_value) = string_to_binary_hash($in_scalar); last SWITCH; } if ( (($data_type == CT_INT64) or ($data_type == CT_UINT64)) and ($in_scalar !~ /^-*\d+$/) ) { $local_rc = CT_CLI_USER_ERROR; printCEMsg("EMsgCTcliInvalid64BitNum", $in_scalar); last SWITCH; } if ( (($data_type == CT_UINT32) or ($data_type == CT_UINT64)) and ($in_scalar < 0) ) { printCEMsg("EMsgCTcliInvalidUnsignedNum", $in_scalar); $local_rc = CT_CLI_USER_ERROR; last SWITCH; } if ($data_type == CT_SD_PTR) { ($local_rc, $output_value) = string_to_sd($in_scalar, $sd_definition); last SWITCH; } if ($data_type == CT_SBS_PTR) { $local_rc = CT_CLI_ERROR; # TODO: This message may be removed if the data type ever is $main::Trace5 && print "$main::PROGNAME: CT_SBS_PTR not supported by the CLI\n"; last SWITCH; } if ($data_type == CT_NONE) { printCEMsg("EMsgCTcliInvalidDataType", "CT_NONE"); return CT_CLI_USER_ERROR; } if ($data_type == CT_UNKNOWN) { printCEMsg("EMsgCTcliInvalidDataType", "CT_UNKNOWN"); return CT_CLI_USER_ERROR; } # Default - return the basic value with no conversion; # $output_value = $in_scalar; # removed by 72970 $strlen = length $in_scalar; # 72970 # remove leading/trailing double quotes # 72970 if (($in_scalar =~ /^\"/) && ($in_scalar =~ /\"$/)) { # 72970 $output_value = substr($in_scalar,1,$strlen-2); # 72970 } # 72970 else { # 72970 $output_value = $in_scalar; # 72970 } # 72970 } $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_value($local_rc, $output_value)\n"; # Return only the $local_rc if it's set to something other than 0. ($local_rc == 0) ? return ($local_rc, $output_value): return ($local_rc); } # end string_to_value #--------------------------------------------------------------------# # string_to_binary_hash: # # Takes a string of binary data, packs it and puts it into a hash # # containing the length of the packed data and the image of the # # data. # # # # Grouped entries will be lumped into a single string for packing # # # # Calls trim_hex_value to verify that leading '0x's are removed, # # and that the values are valid hexadecimals. # # # # Parameters: # # $binary_str binary data to be put into the output hash. # # # # Returns: # # $local_rc - 0 if success, nonzero otherwise. # # \%binary_hv - 2-element hash: "length" and "image" # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub string_to_binary_hash { my ($binary_str) = @_; # Set up local variables my $packed_len; my $binary_image; my %binary_hv = (); $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_binary_hash\n"; # Trim off leading '0x's and check for valid hex values ($local_rc, $binary_str) = trim_hex_value($binary_str); if ($local_rc == 0) { ($packed_len, $binary_image) = hex2bin($binary_str); %binary_hv = ("length" => $packed_len, "image" => $binary_image ); $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_binary_hash\n"; return ($local_rc, \%binary_hv); } else { $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_binary_hash\n"; return $local_rc; } } # end string_to_binary_hash #--------------------------------------------------------------------# # string_to_rhandle: # # Given an input string of up to 6 hexadecimal values, splits the # # string up and returns a 6-entry array. Any more than 6 entries # # are ignored. Less than five means that the remaining array # # entries are buffered with "00000000". # # # # Individual hex entries that are shorter than the required number # # digits for that position are buffered to the left by '00' to the # # left by '00.' Longer than 8 digits are considered an error. # # # # Calls trim_hex_value to verify that leading '0x's are removed, # # and that the values are valid hexadecimals. # # # # Parameters: # # $handle resource handle to be put to an array # # # # Returns: # # $local_rc 0 if success, 1 if invalid hex value. # # \@output_array 6-element resource handle array. # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub string_to_rsrc_handle { my ($handle) = @_; # Set up local variables my @output_array = (); my $local_rc = 0; my $value = ""; my $entry =""; my $i = 0; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_rsrc_handle($handle)\n"; # If the input parameter is undefined, then exit immediately if (!defined($handle)) { printCEMsg("EMsgCTcliInvalidRsrcHndl"); $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_rsrc_handle\n"; return CT_CLI_USER_ERROR; } if ($handle =~ / /) { @output_array = split / /, $handle; } else { @output_array = $handle; } if (scalar(@output_array) <= 6) { for ($i=scalar(@output_array); $i<6; $i++) { $output_array[$i] = 0; } } else { printCEMsg("EMsgCTcliInvalidRsrcHndl"); $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_rsrc_handle\n"; return CT_CLI_USER_ERROR; } $i=0; foreach $entry (@output_array) { # Trim and check the string contains only hexadecimal values ($local_rc, $entry) = trim_hex_value($entry); ($local_rc == 0) || last; if (($i == 0 || $i == 1) && (length($entry) > 4)) { printCEMsg("EMsgCTcliInvalidRsrcHndl"); $local_rc = CT_CLI_USER_ERROR; last; } elsif (length($entry) > 8) { printCEMsg("EMsgCTcliInvalidRsrcHndl"); $local_rc = CT_CLI_USER_ERROR; last; } $output_array[$i] = hex $output_array[$i]; $i++; } $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_rsrc_handle\n"; # Return the array if there were no errors ($local_rc != 0) ? return $local_rc : return ($local_rc, \@output_array); } # end string_to_rhandle #--------------------------------------------------------------------# # string_to_sd: # # Takes an input SD (minus the outer []) in the form of a string # # and another comma-delimited list of the data types of each SD # # entry, converts the values in the string to the appropriate # # Perl data types via convert_input_value, then creates an array # # of hashes containing the SD elements. # # # # The $sd_defn value is currently expected to contain the enum # # value from ct_data_type_t. Use CT_cli_utils::string_to_data_type # # to convert the values before passing them in to this sub. # # # # Each SD entry looks like: # # %sd_entry = {"type"=>data type, "value"=>data value}; # # # # Parameters: # # $input_sd - string containing the SD to be converted. # # $sd_defn - reference to an array of SD data types. # # # # Returns: # # $local_rc - 0 if success, nonzero otherwise. # # \@sd_output - SD data converted from the input string. # # # # Global Variables: # # $main::Trace5 - to print trace information if requested. # #--------------------------------------------------------------------# sub string_to_sd { my ($input_sd, $sd_defn) = @_; use Text::ParseWords; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_sd($input_sd, $sd_defn)\n"; # Set up local variables my @sd_output = (); my $temp_str = ""; my $local_rc = 0; my $ind = 0; my ($chr, $temp_string, $converted_value); $input_sd =~ s/^\s*\[//; $input_sd =~ s/\]\s*$//; # Check to see if there are any arrays in the SD. If not, # then use Text::ParseWords, parse_line if ($input_sd !~ /{.*}/) { # The '0' is to strip off outer quotation marks my @temp_array = parse_line(",", 1, $input_sd); foreach $token ( @temp_array) { ($local_rc, $converted_string) = convert_input_value($sd_defn->[$ind], $token); $sd_output[$ind++] = {"type"=>$sd_defn->[$ind], "value"=>$converted_string}; } } else { # Split out all the {} entries. # This and quotation marks are the only thing expected in an SD. # parse_line takes care of the quotation marks my $offset = 0; # The /s allows '.' to match a newline character my $temp = [$input_sd =~ /(.*?)(\{.*?})(.*)/s]; foreach $entry (@$temp) { if ($entry =~ /^{.*?}$/) { $offset++; next; } if ($entry =~ /{.*?}/) { my $entry_temp = [$entry =~ /(.*?)(\{.*?})(.*)/s]; my $temp_len = scalar(@$temp); splice(@$temp, $offset, $temp_len-$offset, @$entry_temp); $offset++; } else { $offset++; } } $ind = 0; foreach $entry (@$temp) { # Remove any leading or trailing ',' $entry =~ s/^,\s*//; $entry =~ s/,\s*$//; if ($entry eq "") { next; } if ($entry =~ /{.*?}/) { ($local_rc, $converted_value) = convert_input_value($sd_defn->[$ind], $entry); $sd_output[$ind++] = {"type"=>$sd_defn->[$ind], "value"=>$converted_value}; } else { # The '0' is to keep the outer quotation marks # Why? because if there are 2 sets (ie, one set is # supposed to be there,) then they should be kept my @temp_array = parse_line(",", 1, $entry); foreach $token ( @temp_array ) { # $token = strip_quotes($token); ($local_rc, $converted_value) = convert_input_value($sd_defn->[$ind], $token); $sd_output[$ind++] = {"type"=>$sd_defn->[$ind], "value"=>$converted_value}; } } } } # end if.. else return ($local_rc, \@sd_output); } # end string_to_sd #--------------------------------------------------------------------# # string_to_sd_array: # # Takes a string that represents an array of SDs, and translates # # it into the correct Perl structure. An array of sd definitions # # is also passed in - these are arrays of arrays of data types, # # corresponding to the data types in each entry of each SD. # # # # The $sd_def_array value is currently expected to contain the enum# # value from ct_data_type_t. Use CT_cli_utils::string_to_data_type # # to convert the values before passing them in to this sub. # # # # Parameters: # # $input_sd_array - string containing an array of SDs to be # # converted. # # $sd_def_array - reference to an array of SD definitions. # # # # Returns: # # $local_rc - 0 if success, nonzero otherwise. # # @output_sd_array - array of SDs converted from the input string. # # Note: an array is returned, not a reference. # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub string_to_sd_array { my ($input_sd_array, $sd_def_array) = @_; $main::Trace5 && print STDERR "Entered CT_cli_input_utils::string_to_sd_array($input_sd_array)\n"; # Set up local variables my @output_sd_array = (); my $index = 0; my $local_rc = 0; # Remove the outer [] from the string $input_sd_array =~ s/^\[//; $input_sd_array =~ s/\]$//; # Split up the input SD for parsing my @sd_array = split /\]\s*,\s*\[/, $input_sd_array; foreach $sd (@sd_array) { ($local_rc, $output_sd_array[$index]) = string_to_sd($sd, $sd_def_array); $index++; if ($local_rc != 0) {return $local_rc;} } $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::string_to_sd_array($local_rc)\n"; return($local_rc, @output_sd_array); } # end string_to_sd_array #--------------------------------------------------------------------# # trim_hex_value: # # Given an input string, trims off leading 0x values and # # typechecks to make sure the remaining value is hexadecimal. # # Returns the stripped, checked string if it's valid. # # # # Parameters: # # $value Value to be trimmed and checked. # # # # Returns: # # $local_rc 0 if success # # 1 if invalid hexadecimal value # # $value Original value passed in, minus leading 0x and # # verified as hexadecimal # # # # Global Variables: # # $main::Trace5 - to print trace information if requested # #--------------------------------------------------------------------# sub trim_hex_value { my ($value) = @_; # Initialise $local_rc my $local_rc = 0; # Strip off the leading 0x|oxs. For resource handles, it isn't # tolerated when the values are put into an array. For binary, it is # packed as hex and stored to the registry regardless of whether # it's binary, hex, or dec. $value =~ s/0x|ox//g; # Strip off any quotation marks - they should not be in a # hex value, so I'm assuming they are only at the beginning # and end. This line becomes significant for values read in # from an input file, or if it's an array type $value =~ s/"//g; # Check to see if is in a 'valid' hex format - only # a certain range or digits is allowed, with whitespaces # inbetween. if ($value !~ /^[ 0-9a-fA-F]+$/) { printCEMsg("EMsgCTcliInvalidHexadecimal", $value); $local_rc = CT_CLI_USER_ERROR; } return ($local_rc, $value); } # end trim_hex_value #--------------------------------------------------------------------# # hex2bin: # # Converts a string assumed to contain hex characters to a packed # # string using pack. Spaces in the string are removed. Length of # # the packed string is returned with the string. # # # # Paramaters: # # $input_string hexadecimal string to be converted # # # # Returns: # # $packed_length length of converted string # # $output_string converted string # # # # Global Variables: # # $main::Verbose Turns verbose mode on # #--------------------------------------------------------------------# sub hex2bin { my ($input_string) = @_; # There is probably a better way to to this, but this is the best # for now $main::Trace5 && print STDERR "Entered CT_cli_input_utils::hex2bin\n"; $input_string =~ s/ //g; # This will at least make the bit string an even number so the # pack/unpack sequence doesn't right pad as it appears to like # to if it is given an uneven number of bits if (length($input_string)%2) { $input_string = "0".$input_string; } $packed_length = length($input_string)/2; # Convert the string to binary format using pack # The '*' will chew up as many characters as can be found # up to a null. Since the input is a string (PV) this is # safe. To unpack this value, the number of characters # needs to be specified otherwise you risk getting garbage # on the end of the unpacked string. #$output_string = pack("H${input_length}", $input_string); $output_string = pack("H*", $input_string); $main::Trace5 && print STDERR "Leaving CT_cli_input_utils::hex2bin\n"; return ($packed_length, $output_string); } # end hex2bin #--------------------------------------------------------------------# # escape_chars: # # Scans a string respecting multibyte encodings to add escapes # # to backslashes (\) and double quotes ("). # # # # Paramaters: # # $string_in string to check for any needed escapes. # # # # Returns: # # $string_out result. # # # #--------------------------------------------------------------------# sub escape_chars { use POSIX; use POSIX qw(:stdlib_h); use POSIX qw(mblen); my $string_in = shift(@_); my $string_in2 = ""; my $string_out = ""; my $lenstring = 0; my $lenchar = 0; # escape any single character backslashes (\) $lenstring = length($string_in); # if there are none, skip over checking char-by-char if ($string_in =~ /.*\\.*/) { for (my $i=0; $i<$lenstring; $i+=$lenchar) { # form the string of where we're at $string_in2 = substr($string_in,$i); # 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;} # if it's not multibyte and it's a backslash, escape it if ( ($lenchar == 1) && ($string_in2 =~ /^\\/) ) { $string_out .= "\\\\"; } # otherwise, just take it as it is else {$string_out .= substr($string_in2,0,$lenchar);} } } # it doesn't have a backslash at all so take it as is else {$string_out = $string_in;} # going to put double quotes around the whole thing so # escape any inner quotes $string_out =~ s/\"/\\\"/g; return ($string_out); } # end escape_char #--------------------------------------------------------------------# # unescape_chars: # # Scans a string respecting multibyte encodings to change an # # escaped double quote (\") to a double quote ("). # # # # Paramaters: # # $string_in string to check for escaped double quotes. # # # # Returns: # # $string_out result. # # # #--------------------------------------------------------------------# sub unescape_chars { use POSIX; use POSIX qw(:stdlib_h); use POSIX qw(mblen); my $string_in = shift(@_); my $string_in2 = ""; my $string_out = ""; my $lenstring = 0; my $lenchar = 0; # escape any single character backslashes (\) $lenstring = length($string_in); # if there are none, skip over checking char-by-char if ($string_in =~ /.*\\.*/) { for (my $i=0; $i<$lenstring; $i+=$lenchar) { # form the string of where we're at $string_in2 = substr($string_in,$i); # 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;} # if it's not multibyte and it's a backslash, escape it if ( ($lenchar == 1) && ($string_in2 =~ /^\\\"/) ) { $string_out .= "\""; $lenchar++; } # otherwise, just take it as it is else {$string_out .= substr($string_in2,0,$lenchar);} } } # it doesn't have a backslash at all so take it as is else {$string_out = $string_in;} return ($string_out); } # end unescape_char #--------------------------------------------------------------------# # parse_complex_input: # # Given a string containing braces, brackets and quotation marks, # # This code parses out SDs and Arrays, reporting errors when the # # following rules are not followed: # # 1) Arrays can not contain arrays, unless those arrays are # # part of structured data. # # 2) Sturctured data can not contain structured data (SD). # # 3) Arrays and SDs must have matching, closing braces/brackets. # # 4) All data within single or double quotes is considered part # # of the quoted string. # # 5) Outermost quotation marks on strings are stripped off. # # 6) Escape characters are stripped out of strings after 5). # # 7) Braces and Brackets must be escaped within strings. # # # # Visually, only the following structures are allowed: # # array: {} # # sd: [] # # array of sd: {[],[]} # # sd containing array: [{},{}] # # array of sd contatining array: {[{}],[{}]} # # # # Quotations can appear within SDs and ARRAYs. They can contain # # whitespace, including tabs, spaces and newlines. # # valid quoted strings: bla (remains bla) # # "bla" (becomes bla) # # "\"bla\"" (becomes "bla") # # '"bla"' (becomes "bla") # # NOTE: This last case will be printed as '"bla"' on output. # # # # Paramaters: # # $input_line - line to be checked for matching braces/brackets. # # $file_handle - handle for input file. # # # # Returns: # # $local_rc - 0 if success, > 0 otherwise. # # $output_string - The string parsed up to the point of an error, # # or the entire string, with all spaces outside of # # quoted strings removed. # # # # Global Variables: # # $main::Trace5 Turns trace level 5 on. # #--------------------------------------------------------------------# sub parse_complex_input { use POSIX; use POSIX qw(:stdlib_h); use POSIX qw(mblen); my ($str) = @_; my $prev_char = ""; my $output_string = ""; my $in_string = ""; $main::Trace5 && print STDERR "Entered parse_complex_input($str)\n"; # If user gave us attr=value pairs via input file *and* enclosed # any array values in single quotes, then we have to strip those single # quotes off now to avoid processing problems downstream when this # value is converted from a string to an array. # Example: # If the input file contains the line: # RHArray = '{"0x11111111 0x22222222"}' # Then this sub is processing the value part, which is currently: # '{"0x11111111 0x22222222"}' # Before continuing its usual processing, this sub will change # the value part to be: # {"0x11111111 0x22222222"} if (($str =~ /^'\{/) && ($str =~ /}'$/)) { # 84620 # IF ARRAY $str =~ s/^'\{/{/; # pops off leading single quote from array value $str =~ s/}'$/}/; # pops off trailing single quote from array value } # Character by character processing my $lenstring = length($str); #my @temp_array = split //, $str; my $state = ""; my $local_rc = 0; #my $array_size = $#temp_array; #my $index = -1; my $index = 0; my $lenchar = 0; my $index_delta = 0; my $quote_index = 0; my $save_quote = 0; my $passthru = 0; my $escape = 0; #OUTER: foreach (@temp_array) { #OUTER: while ($index < $array_size) { OUTER: for ($index=0; $index<$lenstring; $index+=$lenchar){ #$index ++; # using substr extract each character based on its mblen # mblen returns the num of bytes in the character $instring = substr($str,$index); $lenchar = mblen($instring, MB_CUR_MAX); $_ = substr($str,$index,$lenchar); #$_ = $temp_array[$index]; SWITCH: { /\s/ && do { if (($state !~ /SQ$/) && ( $state !~ /DQ$/ )) { # This should remove whitespace outside of quotations, # so parsing can happen correctly later in the code $index_delta++; next OUTER; } }; /{/ && do { if ($state =~ /ARRAY$/) { printCEMsg("EMsgCTcliNestedArray", $str); return CT_CLI_USER_ERROR; } # These next lines assume that the array contained # is part of a string array. So the quotation marks # need to be added back in elsif ( ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) && ($passthru == 0) ) { $passthru = 1; if ($prev_char =~ /['"]/) { $output_string .= $prev_char; } elsif ($prev_char eq "\\") { $output_string = substr($output_string, 0, ($quote_index - $index_delta)); $index = $quote_index; if ($state =~ /:DQ$/) { $output_string .= '"'; } else { $output_string .= "'";} next OUTER; } ## This else deleted with defect 127193 #else { # printCEMsg("EMsgCTcliBraceInQuote"); # return CT_CLI_USER_ERROR; #} } # This elsif added with defect 127193 to allow {}[] in string elsif ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) { # it's ok. skip doing other stuff } elsif (($state =~ /SD$/) || ($state eq "")) { $state .= ":ARRAY"; } $prev_char = $_; $output_string .= $_; next OUTER; }; /}/ && do { if ($state eq ":ARRAY:SD") { printCEMsg("EMsgCTcliInvalidSD", $str); return CT_CLI_USER_ERROR; } # These next lines assume that the array contained # is part of a string array. So the quotation marks # need to be added back in elsif ( ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) && ($passthru == 0) ) { $passthru = 1; if ($prev_char =~ /['"]/) { $output_string .= $prev_char; $prev_char = $_; $output_string .= $_; next OUTER; } elsif ($prev_char eq "\\") { $output_string = substr($output_string, 0, ($quote_index - $index_delta)); $index = $quote_index; if ($state =~ /:DQ$/) { $output_string .= '"'; } else { $output_string .= "'";} next OUTER; } ## This else deleted with defect 127193 #else { # printCEMsg("EMsgCTcliBraceInQuote"); # return CT_CLI_USER_ERROR; #} } # This elsif added with defect 127193 to allow {}[] in string elsif ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) { # it's ok. skip doing other stuff } elsif (($state =~ /:SD$/) || ($state eq "")) { printCEMsg("EMsgCTcliNoOpenBrace", $str); return CT_CLI_USER_ERROR; } elsif ($prev_char eq ",") { printCEMsg("EMsgCTcliNoArrayEntry", $str); return CT_CLI_USER_ERROR; } elsif ($state =~ /ARRAY$/){ $state =~ s/:ARRAY$//; } $prev_char = $_; $output_string .= $_; next OUTER; }; /\[/ && do { if ($state =~ /SD/) { printCEMsg("EMsgCTcliSDinSD", $str); return CT_CLI_USER_ERROR; } # These next lines assume that the array contained # is part of a string array. So the quotation marks # need to be added back in elsif ( ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) && ($passthru == 0) ) { $passthru = 1; if ($prev_char =~ /['"]/) { $output_string .= $prev_char; } elsif ($prev_char eq "\\") { $output_string = substr($output_string, 0, ($quote_index - $index_delta)); $index = $quote_index ; if ($state =~ /:DQ$/) { $output_string .= '"'; } else { $output_string .= "'";} next OUTER; } ## This else deleted with defect 127193 #else { # printCEMsg("EMsgCTcliBraceInQuote"); # return CT_CLI_USER_ERROR; #} } # This elsif added with defect 127193 to allow {}[] in string elsif ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) { # it's ok. skip doing other stuff } elsif ($state =~ /ARRAY$/) { $state .= ":SD"; } elsif ($state eq "") { $state = ":SD"; } $prev_char = $_; $output_string .= $_; next OUTER; }; /\]/ && do { if ($state =~ /:SD:ARRAY$/) { printCEMsg("EMsgCTcliInvalidArray", $str); return CT_CLI_USER_ERROR; } elsif (($state =~ /ARRAY$/) || ($state eq "")) { printCEMsg("EMsgCTcliNoOpenBracket", $str); return CT_CLI_USER_ERROR; } # These next lines assume that the array contained # is part of a string array. So the quotation marks # need to be added back in elsif ( ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) && ($passthru == 0) ) { $passthru = 1; if ($prev_char =~ /['"]/) { $output_string .= $prev_char; $prev_char = $_; $output_string .= $_; next OUTER; } # From the input file, these values must be escaped for now. elsif ($prev_char eq "\\") { $output_string = substr($output_string, 0, ($quote_index - $index_delta)); $index = $quote_index; if ($state =~ /:DQ$/) { $output_string .= '"'; } else { $output_string .= "'";} next OUTER; } # Kept just in case braces/brackets are decided to be necessarily # escaped within quotation marks. ## This else deleted with defect 127193 #else { # printCEMsg("EMsgCTcliBraceInQuote"); # return CT_CLI_USER_ERROR; #} } # This elsif added with defect 127193 to allow {}[] in string elsif ( ($state =~ /:DQ$/) || ($state =~ /:SQ$/) ) { # it's ok. skip doing other stuff } elsif ($prev_char eq ",") { printCEMsg("EMsgCTcliNoSDEntry", $str); return CT_CLI_USER_ERROR; } elsif ($state =~ /SD$/) { $state =~ s/:SD$//; $quote_index = $index; } $prev_char = $_; $output_string .= $_; next OUTER; }; # Comma exception for inside of quotation marks /,/ && do { if ( (($state =~ /DQ$/) || ($state =~ /SQ$/)) && ($passthru == 0) ) { $passthru = 1; $output_string = substr($output_string, 0, ($quote_index - $index_delta)); $index = $quote_index; if ($state =~ /:DQ$/) { $output_string .= '"'; } else { $output_string .= "'";} next OUTER; } $prev_char = $_; $output_string .= $_; next OUTER; }; /"/ && do { if ($state =~ /DQ$/) { if ($prev_char ne "\\") { # This quote is stripped off the string $state =~ s/:DQ$//; # 72970 if ($passthru == 1) { $output_string .= '"'; } $output_string .= $_; # 72970 $passthru = 0; } else { # Remove the escape character, put the quote on chop $output_string; $escape = 0; $output_string .= $_; } } elsif (($state eq "") || ($state =~ /SD$/) || ($state =~ /ARRAY$/)) { $state .= ":DQ"; $quote_index = $index; $output_string .= $_; # 72970 } elsif ($state =~ /SQ$/) { $output_string .= $_; if ($prev_char eq "\\") { $escape = 0; } } $prev_char = $_; next OUTER; }; /'/ && do { if ($state =~ /SQ$/) { if ($prev_char ne "\\") { # This quote is stripped off the string $state =~ s/:SQ$//; if ($passthru == 1) { $output_string .= "'"; } $passthru = 0; } else { # remove the escape character, put the quote on chop $output_string; $output_string .= $_; } } elsif (($state eq "") || ($state =~ /SD$/) || ($state =~ /ARRAY$/)) { $state .= ":SQ"; $quote_index = $index; } elsif ($state =~ /DQ$/) { $output_string .= $_; } $prev_char = $_; next OUTER; }; # process escapes, look for escaping the escape character (\\) /\\/ && do { $prev_char = $_; $output_string .= $_; if ($escape) { $escape = 0; chop $output_string; } else { $escape = 1; } next OUTER; }; #default: $prev_char = $_; $output_string .= $_; }; # end SWITCH } # end OUTER # Check the final value of $state to see if anything is left # un-checked. if ( $state ne "") { # Strip off the trailing whitespace for printing $str =~ s/\s*$//; SWITCH : { ($state =~ /ARRAY$/) && do { printCEMsg("EMsgCTcliInvalidArray", "\"$str\""); }; ($state =~ /SD$/) && do { printCEMsg("EMsgCTcliInvalidSD", "\"$str\""); }; ($state =~ /(SQ|DQ)$/) && do { printCEMsg("EMsgCTcliInvalidQuote"); }; }; # end SWITCH $local_rc = CT_CLI_USER_ERROR; } $main::Trace5 && print STDERR "Leaving parse_complex_input($output_string)\n"; return ($local_rc, $output_string); } # end parse_complex_input #--------------------------------------------------------------------# # parse_nested_input: # # Using the given file_handle, concatenates lines until a control # # line is reached. Then calls parse_complex_input on the # # resulting string. # # # # Paramaters: # # $input_line - line to be checked for matching braces/brackets. # # $file_handle - handle for input file. # # # # Returns: # # $local_rc - 0 if success, > 0 otherwise. # # $temp_entry or $edited_string - If an error occured, the original# # concatenated string is passed back, otherwise # # a string is sent back with whitespace removed from all # # locations outside of quotation marks. This will sipmlify # # value conversion later in the code. # # $file_handle - modified file handle. # # $file_status- as passed back from get_next_line_from_input() # # $input_str - next line of input from the file, as passed back # # from get_next_line_from_input() # # # # Global Variables: # # $main::Trace5 Turns trace level 5 on. # #--------------------------------------------------------------------# sub parse_nested_input { my ($input_string, $file_handle) = @_; my $temp_entry = $input_string; my ($edited_string, $input_str); # Assume that the end of file may be reached my $file_status = "end"; my $local_rc = 0; my $got_string = 0; $main::Trace5 && print STDERR "Entered parse_nested_input\n"; while (!$file_handle->eof) { ($local_rc, $file_handle, $file_status, $input_str) = get_next_line_from_input($file_handle, 1); if ($file_status ne "OK") { last; } else {$temp_entry .= $input_str;} } # If the end of the file is reached, then try to parse # the string anyway, ($local_rc, $edited_string) = parse_complex_input($temp_entry); if (($file_status ne "end") && !(($file_status eq "OK") && ($file_handle->eof)) ) { $got_string = 1; } if ($local_rc != 0) { $main::Trace5 && print STDERR "Leaving parse_nested_input\n"; return (CT_CLI_USER_ERROR, $temp_entry, $file_handle, $got_string, $file_status, $input_str); } else { $main::Trace5 && print STDERR "Leaving parse_nested_input\n"; return (0, $edited_string, $file_handle, $got_string, $file_status, $input_str); } } # end parse_nested_input #--------------------------------------------------------------------# # get_next_line_from_input: # # Reads the given file handle, and does some simple checks to see # # where in the file the read is. Passes back strings indicating # # status of the read, plus the modified file handle, and the # # next line of usable input. # # # # NLS Note: p 188 Perl CookBook - All string comparisons using \w, # # and the related functions should be NLS compatible, as the # # locale settings are honored by the '\' function. # # # # Paramaters: # # $file_handle - handle for input file. # # $is_array - boolean indicating whether an array is being read # # in or not. # # # # Returns: # # $local_rc - 0 if success, > 0 otherwise. # # $file - modified file handle. # # $file_state - 'ok' - is good to be used # # 'end' - end of file has been reached # # 'done' - '::' found # # 'next section' - ':' found # # 'next line' = '=''::' found # # $input_str - next usable line of input from the file. # # # # Global Variables: # # $main::Trace5 Turns trace level 5 on. # #--------------------------------------------------------------------# sub get_next_line_from_input { my ($file, $is_array) = @_; my $input_str = ""; my $local_rc = 0; # Assume end of file - it will be changed if valid data is found my $file_state = "OK"; $main::Trace5 && print STDERR "Entered get_next_line_from_input\n"; while (!$file->eof) { $input_str = $file->getline; # Skip comment line if ($input_str =~ /^\s*#/ ) { $file_state = "comment"; next; } # Ignore blank lines if ($input_str =~ /^\s*$/) { $file_state = "blank"; next; } # Parse the input string, checking for the '::' reserved # character set as the signal to end processing the input file if ($input_str =~ /^\s*\w*::\s*$/) { $file_state = "done"; last; } # Check for headers of the form: # word: or word digit: - These are all that is expected. if ($input_str =~ /^\s*\w+\s*\d*\s*:\s*$/) { # Strip off trailing whitespace and at most one ':' # character at the end of the string $input_str =~ s/:\s+$//; $file_state = "next section"; last; } if ($input_str =~ /^\s*\w+\s*=.*$/) { # This should account for possible whitespace \s # before and after the column $file_state = "next line"; last; } if ($input_str =~ /^\s*\S+\s*$/) { # 77697 # If next line followed by blank line is not a blank and it is not # catched by other if blocks above this then set file_state to OK $file_state = "OK"; last; } if ($is_array != 1) { # If an array or structured data is being read in, # the any non-data or control line is considered possibly # part of the data. This code can not read minds! $input_str =~ s/\s*$//; printCEMsg("EMsgCTcliInputError", $input_str); $file_state = "garbage"; $local_rc = CT_CLI_USER_ERROR; next; } # if the code gets to here, quit out last; } if ( (($file_state eq "comment") || ($file_state eq "blank")) && (!$file->eof) ) { $file_state = "done"; } $main::Trace5 && print STDERR "Leaving get_next_line_from_input\n"; return ($local_rc, $file, $file_state, $input_str); } # end get_next_line_from_input #--------------------------------------------------------------------# # process_input_file: # # Reads a given input file, scanning for $target. $target is # # expected to be an alphanumeric string with a trailing '::'. # # (The '::' is not included in the $target string, it is assumed # # to be there and is automatically added to the $target string # # before searching.) # # # # The code reads data from the point $target is found in the file # # to the next line with a trailing '::', denoting a different # # target in the input file. Data is placed in an $output_array # # with the format: # # # # $data = [ # # [row_header, [[attribute,value], [attribute,value]]], # # [row_header, [[attribute,value],...]] # # ] # # # # For example, if your input file reads: # # # #DynamicData:: # #DynamicClassAttribute: # # Name="Resource1" # # Id=10 # # # ## Here is a comment # #DynamicClassAttribute: # # Name="ResourceUndefined" # # Id=1 # # VariableType=Quantum # # # # With a target of 'DynamicData', the output would look like: # # $data = [ # # [DynamicClassAttribute, [[Name,Resource1], [Id,10]]], # # [DynamicClassAttribute, [[Name,ResourceUndefined], # # [Id,1],[VariableType,Quantum]] # # ] # # # # To get a better idea of this structure, try displaying it in # # the Perl debugger. The nested arrays are all array references. # # # # Arrays are placed as 'raw data' in the $output_array, in the form # # {x,x,x,x..} This is because at this point, it is unknown what type # # of array is being read in, so the correct formatting and handling # # can not be done. # # # # In this example, $row_header is going to be "DynamicClassAttribute"# # for both iterations. The $row_header is considered the line with # # a single trailing ':' in the input file. # # # # Example of how best to access the output array structure: # # # # foreach $entry (@$data) { # # $row_header = $entry->[0]; # # foreach $element (@{$entry->[1]}) { # # $attribute = $element->[0]; # # $value = $element->[1]; # # } # # } # # # # For more information on input syntax, see the prolog at the # # beginning of this file. # # # # Parameters: # # $file_name Name of file to pull data from # # $target Target line to search for in input file, marks # # the beginning of data to be read in # # $optional (Boolean - value is 0 or 1) - # # = 1 if the value is optional in the input file # # = 0 (or undefined) if the value is required to be # # found in the input file. # # # # Returns: # # $local_rc 0 if success # # return code for local errors otherwise # # \@output_array Array of data from the input file, passed # # by reference (See format above, or in main # # prologue of this file.) # # # # Global Variables: # # $main::Trace5 Only used if Trace mode on # #--------------------------------------------------------------------# sub process_input_file { my ($file_name, $target, $optional) = @_; # Set up local variables my $file = new FileHandle $file_name , "r"; my $input_string=""; my $found = 0; my $local_rc = 0; my $input_file_error = 0; my $line_count = 0; my $long_string = 0; my $entry = ""; my @output_array = (); my $outer_index = -1; my $inner_index = -1; my $is_array = 0; my $done = 0; my $holder = "this value will be a pointer"; my $file_status = ""; my $first = 1; my $no_stanza = 0; my $next = 0; # Return code storage - the idea is to pre-process the input # file, returning the worst return code, while printing # out all possible error messages $main::Trace5 && print STDERR "Entered CT_cli_input_utils::process_input_file($file_name)\n"; do { if (defined $file) { if (($target ne "") && ($next != 1)) { # search for the target name given in parameters while (!($file->eof) && !$found ) { $input_string = $file->getline; next if ($input_string !~ /^$target\::$/); $found++; }; if (!$found) { $file->close; # close filehandle if ($optional != 1) { printCEMsg("EMsgCTcliTargetNotFound", $target, $file_name); return CT_CLI_USER_ERROR; } else { return 0; } } } # At this point, the entry point for reading data # has been located in the input file, so process the data. if ($next != 1) { $found = 0; } # ($next == 1) condition has been added as part of while condition # so that the code covered by CODA