/* 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;