.CM  SCRIPT , Version - 1.1 , last edited by M.Rathmann
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 1995-2004 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VSP44$
.tt 2 $$$
.TT 3 $RudolfM$ESTRING-Conversions$1995-04-20$
***********************************************************
.nf

.nf


    ========== licence begin  GPL
    Copyright (c) 1995-2004 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end

.fo


.fo
.nf
.sp
MODULE  : ESTRING-Conversions
=========
.sp
Purpose : Conversion of numbers in extended plain text format
          into VDN-numbers
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              s44egstr (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    VAR dest    : tsp00_MoveObj;
                    dpos        : tsp00_Int4;
                    VAR dlen    : integer;
                    VAR decimal : tsp_decimal_presentation;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s44egchr (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    VAR dest    : tsp00_MoveObj;
                    dpos        : tsp00_Int4;
                    VAR dlen    : integer;
                    VAR decimal : tsp_decimal_presentation;
                    VAR res     : tsp00_NumError);
 
        PROCEDURE
              s44epstr (
                    VAR buf     : tsp00_MoveObj;
                    pos         : tsp00_Int4;
                    len         : integer;
                    frac        : integer;
                    VAR source  : tsp00_MoveObj;
                    spos        : tsp00_Int4;
                    slen        : integer;
                    VAR decimal : tsp_decimal_presentation;
                    VAR res     : tsp00_NumError);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              GETSTRING-Conversions : VSP42;
 
        PROCEDURE
              s42gstr (
                    VAR buf  : tsp00_Number;
                    pos      : tsp00_Int4;
                    len      : integer;
                    frac     : integer;
                    origlen  : integer;
                    VAR dest : tsp00_MoveObj;
                    dpos     : tsp00_Int4;
                    VAR dlen : integer;
                    VAR res  : tsp00_NumError);
 
        PROCEDURE
              s42gchr (
                    VAR buf  : tsp00_Number;
                    pos      : tsp00_Int4;
                    len      : integer;
                    frac     : integer;
                    origlen  : integer;
                    VAR dest : tsp00_MoveObj;
                    dpos     : tsp00_Int4;
                    VAR dlen : integer;
                    VAR res  : tsp00_NumError);
 
      ------------------------------ 
 
        FROM
              PUTSTRING-Conversions : VSP43;
 
        PROCEDURE
              s43pstr (
                    VAR buf    : tsp00_MoveObj;
                    pos        : tsp00_Int4;
                    len        : integer;
                    frac       : integer;
                    VAR source : tsp00_NumStr;
                    spos       : tsp00_Int4;
                    slen       : integer;
                    VAR res    : tsp00_NumError);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s42gstr;
 
              tsp00_MoveObj tsp00_Number;
 
        PROCEDURE
              s42gchr;
 
              tsp00_MoveObj tsp00_Number;
 
        PROCEDURE
              s43pstr;
 
              tsp00_MoveObj tsp00_NumStr;
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : RudolfM
.sp
.cp 3
Created : 1986-05-28
.sp
.cp 3
Version : 1995-04-20
.sp
.cp 3
Release :  6.1.1 	 Date : 1995-04-20
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
TYPE
 num_error = (num_ok, num_trunc, num_overflow, num_invalid);
.sp
CONST
 maxnumstrlength = 28;
TYPE
 numstr = PACKED ARRAY [ 1 .. maxnumstrlength ] OF CHAR;
TYPE
 decimal_presentation = RECORD
                thousand_token : char;
                zero_point     : char;
                END;
.sp
Meaning of the parameters:
.sp;.nf
 buf            : array or record in which the VDN number is stored
 pos            : position at which the VDN number is to be stored
 len            : length of the VDN number is digits (not in bytes!)
 frac           : number of decimal places or FLOAT
 source         : source variable of appropriate type
 spos           : for strings, position of the source string in source
                  array
 slen           : for strings, precise (!) length of the source string
                  for DECIMAL and ZONED, number of digits
 sfrac          : for DECIMAL and ZONED, number of decimal places
 thousand_token : flag character for thousands positions
 zero_point     : representation of the decimal point
 res            : response concerning success or error situations
.sp;.fo
The parameters THOUSAND_TOKEN and ZERO_POINT are passed as
record components in the parameter DECIMAL for all procedures.
.sp
The parameter BUF identifies the record or array in which the
VDN number is to be stored.
The number of
.oc _/;positions
 (not bytes!) of the VDN number is indicated by LEN;
the number of decimal places is indicated by FRAC.
A FLOAT VDN number is signalled by FRAC = -1
 (use constant FLOAT).
.sp
The parameter SOURCE
is the input parameter for the
standard data types.
.sp
In the case of the data type 'string', the exact (!) string
length must be specified when entering SOURCE.
Strings are supplied
.oc _/1;left-justified.
.sp
After each call of a conversion procedure, the response RES
is to be queried which supplies information on whether the procedure
ran correctly or whether there were exceptional or error conditions
during the conversion.
.sp 2
PROCEDURE S44EGSTR
.sp
Changes a VDN number to a string that is stored right-justified
at a specific position in a longer string.  As an extension to the
S42GSTR procedure, the representation of the decimal point and the
thousand token can also be specified.  If no token is desired at
the thousands position, 'N' must be entered.
If an overflow occurs, asterisks are stored.
.sp 2
PROCEDURE S44EGCHR
.sp
Changes a VDN number to a string that is stored left-justified
at a specific position in a longer string.  It must be noted that
S44EGCHR stores several blanks in the positions following DLEN
in DEST.
As an extension to the S42GCHR procedure, the representations of the
decimal point and the thousand token can also be specified.
If no token is desired at the thousands position, 'N' must be
entered.
If an overflow occurs, asterisks are stored.
.sp 2
PROCEDURE S44EPSTR
.sp
Stores a number as a VDN number in string form that is
located at a specific position in a longer string of the length
 (exactly) specified.
For the syntax of the string, the VDN declarations for numeric
literals apply.
As an extension of the S43PSTR procedure, the representations of the
decimal point and the thousand token can also be specified.
If the thousands positions are not labeled, THOUSAND_TOKEN
must be assigned 'N'.
.sp 2
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
PROCEDURE
      s44egstr (
            VAR buf     : tsp00_MoveObj;
            pos         : tsp00_Int4;
            len         : integer;
            frac        : integer;
            VAR dest    : tsp00_MoveObj;
            dpos        : tsp00_Int4;
            VAR dlen    : integer;
            VAR decimal : tsp_decimal_presentation;
            VAR res     : tsp00_NumError);
 
VAR
      i        : integer;
      startpos : integer;
      minuspos : integer;
      decpos   : integer;
      thouspos : integer;
      n        : tsp00_Number;
 
BEGIN
n := csp_null_number;
FOR i := 1 TO ( (len + 1) DIV 2) + 1 DO
    n [ i ] := buf [ pos + i - 1 ];
(*ENDFOR*) 
s42gstr (n, 1, len, frac, len, dest, dpos, dlen, res);
IF  ( (res = num_ok) OR (res = num_trunc))
    AND NOT ( (len = 1) AND (frac = csp_float_frac))
THEN
    BEGIN
    decpos := dlen - 1;
    WHILE (dest [ dpos + decpos ] <> '.') AND (decpos > 0) DO
        decpos := decpos - 1;
    (*ENDWHILE*) 
    IF  dest [ dpos + decpos ] = '.'
    THEN
        dest [ dpos + decpos ] := decimal.zero_point
    ELSE
        decpos := dlen;
    (*ENDIF*) 
    IF  decimal.thousand_token <> 'N'
    THEN
        BEGIN
        startpos := 0;
        WHILE (dest [ dpos + startpos ] in [ ' ', '-' ]) AND
              (startpos < dlen) DO
            startpos := startpos + 1;
        (*ENDWHILE*) 
        IF  dest [ dpos + startpos - 1 ] = '-'
        THEN
            minuspos := startpos - 1
        ELSE
            minuspos := 9999;
        (*ENDIF*) 
        thouspos := decpos;
        WHILE thouspos > 3 DO
            BEGIN
            thouspos := thouspos - 3;
            FOR i := dlen - 1 DOWNTO thouspos DO
                dest [ dpos + i + 1 ] := dest [ dpos + i ];
            (*ENDFOR*) 
            IF  thouspos > startpos
            THEN
                dest [ dpos + thouspos ] := decimal.thousand_token
            ELSE
                IF  (thouspos = startpos) AND
                    (thouspos - 1 = minuspos)
                THEN
                    BEGIN
                    dest [ dpos + thouspos ] := '-';
                    dest [ dpos + thouspos - 1 ] := ' ';
                    minuspos := 9999;
                    END
                ELSE
                    dest [ dpos + thouspos ] := ' ';
                (*ENDIF*) 
            (*ENDIF*) 
            dlen := dlen + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* s44egstr *)
 
