home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PRECOM.ZIP / PARSEVAR.MOD < prev    next >
Text File  |  1992-12-04  |  10KB  |  398 lines
  1. IMPLEMENTATION MODULE ParseVar;
  2. FROM Str IMPORT Copy,Pos,Slice,Length,StrToCard,Compare,Subst,
  3.      Append,NextPos,Length;
  4. FROM Lists IMPORT GenList,StrElmt;
  5. FROM Lib IMPORT Fill;
  6. FROM SQLCA IMPORT sqlca;
  7. FROM SQLTypes IMPORT LongVChar;
  8. IMPORT SQLPREP;
  9.  
  10. (* Manages the host variables
  11.     Builds list of host variables
  12.     registers the host variables as found
  13.     returns ID of host variables
  14.  
  15. *)
  16.  
  17.  
  18. TYPE
  19.   M2Sql = RECORD
  20.     M2Type : ARRAY[0..30] OF CHAR;
  21.     SqlNbr : CARDINAL;
  22.     M2Len  : CARDINAL;
  23.     ObjectSuffix : ARRAY[0..10] OF CHAR;
  24.   END;
  25.   CharSet = SET OF CHAR;
  26.  
  27.  
  28. CONST
  29.   MaxM2Types = 30;
  30.   ValidChar = CharSet{'0'..'9','A'..'Z','a'..'z','_', '[',']','.'};
  31.   SQLChars  = CharSet{'0'..'9','A'..'Z','a'..'z',':',',','.','_','*',
  32.                       '^','=','>','<','(',')','"',"'",'/','+','-'};
  33.   TermSet   = CharSet{' ',',',':',')','('};
  34.  
  35. VAR
  36.   M2Types : ARRAY[0..MaxM2Types] OF M2Sql;
  37.  
  38.  
  39. PROCEDURE Pack(VAR Str : ARRAY OF CHAR);
  40. (* remove blanks and other non-character stuff *)
  41. VAR
  42.   S : ARRAY[0..80] OF CHAR;
  43.   J,K : CARDINAL;
  44.  
  45. BEGIN
  46.   Copy(S,Str);
  47.   Fill(ADR(Str),HIGH(Str),0);
  48.   J := 0;
  49.   K := 0;
  50.   WHILE J <= Length(S) DO
  51.     IF S[J] IN ValidChar
  52.       THEN
  53.         Str[K] := S[J];
  54.         INC(K);
  55.       END;
  56.       INC(J);
  57.   END;
  58.  
  59. END Pack;
  60.  
  61.  
  62. PROCEDURE RemoveComment(VAR Line : ARRAY OF CHAR; VAR InComment: CARDINAL);
  63. VAR Str : ARRAY[0..300] OF CHAR;
  64.     J,K : CARDINAL;
  65.    (* remove comments from the input line *)
  66.    (* if will handle the case of nested comments and comments that span*)
  67.    (* multiple lines *)
  68.    (* will not handle the case of comment immediatly followed by comment*)
  69.    (* with no space between (i.e.  *)
  70.  
  71. BEGIN
  72.   Copy(Str,Line);
  73.   Fill(ADR(Line),SIZE(Line),0);
  74.   J := 0;
  75.   K := 0;
  76.   WHILE J < Length(Str) DO
  77.     IF (Str[J] = '(') AND (Str[J+1] = '*' )
  78.       THEN INC(InComment);
  79.       END;
  80.     IF (Str[J] = '*') AND (Str[J+1] = ')')
  81.       THEN
  82.         DEC(InComment);
  83.         INC(J,2);
  84.       END;
  85.     IF InComment = 0
  86.       THEN
  87.         Line[K] := Str[J];
  88.         INC(K);
  89.       END;
  90.     INC(J);
  91.    END;   (* end of while *)
  92. END RemoveComment;
  93.  
  94.  
  95. VAR
  96.   Location : CARDINAL;
  97. PROCEDURE AddHostVar(Name : ARRAY OF CHAR;type,Len : CARDINAL; InSection : BOOLEAN);
  98. VAR J : CARDINAL;
  99.     LJ : LONGCARD;
  100.     RC : CARDINAL;
  101.     L : CARDINAL;
  102.     CA : sqlca;
  103. BEGIN
  104.  INC(ProgVars.used);
  105.  J := ProgVars.used;
  106.  IF InSection
  107.    THEN Location := SQLPREP.SQLA_DECLARE_SECT
  108.    ELSE Location := SQLPREP.SQLA_SQL_STMT;
  109.         type := 0;
  110.         Len  := 0;
  111.    END;
  112.  Copy(ProgVars.Vars[J].Name,Name);
  113.  ProgVars.Vars[J].Type := type;
  114.  ProgVars.Vars[J].Len  := Len;
  115.  ProgVars.Vars[J].ID   := J;
  116.  L :=  Length(Name);
  117.  LJ := LONGCARD(J);
  118.  RC := SQLPREP.SQLGAHVR(L,Name,type,Len,LJ,Location,NIL,CA);
  119. END AddHostVar;
  120.  
  121.  
  122.  
  123.  
  124.  
  125. PROCEDURE GetVarType(VarType : ARRAY OF CHAR; VAR SqlType, Len : CARDINAL): BOOLEAN;
  126.  VAR
  127.    ArrayBeginVal, ArrayEndVal : CARDINAL;
  128.    J : CARDINAL;
  129.    B,E : CARDINAL;
  130.    S : ARRAY[0..5] OF CHAR;
  131.    Ok : BOOLEAN;
  132.    ArraySize : CARDINAL;
  133.  
  134. BEGIN
  135.      (* if an array was specified - get size of array *)
  136.  
  137.   ArraySize := 1;     (* assume no array *)
  138.   IF Pos(VarType,'[') < MAX(CARDINAL)  (* calc the size of array*)
  139.    THEN
  140.      B := Pos(VarType,'[');
  141.      E := Pos(VarType,'..');
  142.      Slice(S,VarType,B+1,(E-B-1));   (* isolate the variable type *)
  143.      ArrayBeginVal := CARDINAL(StrToCard(S,10,Ok));
  144.      B := Pos(VarType,'..');
  145.      E := Pos(VarType,']');
  146.      Slice(S,VarType,B+2,(E-B-2));
  147.      ArrayEndVal := CARDINAL(StrToCard(S,10,Ok));
  148.      ArraySize := (ArrayEndVal - ArrayBeginVal + 1);
  149.    END;
  150.  
  151.   J := 0;   (* now look up the var type in the type table *)
  152.   LOOP
  153.     IF J > MaxM2Types
  154.       THEN
  155.         SqlType := 0;
  156.         Len     := 0;
  157.         RETURN FALSE;  (* var type not found - dont add*)
  158.       END;
  159.       IF Pos(VarType,M2Types[J].M2Type) < MAX(CARDINAL)
  160.         THEN EXIT;
  161.         ELSE INC(J);
  162.       END;
  163.   END; (* end of loop *)
  164.     (* J now points to the type of m2 variable *)
  165.  
  166.   SqlType := M2Types[J].SqlNbr;
  167.   Len := M2Types[J].M2Len * ArraySize;
  168.   RETURN TRUE;
  169.  
  170. END GetVarType;
  171.  
  172. PROCEDURE GetVars(Line : ARRAY OF CHAR;VAR InComment: CARDINAL);
  173. (* all variables must be typed on the same line *)
  174. VAR
  175.   P : CARDINAL;
  176.   VarName : ARRAY[0..30] OF CHAR;
  177.   M2Type  : ARRAY[0..40] OF CHAR;
  178.   SqlType : CARDINAL;
  179.   VarLen  : CARDINAL;
  180. BEGIN
  181.  RemoveComment(Line,InComment);
  182.  P := Pos(Line,':');    (* if a variable in this line *)
  183.  IF P = MAX(CARDINAL)   (* no variable on this line *)
  184.    THEN RETURN;
  185.    END;
  186.  Slice(VarName,Line,0,P); (* get the left side of var type*)
  187.  Slice(M2Type,Line,P+1,Length(Line)); (* get the type *)
  188.  Subst(M2Type,'OF','  ');
  189.  Pack(M2Type);
  190.  Pack(VarName);
  191.  IF GetVarType(M2Type,SqlType,VarLen)
  192.    THEN AddHostVar(VarName,SqlType,VarLen,TRUE);
  193.    END;
  194.  
  195. (* based on the M2 type - assign an SQL type *)
  196.  
  197.  
  198. END GetVars;
  199.  
  200.   (* given a host variable, return the variable ID*)
  201.  
  202.  
  203.  
  204.  
  205. PROCEDURE GetID(VarName : ARRAY OF CHAR): LONGCARD;
  206.  
  207. (* given the var name in this instance - remove any prefix stuff and
  208.    save.  This will allow a variable to have a record qualifier or
  209.    a pointer to the variable.
  210.  
  211.  
  212.    e.g.   RecName.Varname  (save the "RecName." return ID for Varname)
  213.           Point^Varname   (save the "Point^" return ID for Varname)
  214.           Rec.Point^.Varname (save the "Rec.Point^." return ID for Varname)
  215.  
  216.  
  217.    Expressions are not allowed - (e.g. VarName1 + VarName2 )
  218.       John - Maybe you could fix this
  219. *)
  220.  
  221. CONST
  222.  
  223.   PrefixSet = CharSet{'^','.'};
  224.  
  225.  
  226. VAR J : CARDINAL;
  227.     Prefix : ARRAY[0..30] OF CHAR;
  228.     TmpStr : ARRAY[0..40] OF CHAR;
  229.  
  230. BEGIN
  231.  
  232.  J := Length(VarName);
  233.  Fill(ADR(Prefix),SIZE(Prefix),0);  (* insure no residule junk*)
  234.  IF J = 0
  235.    THEN  RETURN 0;
  236.    END;
  237.  
  238.  
  239.  LOOP
  240.    IF VarName[J] IN PrefixSet   (* prefix exists - save *)
  241.      THEN
  242.        Slice(Prefix,VarName,0,J+1);
  243.        Slice(TmpStr,VarName,J+1,Length(VarName));
  244.        EXIT;
  245.      END;
  246.    DEC(J);
  247.    IF J = 0
  248.      THEN
  249.        Copy(TmpStr,VarName);
  250.        EXIT;
  251.      END;
  252.  END; (* end of loop *)
  253.  
  254.  J := 1;
  255.  LOOP
  256.    IF Compare(ProgVars.Vars[J].Name, TmpStr) = 0
  257.      THEN EXIT;
  258.      END;
  259.    INC(J);
  260.    IF J > MaxVars   (* the var wasn't found - assume sqlda in a statement *)
  261.      THEN AddHostVar(TmpStr,0,0,FALSE);  (* was not found in declare section*)
  262.           RETURN GetID(VarName);
  263.           EXIT;
  264.      END;
  265.  END;
  266.  Copy(ProgVars.Vars[J].Prefix,Prefix);  (* save prefix for subsequent getvar name*)
  267.  RETURN LONGCARD(J);
  268. END GetID;
  269.  
  270. PROCEDURE GetVarName(VAR VarName : ARRAY OF CHAR;
  271.                      VAR type,len : CARDINAL;
  272.                          ID : LONGCARD);
  273. VAR
  274.   J : CARDINAL;
  275. BEGIN
  276.   J := CARDINAL(ID);
  277.   Copy(VarName,ProgVars.Vars[J].Prefix);
  278.   Append(VarName,ProgVars.Vars[J].Name);
  279.   Append(VarName,ProgVars.Vars[J].Suffix);
  280.   type := ProgVars.Vars[J].Type;
  281.   len  := ProgVars.Vars[J].Len
  282. END GetVarName;
  283.  
  284.  
  285. PROCEDURE SQLStatement(Line : ARRAY OF CHAR): BOOLEAN;
  286. (* return true if line contains EXEC SQL *)
  287.  
  288. BEGIN
  289.   IF (Pos(Line,'EXEC SQL') < MAX(CARDINAL))
  290.     THEN RETURN TRUE
  291.     ELSE RETURN FALSE;
  292.   END;
  293.  
  294. END SQLStatement;
  295.  
  296.  
  297. PROCEDURE PrepareSQL(VAR Line : ARRAY OF CHAR; VAR Token: SQLPREP.sqla_tokens);
  298. (* parse the sql statement and fill the  Token with any host variables *)
  299. VAR
  300.   NbrTokens: CARDINAL;
  301.   J,K : CARDINAL;
  302.   Str : ARRAY[0..30] OF CHAR;
  303. BEGIN
  304.   NbrTokens := 0;
  305.   Subst(Line,'EXEC SQL','  ');  (* get rid of the exec sql part of line*)
  306.   Subst(Line,';',' ');          (* get rid of ';' *)
  307.  
  308.   J := 0;
  309.   LOOP
  310.     J := NextPos(Line,':',J);
  311.     IF J = MAX(CARDINAL)
  312.       THEN Token.Header.used := LONGCARD(NbrTokens);
  313.            EXIT;
  314.       END;
  315.    INC(J);
  316.    K := 0;
  317.    Fill(ADR(Str),SIZE(Str),0);
  318.  
  319.     LOOP
  320.  
  321.       IF NOT (Line[J] IN TermSet)
  322.         THEN
  323.           Str[K] := Line[J];
  324.           Line[J] := ' ';
  325.           INC(J);
  326.           INC(K);
  327.         ELSE    (* end of get var *)
  328.           EXIT;
  329.        END;
  330.     END;
  331.     INC(NbrTokens);
  332.     Token.Tokens[NbrTokens].tokenID := GetID(Str);
  333.   END;
  334.  
  335. (* get rid of any non sql characters (LF/CR tab etc); *)
  336.  FOR J := 0 TO Length(Line)-1 DO
  337.    IF NOT (Line[J] IN SQLChars)
  338.      THEN
  339.        Line[J] := ' ';
  340.      END;
  341.  
  342.  END;
  343.  
  344.  
  345. END PrepareSQL;
  346.  
  347.  
  348. PROCEDURE AssignM2Type(Nbr : CARDINAL;
  349.                        Name,Suffix : ARRAY OF CHAR; SNbr : CARDINAL; L : CARDINAL);
  350. BEGIN
  351.   WITH M2Types[Nbr] DO
  352.     Copy(M2Type,Name);
  353.     Copy(ObjectSuffix,Suffix);
  354.     SqlNbr := SNbr;
  355.     M2Len := L;
  356.   END;
  357. END AssignM2Type;
  358.  
  359.  
  360.  
  361.  
  362.  
  363. BEGIN   (* initialization code *)
  364.   Fill(ADR(M2Types),SIZE(M2Types),0);
  365.   Fill(ADR(ProgVars),SIZE(ProgVars),0);
  366.   Location := 0;
  367.   AssignM2Type(0,'LONGREAL','',480,8);
  368.   AssignM2Type(1,'CHAR','',460,1);        (* Assume var length char *)
  369.   AssignM2Type(2,'CARDINAL','',500,2);
  370.   AssignM2Type(3,'LONGCARD','',496,4);
  371.   AssignM2Type(4,'INTEGER','',500,2);
  372.   AssignM2Type(5,'LONGINT','',496,4);
  373.   AssignM2Type(6,'BYTE','',452,1);
  374.   AssignM2Type(7,'BOOLEAN','',452,1);
  375.   AssignM2Type(8,'REAL','',480,4);
  376.   AssignM2Type(9,'FCHAR','',500,1);        (* fixed length char *)
  377.   AssignM2Type(10,'Date','',384,10);
  378.   AssignM2Type(11,'Time','',388,8);
  379.   AssignM2Type(12,'TimeStamp','',392,26);
  380.   AssignM2Type(13,'LongVChar','',456,SIZE(LongVChar));
  381.  
  382. (* SQL Objects that are supported *)
  383.  
  384.   AssignM2Type(14,'RealObj','.LR',480,8);
  385.   AssignM2Type(15,'CHAR','',460,1);        (* Assume var length char *)
  386.   AssignM2Type(16,'CardObj','.Card',500,2);
  387.   AssignM2Type(17,'LongIntObj','.LI',496,4);
  388.   AssignM2Type(18,'BoolObj','.B',452,1);
  389.   AssignM2Type(19,'FcharObj','.DataPnt',500,1);        (* fixed length char *)
  390.   AssignM2Type(20,'DateObj','.D',384,10);
  391.   AssignM2Type(21,'TimeObj','.TM',388,8);
  392.   AssignM2Type(22,'TStmpObj','.TS',392,26);
  393.   AssignM2Type(23,'MLEObj','.DataPnt',456,SIZE(LongVChar));
  394.  
  395. END ParseVar.
  396. 
  397. 
  398.