/* Copyright (c) 1995, 2002 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */ /* Structured Programming". Permission is given to reproduce and to use these procedures */ /* as part of a program, and to include them as part of a larger work to be sold for profit. */ /* However, the user is not permitted to sell the procedures separately. Provided always */ /* that these procedures and this copyright notice are reproduced in full. */ /* Modified 7 July 2002; WIDECHAR added 22 January 2005 */ DECLARE TRIM GENERIC (TRIM_blank_widechar WHEN (WIDECHAR), TRIM_before_widechar WHEN (WIDECHAR,*), TRIM_other_widechar WHEN (WIDECHAR,*,*), TRIM_blank_graphic WHEN (GRAPHIC), TRIM_blank WHEN (*), TRIM_before WHEN (*,*), TRIM_other WHEN (*,*,*) ); /* This function implements the single-argument version of the built-in function TRIM. */ /* It removes leading and trailing blanks from the string parameter STRING. */ TRIM_blank: PROCEDURE (STRING) OPTIONS (REORDER) RETURNS ( CHARACTER (32767) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading and trailing blanks. */ DECLARE STRING CHARACTER (*); DECLARE (LENGTH, SUBSTR, VERIFY) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31) STATIC; IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY (STRING, ' ' ); /* Search for the first non-blank character. */ IF START = 0 THEN RETURN ( '' ); /* All the characters were blank. Return null string. */ DO ENDING = LENGTH (STRING) TO 1 BY -1; IF SUBSTR (STRING, ENDING, 1) ^= ' ' THEN LEAVE; END; RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any blanks fore and aft. */ END TRIM_blank; /* This function implements the single-argument version of the built-in function TRIM. */ /* It removes leading and trailing blanks from the graphic string parameter STRING. */ TRIM_blank_graphic: PROCEDURE (STRING) OPTIONS (REORDER) RETURNS ( GRAPHIC (16383) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading and trailing blanks. */ DECLARE STRING GRAPHIC (*); DECLARE (LENGTH, SUBSTR, VERIFY) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31) STATIC; IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY (STRING, ' ' ); /* Search for the first non-blank character. */ IF START = 0 THEN RETURN ( '' ); /* All the characters were blank. Return null string. */ DO ENDING = LENGTH (STRING) TO 1 BY -1; IF SUBSTR (STRING, ENDING, 1) ^= ' ' THEN LEAVE; END; RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any blanks fore and aft. */ END TRIM_blank_graphic; /* This function implements the single-argument version of the built-in function TRIM. */ /* It removes leading and trailing blanks from the widechar string parameter STRING. */ TRIM_blank_widechar: PROCEDURE (STRING) OPTIONS (REORDER) RETURNS ( WIDECHAR (16383) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading and trailing blanks. */ DECLARE STRING WIDECHAR (*); DECLARE (LENGTH, SUBSTR) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31) STATIC; IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY_W (STRING, ' ' ); /* Search for the first non-blank character. */ IF START = 0 THEN RETURN ( '' ); /* All the characters were blank. Return null string. */ DO ENDING = LENGTH (STRING) TO 1 BY -1; IF SUBSTR (STRING, ENDING, 1) ^= ' ' THEN LEAVE; END; RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any blanks fore and aft. */ END TRIM_blank_widechar; /* This function implements the two-argument version of the built-in function TRIM. */ /* It removes leading characters specified by BEFORE, and trailing blanks, from the string */ /* parameter STRING. */ TRIM_before: PROCEDURE (STRING, BEFORE) OPTIONS (REORDER) RETURNS ( CHARACTER(32767) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading character BEFORE, and */ /* of trailing blanks. */ /* BEFORE = a character to be trimmed from the beginning of STRING. */ DECLARE STRING CHARACTER (*); DECLARE BEFORE CHARACTER (*); DECLARE (LENGTH, SUBSTR, VERIFY) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31); IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY (STRING, BEFORE); /* Search for the first non-BEFORE character. */ IF START = 0 THEN IF LENGTH(Before) > 0 THEN RETURN ( '' ); /* All the characters were BEFORE. Return a */ /* null string. */ DO ENDING = LENGTH (STRING) TO 1 BY -1; IF SUBSTR (STRING, ENDING, 1) ^= ' ' THEN LEAVE; END; IF LENGTH(Before) = 0 THEN /* Only blanks are truncated from the tail. */ RETURN (SUBSTR (String, 1, Ending) ); RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any specified characters from the */ /* beginning, and any blanks from the end. */ END TRIM_before; /* This function implements the two-argument version of the built-in function TRIM. */ /* It removes leading characters specified by BEFORE, and trailing blanks, from the widechar */ /* string parameter STRING. */ TRIM_before_widechar: PROCEDURE (STRING, BEFORE) OPTIONS (REORDER) RETURNS ( WIDECHAR(16383) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading character BEFORE, and */ /* of trailing blanks. */ /* BEFORE = a character to be trimmed from the beginning of STRING. */ DECLARE STRING WIDECHAR (*); DECLARE BEFORE WIDECHAR (*); DECLARE (LENGTH, SUBSTR) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31); IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY_W (STRING, BEFORE); /* Search for the first non-BEFORE character. */ IF START = 0 THEN IF LENGTH(Before) > 0 THEN RETURN ( '' ); /* All the characters were BEFORE. Return a */ /* null string. */ DO ENDING = LENGTH (STRING) TO 1 BY -1; IF SUBSTR (STRING, ENDING, 1) ^= ' ' THEN LEAVE; END; IF LENGTH(Before) = 0 THEN /* Only blanks are truncated from the tail. */ RETURN (SUBSTR (String, 1, Ending) ); RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any specified characters from the */ /* beginning, and any blanks from the end. */ END TRIM_before_widechar; /* This function implements the three-argument version of the built-in function TRIM. */ /* It removes leading characters specified by BEFORE, and trailing characters specified by */ /* AFT, from the string parameter STRING. */ TRIM_other: PROCEDURE (STRING, BEFORE, AFT) OPTIONS (REORDER) RETURNS ( CHARACTER(32767) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading character BEFORE, and */ /* of trailing blanks. */ /* BEFORE = a character to be trimmed from the beginning of STRING. */ /* AFT = a character to be trimmed from the end of STRING. */ DECLARE STRING CHARACTER (*); DECLARE (BEFORE, AFT) CHARACTER (*); DECLARE (LENGTH, SUBSTR, INDEX, VERIFY) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31); IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY (STRING, BEFORE); /* Search for the first non-BEFORE character. */ IF START = 0 THEN IF LENGTH(Before) > 0 THEN RETURN ( '' ); /* All the characters were BEFORE. Return a */ /* null string. */ IF LENGTH (Aft) = 0 THEN Ending = LENGTH(String); ELSE DO ENDING = LENGTH (STRING) TO 1 BY -1; IF INDEX(AFT, SUBSTR (STRING, ENDING, 1)) = 0 THEN LEAVE; END; IF LENGTH(Before) = 0 THEN /* Nothing is truncated from the front. */ RETURN (SUBSTR (String, 1, Ending) ); IF Start > Ending THEN RETURN (''); /* All characters were eliminated. */ RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any specified characters fore and aft. */ END TRIM_other; /* This function implements the three-argument version of the built-in function TRIM. */ /* It removes leading characters specified by BEFORE, and trailing characters specified by */ /* AFT, from the widechar string parameter STRING. */ TRIM_other_widechar: PROCEDURE (STRING, BEFORE, AFT) OPTIONS (REORDER) RETURNS ( WIDECHAR(16383) VARYING ); /* INCOMING: STRING = the string that is to be stripped of leading character BEFORE, and */ /* of trailing blanks. */ /* BEFORE = a character to be trimmed from the beginning of STRING. */ /* AFT = a character to be trimmed from the end of STRING. */ DECLARE STRING WIDECHAR (*); DECLARE (BEFORE, AFT) WIDECHAR (*); DECLARE (LENGTH, SUBSTR) BUILTIN; DECLARE (START, ENDING) FIXED BINARY (31); IF LENGTH (STRING) = 0 THEN RETURN ( '' ); /* There's nothing to trim. */ START = VERIFY_W (STRING, BEFORE); /* Search for the first non-BEFORE character. */ IF START = 0 THEN IF LENGTH(Before) > 0 THEN RETURN ( '' ); /* All the characters were BEFORE. Return a */ /* null string. */ IF LENGTH (Aft) = 0 THEN Ending = LENGTH(String); ELSE DO ENDING = LENGTH (STRING) TO 1 BY -1; IF INDEX_W(AFT, SUBSTR (STRING, ENDING, 1)) = 0 THEN LEAVE; END; IF LENGTH(Before) = 0 THEN /* Nothing is truncated from the front. */ RETURN (SUBSTR (String, 1, Ending) ); IF Start > Ending THEN RETURN (''); /* All characters were eliminated. */ RETURN (SUBSTR (STRING, START, ENDING-START+1)); /* Omits any specified characters fore and aft. */ END TRIM_other_widechar; /* Implements VERIFY for WIDECHAR. */ VERIFY_W: PROCEDURE (STRING, CHARACTERS) OPTIONS (REORDER) RETURNS (FIXED BINARY (31)); /* INCOMING: STRING = a string to be searched. */ /* CHARACTERS = characters to match. */ DECLARE STRING WIDECHAR (*); DECLARE CHARACTERS WIDECHAR (*); DECLARE (LENGTH, SUBSTR) BUILTIN; DECLARE WCh WIDECHAR (1); DECLARE (I, J) FIXED BINARY (31); DO I = 1 TO LENGTH (String); WCh = SUBSTR (String, I, 1); DO J = 1 TO LENGTH (Characters); IF SUBSTR(Characters, J, 1) ^= Wch THEN RETURN (I); END; END; RETURN (0); /* All characters matched. */ END VERIFY_W; /* Implements INDEX for WIDECHAR. */ INDEX_W: PROCEDURE (STRING, KEY) OPTIONS (REORDER) RETURNS (FIXED BINARY (31)); /* INCOMING: STRING = a string to be searched. */ /* KEY = a key for the search. */ DECLARE STRING WIDECHAR (*); DECLARE Key WIDECHAR (*); DECLARE (LENGTH, SUBSTR) BUILTIN; DECLARE J FIXED BINARY (31); IF LENGTH(Key) = 0 THEN RETURN (0); DO J = 1 TO LENGTH (String) - LENGTH (Key) + 1; IF SUBSTR (String, J, LENGTH(Key)) = Key THEN RETURN (J); END; RETURN (0); /* The search was unsuccessful. */ END INDEX_W;