(*------------------------------*) 
 
PROCEDURE
      s44egchr (
            VAR buf     : tsp00_MoveObj;
            pos         : tsp00_Int4;
            len         : integer;
            frac        : integer;
            VAR dest    : tsp00_MoveObj;
            dpos        : tsp00_Int4;
            VAR dlen    : integer;
            VAR decimal : tsp_decimal_presentation;
            VAR res     : tsp00_NumError);
 
VAR
      i        : integer;
      startpos : integer;
      minuspos : integer;
      decpos   : integer;
      thouspos : integer;
      n        : tsp00_Number;
 
BEGIN
n := csp_null_number;
FOR i := 1 TO ((len + 1) DIV 2) + 1 DO
    n [ i ] := buf [ pos + i - 1 ];
(*ENDFOR*) 
s42gchr (n, 1, len, frac, len, dest, dpos, dlen, res);
IF  ( (res = num_ok) OR (res = num_trunc))
    AND NOT ( (len = 1) AND (frac = csp_float_frac))
THEN
    BEGIN
    decpos := dlen - 1;
    WHILE (dest [ dpos + decpos ] <> '.') AND (decpos > 0) DO
        decpos := decpos - 1;
    (*ENDWHILE*) 
    IF  dest [ dpos + decpos ] = '.'
    THEN
        dest [ dpos + decpos ] := decimal.zero_point
    ELSE
        decpos := dlen;
    (*ENDIF*) 
    IF  decimal.thousand_token <> 'N'
    THEN
        BEGIN
        IF  dest [ dpos ] = '-'
        THEN
            BEGIN
            minuspos := 0;
            startpos := 1;
            END
        ELSE
            BEGIN
            minuspos := 9999;
            startpos := 0
            END;
        (*ENDIF*) 
        thouspos := decpos;
        WHILE thouspos > 3 DO
            BEGIN
            thouspos := thouspos - 3;
            FOR i := dlen - 1 DOWNTO thouspos DO
                dest [ dpos + i + 1 ] := dest [ dpos + i ];
            (*ENDFOR*) 
            IF  thouspos > startpos
            THEN
                dest [ dpos + thouspos ] := decimal.thousand_token
            ELSE
                IF  (thouspos = startpos) AND
                    (thouspos - 1 = minuspos)
                THEN
                    BEGIN
                    FOR i := startpos TO dlen - 1 DO
                        dest [ dpos + i ] := dest [ dpos + i + 1 ];
                    (*ENDFOR*) 
                    dest [ dpos + dlen ] := ' ';
                    dlen := dlen - 1;
                    minuspos := 9999;
                    END
                ELSE
                    dest [ dpos + thouspos ] := ' ';
                (*ENDIF*) 
            (*ENDIF*) 
            dlen := dlen + 1;
            END;
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* s44egchr *)
 
