426 lines
12 KiB
Plaintext
426 lines
12 KiB
Plaintext
|
subroutine DC.A( psource, ucode, result )
|
||
|
*******************************************************************************
|
||
|
*
|
||
|
* Convert dictionary item(s) from Pick to Uni*Verse format:
|
||
|
* parse A correlatives/conversions for correct syntax
|
||
|
*
|
||
|
* Module %M% Version %I% Date %H%
|
||
|
*
|
||
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
* The copyright notice above does not evidence any actual or intended
|
||
|
* publication of such source code.
|
||
|
*
|
||
|
*******************************************************************************
|
||
|
*
|
||
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
*
|
||
|
* Date.... GTAR# WHO Description.........................................
|
||
|
* 10/22/98 23801 SAP Change company name to Ardent
|
||
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
* 02/23/90 5454 JWT Fix error in processing parenthesized expressions.
|
||
|
* if first character of expression is not a valid
|
||
|
* leading character for a conversion code, we
|
||
|
* need to recurse in DC.A rather than calling
|
||
|
* DC.CORR.CONV
|
||
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
*
|
||
|
*******************************************************************************
|
||
|
*
|
||
|
* The basis for this Pick-to-Uni*Verse dictionary converter was a
|
||
|
* Microdata-to-Prime converter written by J. Michael Cannady and
|
||
|
* Thomas J. Rauschenbach of Fulcrum Computer Group, Inc. Ardent
|
||
|
* was granted permission to use that code by Infocel, Inc., a successor
|
||
|
* of Fulcrum.
|
||
|
*
|
||
|
*******************************************************************************
|
||
|
*
|
||
|
* Parse A correlatives/conversions for correct syntax
|
||
|
*
|
||
|
* Arguments:
|
||
|
* psource - the Pick dictionary item's conversion code
|
||
|
* ucode - the returned Uni*Verse conversion code
|
||
|
* result - Boolean: returned "true" if the conversion is successful,
|
||
|
* false otherwise
|
||
|
*
|
||
|
* This subroutine parses the "psource" to insure that it is a valid A
|
||
|
* correlative or conversion. The form is:
|
||
|
* A(expression)
|
||
|
* where an "expression" may comprise one or more of the following:
|
||
|
*
|
||
|
* 1. A numeric AMC, optionally followed by an 'R' (repeat or reuse code).
|
||
|
* 2. "N(name)", where "name" is a dictionary entry for an attribute
|
||
|
* 3. "string", a literal string enclosed within pairs of "s, 's, or \s.
|
||
|
* 4. "number", a constant number enclosed within pairs "s, 's, or \s.
|
||
|
* 5. 'D', the internal system date.
|
||
|
* 6. 'T', the internal system time.
|
||
|
* 7. A special system counter operand:
|
||
|
* a. "NI", the current item counter
|
||
|
* b. "ND", the number of detail lines since BREAK
|
||
|
* c. "NV", the current multivalue counter
|
||
|
* d. "NS", the current submultivalue counter
|
||
|
* e. "NB", the current BREAK level
|
||
|
* f. "LPV", load the result of the last correlative/conversion
|
||
|
* 8. A function:
|
||
|
* a. 'R', the remainder after integer division of the first
|
||
|
* attribute/constant by the second. E.g., "R( 2, '5' )"
|
||
|
* returns the mod when attribute 2's value is divided by 5.
|
||
|
* b. 'S', the sum of the multivalues. E.g.,
|
||
|
* "S(6)" sums the multivalues of attribute 6.
|
||
|
* c. "[]", substring. AMCs, literal numbers, or expressions can
|
||
|
* comprise the arguments within the brackets. E.g., if the
|
||
|
* value of attribute 3 is 9, then "7[ '2', 3 ]" will return
|
||
|
* the second through ninth characters of attribute 7.
|
||
|
* d. "IF (expression) THEN (expression) ELSE (expression)
|
||
|
* 9. An arithmetic operator:
|
||
|
* a. "*(n)", multiply operands
|
||
|
* The optional 'n' is the descaling factor (i.e., result
|
||
|
* is divided by 10 raised to the nth power).
|
||
|
* b. '/', divide operands (integer division)
|
||
|
* c. '+', add operands
|
||
|
* d. '-', subtract operands
|
||
|
* e. ':', concatenate operands
|
||
|
* 10. A relational operator:
|
||
|
* a. '=', equal to
|
||
|
* b. '<', less than
|
||
|
* c. '>', greater than
|
||
|
* d. '#', not equal to
|
||
|
* e. "<=", less than or equal to
|
||
|
* f. ">=", greater than or equal to
|
||
|
* g. "<>", not equal to
|
||
|
* 11. A parenthesized expression:
|
||
|
* a. "(expression)" used for ordering; must follow an operator
|
||
|
* b. "(conversion)" used to apply another conversion to a value;
|
||
|
* may not follow an operator
|
||
|
*
|
||
|
************************************************************************
|
||
|
*
|
||
|
$options DEFAULT
|
||
|
$include UNIVERSE.INCLUDE DC.COMM.DECL
|
||
|
*
|
||
|
equ true to 1
|
||
|
equ false to 0
|
||
|
*
|
||
|
*
|
||
|
ucode = "A"
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
result = 1
|
||
|
need.right.paren = 0
|
||
|
need.right.bracket = 0
|
||
|
need.then = 0
|
||
|
need.else = 0
|
||
|
need.comma = 0
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
loop
|
||
|
char1 = psource[ 1, 1 ]
|
||
|
while len( psource ) and char1 <> @VM and char1 <> "}" and not( char1 = "]" and need.right.bracket = 0 )
|
||
|
begin case
|
||
|
case char1 matches "1N"
|
||
|
*
|
||
|
* << AMC. Get all the digits >>
|
||
|
*
|
||
|
loop
|
||
|
temp = psource[ 1, 1 ]
|
||
|
while temp matches "1N" do
|
||
|
ucode := temp
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
repeat
|
||
|
if psource[ 1, 1 ] = "R" then; * Reuse code
|
||
|
ucode := "R"
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
end
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case psource[ 1, 2 ] = "N("
|
||
|
*
|
||
|
* << Attribute name: N(name) >>
|
||
|
*
|
||
|
loop
|
||
|
temp = psource[ 1, 1 ]
|
||
|
until temp = "" or temp = ")" do
|
||
|
ucode := temp
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
repeat
|
||
|
if temp <> ")" then
|
||
|
call @DC.MESSAGE( '"N( name )" function missing right parenthesis:', psource )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
ucode := ")"
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case char1 = '"' or char1 = "'" or char1 = "\"
|
||
|
*
|
||
|
* << Quoted expression: "EXP" >>
|
||
|
*
|
||
|
quote = char1
|
||
|
ucode := quote
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
loop
|
||
|
temp = psource[ 1, 1 ]
|
||
|
until temp = quote or temp = "" or temp = @VM do
|
||
|
ucode := temp
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
repeat
|
||
|
if temp <> quote then
|
||
|
call @DC.MESSAGE( "Quoted string missing closing quotation mark:", psource )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
ucode := quote
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case psource[ 1, 2 ] = "NI" or psource[ 1, 2 ] = "ND" or psource[ 1, 2 ] = "NB" or psource[ 1, 2 ] = "NS" or psource[ 1, 2 ] = "NV"
|
||
|
*
|
||
|
* << Current item counter >>
|
||
|
* << Number of detail lines since last BREAK >>
|
||
|
* << Current multivalue counter >>
|
||
|
* << Current submultivalue counter >>
|
||
|
* << Current break level >>
|
||
|
*
|
||
|
ucode := "@" : psource[ 1, 2 ]
|
||
|
psource = psource[ 3, len( psource )]
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case psource[ 1, 3 ] = "LPV"
|
||
|
*
|
||
|
* << Load value from previous correlative/conversion >>
|
||
|
*
|
||
|
ucode := "@LPV"
|
||
|
psource = psource[ 4, len( psource )]
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case psource[ 1, 2 ] = "R(" or psource[ 1, 2 ] = "S("
|
||
|
*
|
||
|
* << Remainder function: R(n,m) >>
|
||
|
* << Summation function: S(n) >>
|
||
|
*
|
||
|
if psource[ 1, 2 ] = "R(" then
|
||
|
need.comma += 1
|
||
|
end
|
||
|
ucode := psource[ 1, 2 ]
|
||
|
psource = psource[ 3, len( psource )]
|
||
|
need.right.paren += 1
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case char1 = "["
|
||
|
*
|
||
|
* << Substring specification: AMC[ m, n ] >>
|
||
|
*
|
||
|
ucode := "["
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
need.right.bracket += 1
|
||
|
need.comma += 1
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case char1 = ")"
|
||
|
if need.right.paren = 0 then
|
||
|
call @DC.MESSAGE( "Extraneous closing parenthesis:", psource )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
ucode := ")"
|
||
|
need.right.paren -= 1
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case char1 = "]"
|
||
|
if need.right.bracket = 0 then
|
||
|
call @DC.MESSAGE( "Extraneous closing bracket:", psource )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
ucode := "]"
|
||
|
need.right.bracket -= 1
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = false
|
||
|
*
|
||
|
case char1 = ","
|
||
|
if need.comma = 0 then
|
||
|
call @DC.MESSAGE( "Extraneous comma:", psource )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
ucode := ","
|
||
|
need.comma -= 1
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case psource[ 1, 2 ] = "IF"
|
||
|
*
|
||
|
* << IF/THEN/ELSE statement coming up. >>
|
||
|
*
|
||
|
ucode := "IF"
|
||
|
psource = psource[ 3, len( psource )]
|
||
|
need.then += 1
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case psource[ 1, 4 ] = "THEN"
|
||
|
*
|
||
|
* << IF/THEN/ELSE statement continuing. >>
|
||
|
*
|
||
|
ucode := "THEN"
|
||
|
psource = psource[ 5, len( psource )]
|
||
|
need.then -= 1
|
||
|
need.else += 1
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case psource[ 1, 4 ] = "ELSE"
|
||
|
*
|
||
|
* << IF/THEN/ELSE statement finishing. >>
|
||
|
*
|
||
|
ucode := "ELSE"
|
||
|
psource = psource[ 5, len( psource )]
|
||
|
need.else -= 1
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case char1 = "*" or char1 = "/" or char1 = "+" or char1 = "-" or char1 = ":"
|
||
|
*
|
||
|
* << Arithmetic or concatenation operator. Take it. >>
|
||
|
*
|
||
|
ucode := char1
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = true
|
||
|
|
||
|
*
|
||
|
case psource[ 1, 3 ] = "OR "
|
||
|
*
|
||
|
* << Logical or. >>
|
||
|
*
|
||
|
ucode := "OR "
|
||
|
psource = psource[ 4, len( psource )]
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case psource[ 1, 4 ] = "AND "
|
||
|
*
|
||
|
* << Logical and. >>
|
||
|
*
|
||
|
ucode := "AND "
|
||
|
psource = psource[ 5, len( psource )]
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case psource[ 1, 2 ] = "<=" or psource[ 1, 2 ] = ">=" or psource[ 1, 2 ] = "<>"
|
||
|
*
|
||
|
* << Relational operators. >>
|
||
|
*
|
||
|
ucode := psource[ 1, 2 ]
|
||
|
psource = psource[ 3, len( psource )]
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case char1 = "=" or char1 = "#" or char1 = "<" or char1 = ">"
|
||
|
*
|
||
|
* << Relational operators. >>
|
||
|
*
|
||
|
ucode := char1
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
OPERATOR.LAST = true
|
||
|
*
|
||
|
case char1 = "("
|
||
|
*
|
||
|
* << Conversion code (conv) or parenthetical expression (n) >>
|
||
|
*
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
loop
|
||
|
temp = psource[ 1, 1 ]
|
||
|
while temp = " " do
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
repeat
|
||
|
psource = "(" : psource
|
||
|
if not( OPERATOR.LAST ) then
|
||
|
hold.psource = psource
|
||
|
psource = ""
|
||
|
op = 1; cp = 0; quit.loop = false
|
||
|
for k = 2 to len( hold.psource ) until quit.loop
|
||
|
if hold.psource[ k, 1 ] = "(" then
|
||
|
op += 1
|
||
|
end else
|
||
|
if hold.psource[ k, 1 ] = ")" then
|
||
|
cp += 1
|
||
|
end
|
||
|
end
|
||
|
if cp = op then
|
||
|
quit.loop = true
|
||
|
nbr.chars = k
|
||
|
end else
|
||
|
psource := hold.psource[ k, 1 ]
|
||
|
end
|
||
|
next k
|
||
|
conv.code = ""
|
||
|
index.type = index( "ACDFGLMPRSTU", psource[1,1], 1 )
|
||
|
if index.type < 1
|
||
|
then
|
||
|
call @DC.A( "A;":psource, conv.code, result )
|
||
|
end
|
||
|
else
|
||
|
call @DC.CORR.CONV( "", "", psource, conv.code, result )
|
||
|
end
|
||
|
if result then
|
||
|
ucode := hold.psource[ 1, nbr.chars ]
|
||
|
psource = hold.psource[ nbr.chars + 1, 999 ]
|
||
|
end
|
||
|
OPERATOR.LAST = false
|
||
|
end else
|
||
|
ucode := "("
|
||
|
psource = psource[ 2, len( psource )]
|
||
|
need.right.paren += 1
|
||
|
OPERATOR.LAST = true
|
||
|
end
|
||
|
*
|
||
|
case char1 = ";" or char1 = " " or char1 = "D" or char1 = "T"
|
||
|
*
|
||
|
* << Semicolon, spaces taken in. Likewise date and time. >>
|
||
|
*
|
||
|
ucode := psource[ 1, 1 ]
|
||
|
psource = psource[ 2, len( psource ) ]
|
||
|
if char1 = "D" or char1 = "T" then
|
||
|
OPERATOR.LAST = false
|
||
|
end
|
||
|
*
|
||
|
case 1
|
||
|
*
|
||
|
* << Conversion code, or error >>
|
||
|
*
|
||
|
call @DC.MESSAGE( "Invalid expression in A conversion: ", psource )
|
||
|
result = 0
|
||
|
return
|
||
|
end case
|
||
|
repeat
|
||
|
*
|
||
|
if need.right.paren <> 0 then
|
||
|
call @DC.MESSAGE( '"A" conversion missing closing parenthesis: ', ucode )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
*
|
||
|
if need.right.bracket <> 0 then
|
||
|
call @DC.MESSAGE( '"A" conversion missing closing bracket: ', ucode )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
*
|
||
|
if need.then <> 0 then
|
||
|
call @DC.MESSAGE( '"A" conversion conditional missing "THEN" clause: ', ucode )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
*
|
||
|
if need.else <> 0 then
|
||
|
call @DC.MESSAGE( '"A" conversion conditional missing "ELSE" clause: ', ucode )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
*
|
||
|
if need.comma <> 0 then
|
||
|
call @DC.MESSAGE( '"A" conversion text extraction missing comma: ', ucode )
|
||
|
result = 0
|
||
|
return
|
||
|
end
|
||
|
*
|
||
|
if psource[ 1, 1 ] = "]" or psource[ 1, 1 ] = "}" then
|
||
|
psource[ 1, 1 ] = @VM
|
||
|
return
|
||
|
end
|