{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2009 Ralf Junker, The Delphi Inspiration
 Internet: http://www.yunqa.de/delphi/
 E-Mail:   delphi@yunqa.de

-------------------------------------------------------------------------------}

unit DISQLite3RegExp;

{$I DI.inc}
{$I DISQLite3.inc}

{$IFDEF DISQLite3_Personal}
!!! This unit does not compile with DISQLite3 Personal      !!!
!!! Download DISQLite3 Pro from http:
{$ENDIF DISQLite3_Personal}

interface

uses
  DISystemCompat, DISQLite3Api;

type

  TDISQLite3RegexpOptions = record
    CompileOptions: Cardinal;
  end;
  PDISQLite3RegexpOptions = ^TDISQLite3RegexpOptions;

procedure sqlite3_create_function_regexp(const DB: sqlite3; const Options: PDISQLite3RegexpOptions = nil);

implementation

uses
  SysUtils, {$IFNDEF SUPPORTS_UNICODE_STRING}DITypes, {$ENDIF}
  DIRegEx_Api;

type
  TRegExp = record
    PCRE: Pointer;
    PcreExtra: PPcre_Extra;
  end;
  PRegExp = ^TRegExp;

procedure sqlite3_destroy_regexp(p: Pointer);
begin
  with PRegExp(p)^ do
    begin
      FreeMem(PcreExtra);
      FreeMem(PCRE);
    end;
  FreeMem(p);
end;

procedure sqlite3_regexp_func(pCtx: sqlite3_context; nArgs: Integer; Args: PPointerArray);
const
  BOOLEAN_TO_INT: array[Boolean] of Integer = (0, 1);
const
  PCRE_COMPILE_OPTIONS = PCRE_UTF8 or PCRE_NO_UTF8_CHECK;
  PCRE_EXEC_OPTIONS = PCRE_NO_UTF8_CHECK;
var
  AuxData: PRegExp;
  argptr: PAnsiChar;
  ArgLen: Integer;
  CompileOptions: Cardinal;
  ErrorMessage: Utf8String;
  Options: PDISQLite3RegexpOptions;
  PcreErrPtr: PAnsiChar;
  PcreErrOffset: Integer;
  PcreResult: Integer;
  p: Pointer;
begin
  AuxData := sqlite3_get_auxdata(pCtx, 0);
  if not Assigned(AuxData) then
    begin
      argptr := sqlite3_value_text(Args[0]);

      Options := sqlite3_user_data(pCtx);
      if Assigned(Options) then
        CompileOptions := Options^.CompileOptions or PCRE_COMPILE_OPTIONS
      else
        CompileOptions := PCRE_COMPILE_OPTIONS;

      GetMem(AuxData, SizeOf(AuxData^));
      sqlite3_set_auxdata(pCtx, 0, AuxData, sqlite3_destroy_regexp);

      AuxData^.PCRE := pcre_compile2(argptr, CompileOptions, nil, @PcreErrPtr, @PcreErrOffset, nil);
      if not Assigned(AuxData^.PCRE) then
        begin
          AuxData^.PcreExtra := nil;
          ErrorMessage := sqlite3_encode_utf8(Format('REGEXP: "%s" at offset %d', [PcreErrPtr, PcreErrOffset]));
          sqlite3_result_error(pCtx, Pointer(ErrorMessage), Length(ErrorMessage));
          Exit;
        end;

      AuxData^.PcreExtra := pcre_study(AuxData^.PCRE, 0, @PcreErrPtr);
      if Assigned(PcreErrPtr) then
        begin
          ErrorMessage := sqlite3_encode_utf8(Format('REGEXP: "%s"', [PcreErrPtr]));
          sqlite3_result_error(pCtx, Pointer(ErrorMessage), Length(ErrorMessage));
          Exit;
        end;
    end;

  p := Args[1];

  argptr := sqlite3_value_text(p);
  ArgLen := sqlite3_value_bytes(p);
  with AuxData^ do
    PcreResult := pcre_exec(PCRE, PcreExtra, argptr, ArgLen, 0, PCRE_EXEC_OPTIONS, nil, 0);
  sqlite3_result_int(pCtx, BOOLEAN_TO_INT[PcreResult >= 0]);
end;

procedure sqlite3_create_function_regexp(const DB: sqlite3; const Options: PDISQLite3RegexpOptions = nil);
begin
  sqlite3_check(sqlite3_create_function(DB, 'REGEXP', 2, SQLITE_UTF8, Options, sqlite3_regexp_func, nil, nil), DB);
end;

end.