(*------------------------------*) 
 
PROCEDURE
      s44epstr (
            VAR buf     : tsp00_MoveObj;
            pos         : tsp00_Int4;
            len         : integer;
            frac        : integer;
            VAR source  : tsp00_MoveObj;
            spos        : tsp00_Int4;
            slen        : integer;
            VAR decimal : tsp_decimal_presentation;
            VAR res     : tsp00_NumError);
 
VAR
      i              : tsp00_Int4;
      j              : tsp00_Int4;
      p              : integer;
      decpos         : integer;
      th_cnt         : integer;
      th_found       : boolean;
      negativ        : boolean;
      floating_point : boolean;
      s              : tsp00_NumStr;
 
BEGIN
res := num_ok;
negativ := false;
floating_point := false;
p := - spos;
FOR i := spos TO spos + slen - 1 DO
    IF  (source [ i ] <> bsp_c1)
        AND (source [ i ] <> '+')
        AND (source [ i ] <> '-')
        AND (p = - spos)
    THEN
        p := i
    ELSE
        IF  (source [ i ] = '-')
            AND (p = - spos)
        THEN
            negativ := NOT negativ
        ELSE
            IF  (source [ i ] = 'e') OR (source [ i ] = 'E')
            THEN
                floating_point := true;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDFOR*) 
