program parsertest;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, IBUtils
  { you can add units after this };

const
  TestStrings: array [0..4] of string = (
  'with recursive Depts As (' +
        'Select DEPT_NO, DEPARTMENT, "HEAD_DEPT", cast(DEPARTMENT  as VarChar(256)) as DEPT_PATH /* test */,' +
        'cast(DEPT_NO as VarChar(64)) as DEPT_KEY_PATH ' + LF +
        'From DEPARTMENT Where HEAD_DEPT is NULL ' + LF +
        'UNION ALL' + CRLF +
        'Select D.DEPT_NO, D.DEPARTMENT, D.HEAD_DEPT, Depts.DEPT_PATH ||  '' / '' || D.DEPARTMENT as DEPT_PATH,' +
        'Depts.DEPT_KEY_PATH || '';'' || D.DEPT_NO as DEPT_KEY_PATH ' +
        'From DEPARTMENT  D'+ CR +
        'JOIN Depts On D.HEAD_DEPT = Depts.DEPT_NO' + LF +
        ')' +
        '//ignore' + LF +
        'Select distinct A.EMP_NO, A.FIRST_NAME, A.LAST_NAME, A.PHONE_EXT, A.HIRE_DATE, A.DEPT_NO, A.JOB_CODE, 2.2, 2..30 '  +
        'A.JOB_GRADE, A.JOB_COUNTRY, A.SALARY, A.FULL_NAME, D.DEPT_PATH, D.DEPT_KEY_PATH' + LF +
        'From EMPLOYEE A' +  LF +
        'JOIN Depts D On D.DEPT_NO = A.DEPT_NO',
        'Update EMPLOYEE A Set '#13#10'  A.DEPT_NO = :DEPT_NO,'#13#10 +
        '  A.FIRST_NAME = ''Mr'' || :FIRST_NAME,'#13#10+
        '  A.HIRE_DATE = :HIRE_DATE,'#13#10+
        '  A.JOB_CODE = :JOB_CODE,'#13#10'  A.JOB_COUNTRY = :JOB_COUNTRY,'#13#10+
        '  A.JOB_GRADE = :JOB_GRADE,'#13#10'  A.LAST_NAME = :LAST_NAME,'#13#10+
        '  A.PHONE_EXT = :PHONE_EXT,'#13#10'  A.SALARY = :SALARY ' +
        'Where A.EMP_NO = :OLD_EMP_NO;',

        'INSERT INTO EMPLOYEE (EMP_NO, FIRST_NAME, LAST_NAME, PHONE_EXT, HIRE_DATE,' +
        'DEPT_NO, JOB_CODE, JOB_GRADE, JOB_COUNTRY, SALARY /* what''s this */) '+
        'VALUES (:EMP_NO, :FIRST_NAME, :LAST_NAME, :PHONE_EXT, :HIRE_DATE, //end comment' + CRLF +
        ':DEPT_NO, :"JOB""CODE", ''Tester''''s way'''''''''', :JOB_COUNTRY, :"$SALARY")',
        'Select * from EMPLOYEE Where EMP_NO = :EMP_NO',
        '')  ;

type

  { SQLParserTest }

  SQLParserTest = class(TCustomApplication)
  private
    procedure WriteToken(token: TSQLTokens; text: string);
    procedure AnalyseSQL(S: string);
    procedure AnalyseAll;
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;

  { TSQLStringTokeniser }

  TSQLStringTokeniser = class(TSQLwithNamedParamsTokeniser)
//  TSQLStringTokeniser = class(TSQLTokeniser)
  private
    FInString: string;
    FIndex: integer;
  protected
    function GetChar: char; override;
  public
    constructor Create(S: string);
  end;

  { TSQLStringTokeniser }

  function TSQLStringTokeniser.GetChar: char;
  begin
    if FIndex <= Length(FInString) then
    begin
      Result := FInString[FIndex];
      Inc(FIndex);
    end
    else
      Result := #0;
  end;

  constructor TSQLStringTokeniser.Create(S: string);
  begin
    inherited Create;
    FInString := S;
    FIndex := 1;
  end;

{ SQLParserTest }

procedure SQLParserTest.WriteToken(token: TSQLTokens; text: string);
begin
  case token of
  sqltSpace:
     write('sqltSpace ');
  sqltSemiColon:
     write('sqltSemiColon ');
  sqltPlaceholder:
     write('sqltPlaceholder ');
  sqltPipe:
     write('sqltPipe ');
  sqltSingleQuotes:
     write('sqltSingleQuotes ');
  sqltDoubleQuotes:
     write('sqltDoubleQuotes ');
  sqltComma:
     write('sqltComma ');
  sqltEquals:
     write('sqltEquals ');
  sqltPeriod:
    write('sqltPeriod ');
  sqltIdentifier:
     write('sqltIdentifier ');
  sqltIdentifierInDoubleQuotes:
     write('sqltIdentifierInDoubleQuotes ');
  sqltNumberString:
     write('sqltNumberString ');
  sqltBadIdentifier:
     write('sqltBadIdentifier ');
  sqltString:
     write('sqltString ');
  sqltParam:
     write('sqlParam ');
  sqltQuotedParam:
    write('sqltQuotedParam ');
  sqltColon:
     write('sqltColon ');
  sqltComment:
     write('sqltComment ');
  sqltCommentLine:
     write('sqltCommentLine ');
  sqltQuotedString:
     write('sqltQuotedString ');
  sqltAsterisk:
     write('sqltAsterisk ');
  sqltForwardSlash:
     write('sqltForwardSlash ');
  sqltOpenSquareBracket:
     write('sqltOpenSquareBracket ');
  sqltCloseSquareBracket:
     write('sqltCloseSquareBracket ');
  sqltOpenBracket:
     write('sqltOpenBracket ');
  sqltCloseBracket:
     write('sqltCloseBracket ');
  sqltCR:
     write('sqltCR ');
  sqltEOL:
     write('sqltEOL ');
  sqltEOF:
    write('sqltEOF ');
  end;
  writeln('"',text,'" ');
end;

procedure SQLParserTest.AnalyseSQL(S: string);
var SQLTokeniser: TSQLTokeniser;
begin
  SQLTokeniser := TSQLStringTokeniser.Create(S);
  try
    writeln('Analysing:');
    writeln(S);
    writeln;
    while not SQLTokeniser.EOF do
      WriteToken(SQLTokeniser.GetNextToken,SQLTokeniser.TokenText);
  finally
    SQLTokeniser.Free;
  end;
end;

procedure SQLParserTest.AnalyseAll;
var i: integer;
begin
  for i := 0 to length(TestStrings) -1 do
    AnalyseSQL(TestStrings[i]);
end;

procedure SQLParserTest.DoRun;
var
  ErrorMsg: String;
begin
  // quick check parameters
  ErrorMsg := CheckOptions('h', 'help');
  if ErrorMsg <> '' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;

  // parse parameters
  if HasOption('h', 'help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;

  { add your program here }
  AnalyseAll;
  Flush(output);
  readln;

  // stop program loop
  Terminate;
end;

constructor SQLParserTest.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
end;

destructor SQLParserTest.Destroy;
begin
  inherited Destroy;
end;

procedure SQLParserTest.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ', ExeName, ' -h');
end;

var
  Application: SQLParserTest;
begin
  Application := SQLParserTest.Create(nil);
  Application.Title := 'SQL Parser Test';
  Application.Run;
  Application.Free;
end.