
//////////////////////////////////////////////////
//  Oracle Data Access Components
//  Copyright © 1998-2014 Devart. All right reserved.
//  Ora Parser
//////////////////////////////////////////////////

{$IFNDEF CLR}
{$I Odac.inc}
unit OraParserUni;
{$ENDIF}

interface

uses
  Classes, SysUtils, CRTypes, CRParser;

var
  OraKeywordLexems: TIntValueStringList;

const
  lxOraFirst  = 1000;
  lxALTER     = lxOraFirst;
  lxBODY      = lxALTER + 1;
  lxCONNECT   = lxBODY + 1;
  lxCREATE    = lxCONNECT + 1;
  lxDECLARE   = lxCREATE + 1;
  lxDEFINE    = lxDECLARE + 1;
  lxDISCONNECT = lxDEFINE + 1;
  lxEND       = lxDISCONNECT + 1;
  lxEXIT      = lxEND + 1;
  lxEXPLAIN   = lxEXIT + 1;
  lxFUNCTION  = lxEXPLAIN + 1;
  lxJAVA      = lxFUNCTION + 1;
  lxPACKAGE   = lxJAVA + 1;
  lxPARTITION = lxPACKAGE + 1;
  lxPAUSE     = lxPARTITION + 1;
  lxPROCEDURE = lxPAUSE + 1;
  lxPROMPT    = lxPROCEDURE + 1;
  lxQUIT      = lxPROMPT + 1;
  lxREM       = lxQUIT + 1;
  lxREMARK    = lxREM + 1;
  lxREPLACE   = lxREMARK + 1;
  lxSTART     = lxREPLACE + 1;
  lxTRIGGER   = lxSTART + 1;
  lxTYPE      = lxTRIGGER + 1;
  lxUNDEFINE  = lxTYPE + 1;
  lxUNIQUE    = lxUNDEFINE + 1;
  lxWRAPPED   = lxUNIQUE + 1;

type
  TOraParser = class (TSQLParser)
  private
    FInWrapped: boolean;
  protected
    procedure InitParser; override;
  public
    function GetNext(out Lexem: string): integer; override;
    function IsMacroAllowed(Code: integer): boolean; override;
    class function IsNumericMacroNameAllowed: boolean; override;
    class function IsSelectModifier(Code: integer): boolean; override;
    class function IsFunctionOrConst(const UpperedName: string): boolean; override;
    class function IsQuasiColumn(const UpperedName: string): boolean; override;
  end;

implementation

{ TOraParser }

procedure TOraParser.InitParser;
begin
  inherited;

  FInWrapped := False;
  FKeywordLexems := OraKeywordLexems;
  CommentBegin := '/*';
  CommentEnd := '*/';
  AlternativeQuoting := True;

  SetLength(FClauses, 10);
  FClauses[0] := lxWHERE;
  FClauses[1] := lxSTART;
  FClauses[2] := lxCONNECT;
  FClauses[3] := lxGROUP;
  FClauses[4] := lxHAVING;
  FClauses[5] := lxUNION;
  FClauses[6] := lxINTERSECT;
  FClauses[7] := lxMINUS;
  FClauses[8] := lxORDER;
  FClauses[9] := lxFOR; 
end;

function TOraParser.GetNext(out Lexem: string): integer;
var
  Code: Integer;
  Stm: string;
  StartPos: Integer;
  BlankLine: boolean;
  InWrappedDelimiter: boolean;
begin
  if not FInWrapped then begin
    Result := inherited GetNext(Lexem);
    if Result = lxWRAPPED then
      FInWrapped := True;
  end
  else begin
    // return all wrapped code as single string
    InWrappedDelimiter := False;
    BlankLine := False;
    StartPos := CurrPos + 1;
    while True do begin
      Code := inherited GetNext(Stm);
      if Code = lcEnd then
        break
      else if BlankLine and (Stm = '/') then
        InWrappedDelimiter := True
      else if (Code <> lcBlank) and (Code <> lcComment) then begin
        InWrappedDelimiter := False;
        BlankLine := False;
      end
      else if (PrevLine < CurrLine) then begin
        if InWrappedDelimiter then
          break
        else
          BlankLine := True;
      end;
    end;

    FInWrapped := False;
    Result := lcString;
    Lexem := CopyText(StartPos, CurrPos - StartPos + 1);
  end
end;

function TOraParser.IsMacroAllowed(Code: integer): boolean;
begin
  if FInWrapped then
    Result := False
  else
    Result := inherited IsMacroAllowed(Code);
end;

class function TOraParser.IsNumericMacroNameAllowed: boolean;
begin
  Result := True;
end;

class function TOraParser.IsSelectModifier(Code: integer): boolean;
begin
  Result := inherited IsSelectModifier(Code) or (Code = lxUNIQUE);
end;

class function TOraParser.IsFunctionOrConst(const UpperedName: string): boolean;
begin
  if inherited IsFunctionOrConst(UpperedName) or
    (UpperedName = 'SYSDATE') or
    (UpperedName = 'USER') or
    (UpperedName = 'UID')
  then
    Result := True
  else
    Result := False;
end;

class function TOraParser.IsQuasiColumn(const UpperedName: string): boolean;
begin
  if UpperedName = 'ROWID' then
    Result := True
  else
    Result := False;
end;

initialization
  OraKeywordLexems := TIntValueStringList.Create;
  OraKeywordLexems.Assign(SQLKeywordLexems);

  OraKeywordLexems.Add('ALTER',     lxALTER    );
  OraKeywordLexems.Add('BODY',      lxBODY     );
  OraKeywordLexems.Add('CONNECT',   lxCONNECT  );
  OraKeywordLexems.Add('CREATE',    lxCREATE   );
  OraKeywordLexems.Add('DECLARE',   lxDECLARE  );
  OraKeywordLexems.Add('DEFINE',    lxDEFINE   );
  OraKeywordLexems.Add('DISCONNECT', lxDISCONNECT);
  OraKeywordLexems.Add('END',       lxEND      );
  OraKeywordLexems.Add('EXIT',      lxEXIT     );
  OraKeywordLexems.Add('EXPLAIN',   lxEXPLAIN  );
  OraKeywordLexems.Add('FUNCTION',  lxFUNCTION );
  OraKeywordLexems.Add('JAVA',      lxJAVA     );
  OraKeywordLexems.Add('PACKAGE',   lxPACKAGE  );
  OraKeywordLexems.Add('PAUSE',     lxPAUSE    );
  OraKeywordLexems.Add('PARTITION', lxPARTITION);
  OraKeywordLexems.Add('PROCEDURE', lxPROCEDURE);
  OraKeywordLexems.Add('PROMPT',    lxPROMPT   );
  OraKeywordLexems.Add('QUIT',      lxQUIT     );
  OraKeywordLexems.Add('REM',       lxREM      );
  OraKeywordLexems.Add('REMARK',    lxREMARK   );
  OraKeywordLexems.Add('REPLACE',   lxREPLACE  );
  OraKeywordLexems.Add('START',     lxSTART    );
  OraKeywordLexems.Add('TRIGGER',   lxTRIGGER  );
  OraKeywordLexems.Add('TYPE',      lxTYPE     );
  OraKeywordLexems.Add('UNDEFINE',  lxUNDEFINE );
  OraKeywordLexems.Add('WRAPPED',   lxWRAPPED  );
  OraKeywordLexems.Sort;

finalization
  OraKeywordLexems.Free;
end.