IF  p = - spos
THEN
    res := num_invalid
ELSE
    BEGIN
    IF  negativ
    THEN
        s [ 1 ] := '-'
    ELSE
        s [ 1 ] := '+';
    (*ENDIF*) 
    slen := slen - (p - spos);
    spos := p;
    decpos := 0;
    IF  (decimal.thousand_token <> 'N') AND NOT floating_point
    THEN
        BEGIN
        i := 1;
        j := spos;
        th_cnt := 0;
        th_found := false;
        WHILE (j < spos + slen) AND (res = num_ok) DO
            IF  source [ j ] in [ '0'..'9' ]
            THEN
                BEGIN
                i := i + 1;
                s [ i ] := source [ j ];
                j := j + 1;
                th_cnt := th_cnt + 1;
                IF  th_found AND (th_cnt > 3) AND (decpos = 0)
                THEN
                    res := num_invalid;
                (*ENDIF*) 
                END
            ELSE
                IF  source [ j ] = decimal.thousand_token
                THEN
                    BEGIN
                    th_found := true;
                    IF  ((i > 3) AND (th_cnt <> 3)) OR (decpos <> 0)
                    THEN
                        res  := num_invalid
                    ELSE
                        BEGIN
                        j := j + 1;
                        th_cnt := 0;
                        END;
                    (*ENDIF*) 
                    END
                ELSE
                    IF  ((source [ j ] = decimal.zero_point)
                        OR (source [ j ] = '.'))
                        (* thousand_token is not equal '.', see IF seq *)
                        AND (decpos = 0) AND ((i <= 3) OR (th_cnt >= 3))
                    THEN
                        BEGIN
                        i := i + 1;
                        s [ i ] := '.';
                        decpos := i;
                        j := j + 1;
                        END
                    ELSE
                        res := num_invalid;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDWHILE*) 
        slen := i;
        END
    ELSE
        BEGIN
        slen := slen + 1; (* digit length + sign *)
        IF  slen > NUMSTR_MXSP00
        THEN
            res := num_invalid
        ELSE
            FOR i := 2 TO slen DO
                IF  (source [ spos + i - 2 ] = decimal.zero_point)
                    AND (decpos = 0)
                THEN
                    BEGIN
                    s [ i ] := '.';
                    decpos := i;
                    END
                ELSE
                    s [ i ] := source [ spos + i - 2 ];
                (*ENDIF*) 
            (*ENDFOR*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  res = num_ok
THEN
    s43pstr (buf, pos, len, frac, s, 1, slen, res);
(*ENDIF*) 
END; (* s44epstr *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        118
*-PRETTY-*  lines of code :        328        PRETTY  3.09 
*-PRETTY-*  lines in file :        600         1992-11-23 
.PA 
