{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2021 Ralf Junker, Yunqa
 Internet: https://www.yunqa.de
 E-Mail:   delphi@yunqa.de

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

unit DISQLite3RegExp2;

{$I DICompilers.inc}
{$I DISQLite3.inc}

{$IFDEF DISQLite3_Personal}
' This file requires functionality unavailable in DISQLite3 Personal. '
' To compile, download DISQLite3 Pro from www.yunqa.de.               '
{$ENDIF DISQLite3_Personal}

interface

uses
  DISystemCompat,

  DISQLite3Api, YuPcre2;

type

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

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

const
  REGEXP_FUNC_NAME = 'regexp';

procedure sqlite3_create_function_regextract(
  const DB: sqlite3_ptr;
  const Options: PDISQLite3RegexpOptions = nil);

const

  REGEXTRACT_FUNC_NAME = 'regextract';

procedure sqlite3_create_function_regexp_replace(
  const DB: sqlite3_ptr);

const

  REGEXP_REPLACE_FUNC_NAME = 'regexp_replace';

  REGEXP_REPLACE_INVALID_MATCH_PARAM =
    REGEXP_REPLACE_FUNC_NAME + '(): Invalid match_param argument';
  REGEXP_REPLACE_OCCURRENCE_ERROR =
    REGEXP_REPLACE_FUNC_NAME + '(): Occurrence argument must be non-negative integer';
  REGEXP_REPLACE_OCCURRENCE_NOT_SUPPORTED_ERROR =
    REGEXP_REPLACE_FUNC_NAME + '(): Occurrence values other than 0 not supported';
  REGEXP_REPLACE_POSITION_ERROR =
    REGEXP_REPLACE_FUNC_NAME + '(): Position argument must be a positive integer';

implementation

uses
  {$IFDEF HAS_UNITSCOPE}
  System.SysUtils,
  {$ELSE HAS_UNIT_SCOPE}
  SysUtils,
  {$ENDIF HAS_UNIT_SCOPE}
  {$IFNDEF SUPPORTS_UNICODE_STRING}DITypes, {$ENDIF}
  YuUtf,
  YuPcre2_RegEx2;

const
  BOOLEAN_TO_INT: array[Boolean] of Integer = (0, 1);

  PCRE2_COMPILE_OPTIONS = PCRE2_UTF or PCRE2_NO_UTF_CHECK;
  PCRE2_MATCH_OPTIONS = PCRE2_NO_UTF_CHECK;

type
  regexp_aux0 = record
    Code: pcre2_code_8_ptr;
    MatchData: pcre2_match_data_8_ptr;
  end;
  regexp_aux0_ptr = ^regexp_aux0;

procedure regexp_aux0_destroy(p: C_void_ptr);
var
  Aux0: regexp_aux0_ptr;
begin
  Aux0 := p;
  if Assigned(Aux0) then
    begin
      pcre2_match_data_free_8(Aux0.MatchData);
      pcre2_code_free_8(Aux0.Code);
      FreeMem(p);
    end;
end;

procedure sqlite3_regexp_func(pCtx: sqlite3_context_ptr; nArgs: Integer; Args: sqlite3_value_ptr_array_ptr);
var
  Aux0: regexp_aux0_ptr;
  ArgPtr: PAnsiChar;
  ArgLen: Integer;
  CompileOptions: C_uint32_t;
  ErrorMessage: Utf8String;
  Options: PDISQLite3RegexpOptions;
  Pcre2ErrorCode: C_int;
  Pcre2ErrorOffset: PCRE2_SIZE;
  Pcre2Result: C_int;
  p: sqlite3_value_ptr;
begin
  Aux0 := sqlite3_get_auxdata(pCtx, 0);
  if not Assigned(Aux0) then
    begin

      Aux0 := AllocMem(SizeOf(Aux0^));
      sqlite3_set_auxdata(pCtx, 0, Aux0, regexp_aux0_destroy);

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

      p := Args[0];
      ArgPtr := sqlite3_value_text(p);
      ArgLen := sqlite3_value_bytes(p);
      Aux0^.Code := pcre2_compile_8(ArgPtr, ArgLen, CompileOptions,
        @Pcre2ErrorCode, @Pcre2ErrorOffset, nil);
      if not Assigned(Aux0^.Code) then
        begin
          ErrorMessage := sqlite3_encode_utf8(Format(
            REGEXP_FUNC_NAME + '(): Pattern error "%s" at offset %d', [
            pcre2_get_error_message_str(Pcre2ErrorCode), Pcre2ErrorOffset]));
          sqlite3_result_error_str(pCtx, ErrorMessage);
          Exit;
        end;

      Aux0^.MatchData := pcre2_match_data_create_8(0, nil);
    end;

  p := Args[1];
  ArgPtr := sqlite3_value_text(p);
  ArgLen := sqlite3_value_bytes(p);
  Pcre2Result := pcre2_match_8(Aux0^.Code, ArgPtr, ArgLen, 0,
    PCRE2_MATCH_OPTIONS, Aux0^.MatchData, nil);
  sqlite3_result_int(pCtx, BOOLEAN_TO_INT[Pcre2Result >= 0]);
end;

procedure sqlite3_create_function_regexp(const DB: sqlite3_ptr; const Options: PDISQLite3RegexpOptions = nil);
begin
  sqlite3_check(sqlite3_create_function(DB, REGEXP_FUNC_NAME, 2,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, Options, sqlite3_regexp_func, nil, nil), DB);
end;

type
  regextract_aux0 = record
    Code: pcre2_code_8_ptr;
    nSubStr: C_int;
    MatchData: pcre2_match_data_8_ptr;
  end;
  regextract_aux0_ptr = ^regextract_aux0;

  regextract_aux2 = record
    pSubStr: C_char_ptr;
    nSubStr: C_int;
  end;
  regextract_aux2_ptr = ^regextract_aux2;

procedure regextract_aux0_destroy(p: C_void_ptr);
var
  Aux0: regextract_aux0_ptr;
begin
  Aux0 := p;
  if Assigned(Aux0) then
    begin
      pcre2_match_data_free_8(Aux0.MatchData);
      pcre2_code_free_8(Aux0.Code);
      FreeMem(Aux0);
    end;
end;

procedure regextract_aux2_destroy(p: C_void_ptr);
begin
  FreeMem(p);
end;

procedure sqlite3_regextract_func(pCtx: sqlite3_context_ptr; nArgs: Integer; Args: sqlite3_value_ptr_array_ptr);
var
  Aux0: regextract_aux0_ptr;
  Aux2: regextract_aux2_ptr;
  AuxChanged: Boolean;
  ArgPtr: C_char_ptr;
  ArgLen: C_int;
  CompileOptions: C_uint32_t;
  ErrorMessage: Utf8String;
  nSubStrStart, nSubStrEnd: PCRE2_SIZE;
  Options: PDISQLite3RegexpOptions;
  Pcre2ErrorCode: C_int;
  Pcre2ErrorOffset: PCRE2_SIZE;
  Pcre2Result: C_int;
  p: sqlite3_value_ptr;
begin
  AuxChanged := False;

  Aux0 := sqlite3_get_auxdata(pCtx, 0);
  if not Assigned(Aux0) then
    begin
      Aux0 := AllocMem(SizeOf(Aux0^));
      sqlite3_set_auxdata(pCtx, 0, Aux0, regextract_aux0_destroy);

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

      p := Args[0];
      ArgPtr := sqlite3_value_text(p);
      ArgLen := sqlite3_value_bytes(p);
      Aux0^.Code := pcre2_compile_8(ArgPtr, ArgLen, CompileOptions,
        @Pcre2ErrorCode, @Pcre2ErrorOffset, nil);
      if not Assigned(Aux0^.Code) then
        begin
          ErrorMessage := sqlite3_encode_utf8(Format(
            REGEXTRACT_FUNC_NAME + '(): Pattern error "%s" at offset %d', [
            pcre2_get_error_message_str(Pcre2ErrorCode), Pcre2ErrorOffset]));
          sqlite3_result_error_str(pCtx, ErrorMessage);
          Exit;
        end;

      pcre2_pattern_info_8(Aux0^.Code, PCRE2_INFO_CAPTURECOUNT, @Aux0^.nSubStr);
      Aux0^.MatchData := pcre2_match_data_create_from_pattern_8(Aux0^.Code, nil);

      AuxChanged := True;
    end;

  Aux2 := sqlite3_get_auxdata(pCtx, 2);
  if not Assigned(Aux2) then
    begin
      Aux2 := AllocMem(SizeOf(Aux2^));
      sqlite3_set_auxdata(pCtx, 2, Aux2, regextract_aux2_destroy);
      if nArgs = 3 then
        begin
          p := Args[2];
          case sqlite3_value_type(p) of
            SQLITE_TEXT:
              Aux2^.pSubStr := sqlite3_value_text(p);
            SQLITE_INTEGER:
              Aux2^.nSubStr := sqlite3_value_int(p);
          else
            ErrorMessage :=
              REGEXTRACT_FUNC_NAME + '(): Invalid subpattern type, expected integer or text';
            sqlite3_result_error_str(pCtx, ErrorMessage);
            Exit;
          end;
        end
      else
        Aux2^.nSubStr := 0;

      AuxChanged := True;
    end;

  if AuxChanged then
    begin
      if Assigned(Aux2^.pSubStr) then
        begin
          Aux2^.nSubStr := pcre2_substring_number_from_name_8(Aux0^.Code, Aux2^.pSubStr);
          case Aux2^.nSubStr of
            PCRE2_ERROR_NOSUBSTRING:
              begin
                ErrorMessage := sqlite3_encode_utf8(Format(
                  REGEXTRACT_FUNC_NAME + '(): No substring name "%s"',
                  [Aux2^.pSubStr]));
                sqlite3_result_error_str(pCtx, ErrorMessage);
                Exit;
              end;
            PCRE2_ERROR_NOUNIQUESUBSTRING:
              begin
                Assert(False);
              end
          else
            Assert(Aux2^.nSubStr > 0);
          end;
        end;

      if (Aux2^.nSubStr < 0) or (Aux2^.nSubStr > Aux0^.nSubStr) then
        begin
          ErrorMessage := sqlite3_encode_utf8(Format(
            REGEXTRACT_FUNC_NAME + '(): Invalid substring number %d, expected between 0 and %d',
            [Aux2^.nSubStr, Aux0^.nSubStr]));
          sqlite3_result_error_str(pCtx, ErrorMessage);
          Exit;
        end;
    end;

  p := Args[1];
  ArgPtr := sqlite3_value_text(p);
  ArgLen := sqlite3_value_bytes(p);
  Pcre2Result := pcre2_match_8(Aux0^.Code, ArgPtr, ArgLen, 0,
    PCRE2_MATCH_OPTIONS, Aux0^.MatchData, nil);

  if Pcre2Result >= 0 then
    begin
      if pcre2_substring_offset_bynumber_8(Aux0^.MatchData, Aux2^.nSubStr,
        @nSubStrStart, @nSubStrEnd) = 0 then
        begin
          if nSubStrEnd > nSubStrStart then
            begin
              Inc(ArgPtr, nSubStrStart);
              Dec(nSubStrEnd, nSubStrStart)
            end
          else
            nSubStrEnd := 0;

          sqlite3_result_text(pCtx, ArgPtr, nSubStrEnd, nil);
          Exit;
        end
    end;

  sqlite3_result_null(pCtx);
end;

procedure sqlite3_create_function_regextract(const DB: sqlite3_ptr; const Options: PDISQLite3RegexpOptions = nil);
begin
  sqlite3_check(sqlite3_create_function(DB, REGEXTRACT_FUNC_NAME, 2,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, Options, sqlite3_regextract_func, nil, nil), DB);
  sqlite3_check(sqlite3_create_function(DB, REGEXTRACT_FUNC_NAME, 3,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, Options, sqlite3_regextract_func, nil, nil), DB);
end;

type
  TValid = (vSource, vPattern, vReplace, vPosition, vOccurrence, vMatchParams);

  regexp_replace_aux = record
    RE: TDIPerlRegEx2_8;
    pSource: PUtf8Char;
    lSource: Integer;
    Pattern: Utf8String;
    CompileOptions: Cardinal;
    Replace: Utf8String;
    Position: Int64;
    Occurrence: Int64;
    StartOffset: Cardinal;
    Valid: set of TValid;
  end;
  regexp_replace_aux_ptr = ^regexp_replace_aux;

procedure Invalidate(const p: regexp_replace_aux_ptr; const What: TValid);
var
  Aux: regexp_replace_aux_ptr;
begin
  if Assigned(p) then
    begin
      Aux := p;
      Exclude(Aux^.Valid, What);
      if Aux^.Valid = [] then
        begin
          Aux^.RE.Free;
          FreeMem(p);
        end;
    end;
end;

procedure regexp_replace_source_destroy(p: C_void_ptr);
var
  Aux: regexp_replace_aux_ptr;
begin
  if Assigned(p) then
    begin
      Aux := p;
      Invalidate(Aux, vSource);
    end;
end;

procedure regexp_replace_pattern_destroy(p: C_void_ptr);
var
  Aux: regexp_replace_aux_ptr;
begin
  if Assigned(p) then
    begin
      Aux := p;
      Aux^.Pattern := '';
      Invalidate(Aux, vPattern);
    end;
end;

procedure regexp_replace_replace_destroy(p: C_void_ptr);
var
  Aux: regexp_replace_aux_ptr;
begin
  if Assigned(p) then
    begin
      Aux := p;
      Aux^.Replace := '';
      Invalidate(Aux, vReplace);
    end;
end;

procedure regexp_replace_position_destroy(p: C_void_ptr);
begin
  Invalidate(p, vPosition);
end;

procedure regexp_replace_occurrence_destroy(p: C_void_ptr);
begin
  Invalidate(p, vOccurrence);
end;

procedure regexp_replace_match_params_destroy(p: C_void_ptr);
begin
  Invalidate(p, vMatchParams);
end;

procedure sqlite3_regexp_replace(pCtx: sqlite3_context_ptr; nArgs: Integer; Args: sqlite3_value_ptr_array_ptr);
const
  DEFAULT_COMPILE_OPTIONS = PCRE2_UTF or PCRE2_NO_UTF_CHECK;
var
  Aux: regexp_replace_aux_ptr;
  l, lUtf8: NativeInt;
  ErrorMessage: Utf8String;
  iAux: C_int;
  nCompileOptions: Cardinal;
  nErrorOffset: NativeInt;
  nErrorOffset8: C_int;
  nPosition, nOccurrence, nStartOffset: Int64;
  lSource: C_int;
  p: PUtf8Char;
  pValue: sqlite3_value_ptr;
  PatternChanged, SourceChanged: Boolean;
  sResult: RawByteString;
  zSource, zPattern: PUtf8Char;
begin
  zSource := sqlite3_value_text(Args[0]);
  if not Assigned(zSource) then
    Exit;

  for iAux := 1 to 6 do
    begin
      Aux := sqlite3_get_auxdata(pCtx, iAux);
      if Assigned(Aux) then Break;
    end;

  if not Assigned(Aux) then
    begin
      Aux := AllocMem(SizeOf(Aux^));
      Aux^.RE := TDIPerlRegEx2_8.Create(nil);
      Aux^.RE.NewLine := PCRE2_NEWLINE_ANY;
      Aux^.RE.FormatOptions := [foSubStrNum];
      Aux^.RE.FormatSubStrChar := '\';
    end;

  PatternChanged := False;

  if vPattern in Aux^.Valid then
    begin
      if Aux^.Pattern = '' then
        begin sqlite3_result_value(pCtx, Args[0]); Exit; end;
    end
  else
    begin
      Include(Aux^.Valid, vPattern);
      sqlite3_set_auxdata(pCtx, 1, Aux, regexp_replace_pattern_destroy);

      pValue := Args[1];
      zPattern := sqlite3_value_text(pValue);

      if Assigned(zPattern) then
        l := sqlite3_value_bytes(pValue)
      else
        l := 0;

      if l = 0 then
        begin sqlite3_result_value(pCtx, Args[0]); Exit; end;

      SetString(Aux^.Pattern, zPattern, l);

      PatternChanged := True;
    end;

  if nArgs >= 6 then
    if vMatchParams in Aux^.Valid then
      nCompileOptions := Aux^.CompileOptions
    else
      begin
        Include(Aux^.Valid, vMatchParams);
        sqlite3_set_auxdata(pCtx, 5, Aux, regexp_replace_match_params_destroy);

        nCompileOptions := DEFAULT_COMPILE_OPTIONS;

        pValue := Args[5];
        p := sqlite3_value_text(pValue);
        if Assigned(p) then
          begin
            l := sqlite3_value_bytes(pValue);
            while l > 0 do
              begin
                case p^ of
                  'c':
                    nCompileOptions := nCompileOptions and not PCRE2_CASELESS;
                  'i':
                    nCompileOptions := nCompileOptions or PCRE2_CASELESS;
                  'n':
                    nCompileOptions := nCompileOptions or PCRE2_DOTALL;
                  'm':
                    nCompileOptions := nCompileOptions or PCRE2_MULTILINE;
                  'x':
                    nCompileOptions := nCompileOptions or PCRE2_EXTENDED;
                else
                  sqlite3_result_error_str(pCtx, REGEXP_REPLACE_INVALID_MATCH_PARAM);
                  Exit;
                end;
                Inc(p); Dec(l);
              end;
          end;

        if Aux^.CompileOptions <> nCompileOptions then
          begin
            Aux^.CompileOptions := nCompileOptions;
            PatternChanged := True;
          end;
      end
  else
    nCompileOptions := DEFAULT_COMPILE_OPTIONS;

  if PatternChanged and not Aux^.RE.CompileMatchPatternStrOpt(
    Aux^.Pattern, nCompileOptions) then
    begin

      zPattern := PUtf8Char(Aux^.Pattern);
      nErrorOffset := 0;
      nErrorOffset8 := Aux^.RE.ErrorOffset;
      while nErrorOffset8 > 0 do
        begin
          lUtf8 := Utf8Bytes(zPattern, nErrorOffset8);
          if lUtf8 < 0 then Break;
          Inc(nErrorOffset);
          Inc(zPattern, lUtf8); Dec(nErrorOffset8, lUtf8);
        end;

      ErrorMessage := sqlite3_encode_utf8(Format(
        REGEXP_REPLACE_FUNC_NAME + '(): Pattern error "%s" at offset %d',
        [sqlite3_decode_utf8(Aux^.RE.ErrorMessage), nErrorOffset]));
      sqlite3_result_error_str(pCtx, ErrorMessage);
      Exit;
    end;

  if not (vReplace in Aux^.Valid) then
    begin
      Include(Aux^.Valid, vReplace);
      sqlite3_set_auxdata(pCtx, 2, Aux, regexp_replace_replace_destroy);

      pValue := Args[2];
      p := sqlite3_value_text(pValue);
      if Assigned(p) then
        l := sqlite3_value_bytes(pValue)
      else
        l := 0;
      SetString(Aux^.Replace, p, l);
      Aux^.RE.FormatPattern := Aux^.Replace;
    end;

  SourceChanged := False;

  if nArgs >= 4 then
    if vPosition in Aux^.Valid then
      nPosition := Aux^.Position
    else
      begin
        Include(Aux^.Valid, vPosition);
        sqlite3_set_auxdata(pCtx, 3, Aux, regexp_replace_position_destroy);

        nPosition := 0;

        pValue := Args[3];
        case sqlite3_value_numeric_type(pValue) of
          SQLITE_INTEGER:
            nPosition := sqlite3_value_int64(pValue);
          SQLITE_TEXT:
            if sqlite3_value_bytes(pValue) = 0 then
              nPosition := 1;
          SQLITE_NULL:
            nPosition := 1;
        end;

        if nPosition <= 0 then
          begin
            sqlite3_result_error_str(pCtx, REGEXP_REPLACE_POSITION_ERROR);
            Exit;
          end;

        if Aux^.Position <> nPosition then
          begin
            Aux^.Position := nPosition;
            SourceChanged := True;
          end;
      end
  else
    nPosition := 1;

  if nArgs >= 5 then
    if vOccurrence in Aux^.Valid then
      nOccurrence := Aux^.Occurrence
    else
      begin
        Include(Aux^.Valid, vOccurrence);
        sqlite3_set_auxdata(pCtx, 4, Aux, regexp_replace_occurrence_destroy);

        nOccurrence := -1;

        pValue := Args[4];
        case sqlite3_value_numeric_type(pValue) of
          SQLITE_INTEGER:
            nOccurrence := sqlite3_value_int64(pValue);
          SQLITE_TEXT:
            if sqlite3_value_bytes(pValue) = 0 then
              nOccurrence := 0;
          SQLITE_NULL:
            nOccurrence := 0;
        end;

        if nOccurrence < 0 then
          begin
            sqlite3_result_error_str(pCtx, REGEXP_REPLACE_OCCURRENCE_ERROR);
            Exit;
          end;

        Aux^.Occurrence := nOccurrence;
      end
  else
    nOccurrence := 0;

  if not (vSource in Aux^.Valid) then
    begin
      Include(Aux^.Valid, vSource);
      sqlite3_set_auxdata(pCtx, 0, Aux, regexp_replace_source_destroy);

      SourceChanged := True;
    end;

  pValue := Args[0];
  lSource := sqlite3_value_bytes(pValue);
  Aux^.RE.SetSubjectBuf(zSource^, lSource);

  if SourceChanged then
    begin

      nStartOffset := 0;
      while lSource > 0 do
        begin
          Dec(nPosition);
          if nPosition = 0 then Break;
          l := Utf8Bytes(zSource, lSource);
          Inc(nStartOffset, l); Inc(zSource, l); Dec(lSource, l);
        end;
      Aux^.StartOffset := nStartOffset;
    end;

  if Aux^.RE.Replace2(sResult, Aux^.StartOffset, -1, nOccurrence) > 0 then
    sqlite3_result_str(pCtx, sResult)
  else
    sqlite3_result_value(pCtx, Args[0]);
end;

procedure sqlite3_create_function_regexp_replace(const DB: sqlite3_ptr);
begin
  sqlite3_check(sqlite3_create_function(DB, REGEXP_REPLACE_FUNC_NAME, 3,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, nil, sqlite3_regexp_replace, nil, nil), DB);
  sqlite3_check(sqlite3_create_function(DB, REGEXP_REPLACE_FUNC_NAME, 4,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, nil, sqlite3_regexp_replace, nil, nil), DB);
  sqlite3_check(sqlite3_create_function(DB, REGEXP_REPLACE_FUNC_NAME, 5,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, nil, sqlite3_regexp_replace, nil, nil), DB);
  sqlite3_check(sqlite3_create_function(DB, REGEXP_REPLACE_FUNC_NAME, 6,
    SQLITE_UTF8 or SQLITE_DETERMINISTIC, nil, sqlite3_regexp_replace, nil, nil), DB);
end;

end.

