{

  pcRegExp - Perl compatible regular expressions for Virtual Pascal

  (c) 2001 Peter S. Voronov aka Chem O'Dun <petervrn@yahoo.com>

  Based on PCRE library interface unit for Virtual Pascal.

  (c) 2001 Alexander Tokarev <dwalin@dwalin.ru>

  The current PCRE version is: 3.7

  This software must be distributed as Freeware.

  The PCRE library is written by: Philip Hazel <ph10@cam.ac.uk>

  Copyright (c) 1997-2004 University of Cambridge

  AngelsHolocaust 4-11-04 updated to use version v5.0

  (INFO: this is regex-directed, NFA)

  AH:  9-11-04 - pcre_free: removed var, pcre already gives the ptr, now

			    everything works as it should (no more crashes)

		 -> removed CheckRegExp because pcre handles errors perfectly

      10-11-04 - added pcError (errorhandling), pcInit

      13-11-04 - removed the ErrorPos = 0 check -> always print erroroffset

      17-10-05 - support for \1-\9 backreferences in TpcRegExp.GetReplStr

      17-02-06 - added RunTimeOptions: caller can set options while searching

      19-02-06 - added SearchOfs(): let PCRE use the complete string and offset

		 into the string itself

      20-12-06 - support for version 7.0

      27.08.08 - support for v7.7

}

{$H+} {$DEFINE PCRE_3_7} {$DEFINE PCRE_5_0} {$DEFINE PCRE_7_0} {$DEFINE PCRE_7_7}

Unit pcregexp;

Interface

uses objects;

Type

 PpcRegExp = ^TpcRegExp;

// TpcRegExp = object

 TpcRegExp = object(TObject)

  MatchesCount: integer;

  RegExpC, RegExpExt : Pointer;

  Matches:Pointer;

  RegExp: shortstring;

  SourceLen: integer;

  PartialMatch : boolean;

  Error : boolean;

  ErrorMsg : Pchar;

  ErrorPos : integer;

  RunTimeOptions: Integer; // options which can be set by the caller

  constructor Init(const ARegExp : shortstring; AOptions : integer; ALocale : Pointer);

  function Search(AStr: Pchar; ALen : longint) : boolean; virtual;

  function SearchNext( AStr: Pchar; ALen : longint) : boolean; virtual;

  function SearchOfs ( AStr: Pchar; ALen, AOfs : longint) : boolean; virtual;

  function MatchSub(ANom: integer; var Pos, Len : longint) : boolean; virtual;

  function MatchFull(var Pos, Len : longint) : boolean; virtual;

  function GetSubStr(ANom: integer; AStr: Pchar) : string; virtual;

  function GetFullStr(AStr: Pchar) : string; virtual;

  function GetReplStr(AStr: Pchar; const ARepl: string) : string; virtual;

  function GetPreSubStr(AStr: Pchar) : string; virtual;

  function GetPostSubStr(AStr: Pchar) : string; virtual;

  function ErrorStr : string; virtual;

  destructor Done; virtual;

 end;

 function pcGrepMatch(WildCard, aStr: string; AOptions:integer; ALocale : Pointer): Boolean;

 function pcGrepSub(WildCard, aStr, aRepl: string; AOptions:integer; ALocale : Pointer): string;

 function pcFastGrepMatch(WildCard, aStr: string): Boolean;

 function pcFastGrepSub(WildCard, aStr, aRepl: string): string;

{$IFDEF PCRE_5_0}

 function pcGetVersion : pchar;

{$ENDIF}

 function pcError (var pRegExp : Pointer) : Boolean;

 function pcInit  (const Pattern: Shortstring; CaseSens: Boolean) : Pointer;

Const { Options }

 PCRE_CASELESS         = $0001;

 PCRE_MULTILINE        = $0002;

 PCRE_DOTALL           = $0004;

 PCRE_EXTENDED         = $0008;

 PCRE_ANCHORED         = $0010;

 PCRE_DOLLAR_ENDONLY   = $0020;

 PCRE_EXTRA            = $0040;

 PCRE_NOTBOL           = $0080;

 PCRE_NOTEOL           = $0100;

 PCRE_UNGREEDY         = $0200;

 PCRE_NOTEMPTY         = $0400;

{$IFDEF PCRE_5_0}

 PCRE_UTF8             = $0800;

 PCRE_NO_AUTO_CAPTURE  = $1000;

 PCRE_NO_UTF8_CHECK    = $2000;

 PCRE_AUTO_CALLOUT     = $4000;

 PCRE_PARTIAL          = $8000;

{$ENDIF}

{$IFDEF PCRE_7_0}

 PCRE_DFA_SHORTEST     = $00010000;

 PCRE_DFA_RESTART      = $00020000;

 PCRE_FIRSTLINE        = $00040000;

 PCRE_DUPNAMES         = $00080000;

 PCRE_NEWLINE_CR       = $00100000;

 PCRE_NEWLINE_LF       = $00200000;

 PCRE_NEWLINE_CRLF     = $00300000;

 PCRE_NEWLINE_ANY      = $00400000;

 PCRE_NEWLINE_ANYCRLF  = $00500000;

 PCRE_NEWLINE_BITS     = PCRE_NEWLINE_CR or PCRE_NEWLINE_LF or PCRE_NEWLINE_ANY;

{$ENDIF}

{$IFDEF PCRE_7_7}

 PCRE_BSR_ANYCRLF      = $00800000;

 PCRE_BSR_UNICODE      = $01000000;

 PCRE_JAVASCRIPT_COMPAT= $02000000;

{$ENDIF}

 PCRE_COMPILE_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_AUTO_CALLOUT + PCRE_CASELESS  +

				PCRE_DOLLAR_ENDONLY + PCRE_DOTALL + PCRE_EXTENDED  +

				PCRE_EXTRA + PCRE_MULTILINE + PCRE_NO_AUTO_CAPTURE +

				PCRE_UNGREEDY + PCRE_UTF8 + PCRE_NO_UTF8_CHECK

				{$IFDEF PCRE_7_0}

				+ PCRE_DUPNAMES + PCRE_FIRSTLINE + PCRE_NEWLINE_BITS

				{$ENDIF}

				{$IFDEF PCRE_7_7}

				+ PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE + PCRE_JAVASCRIPT_COMPAT

				{$ENDIF}

				;

 PCRE_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL +

			     PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL

			     {$IFDEF PCRE_7_0}

			     + PCRE_NEWLINE_BITS

			     {$ENDIF}

			     {$IFDEF PCRE_7_7}

			     + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE

			     {$ENDIF}

			     ;

{$IFDEF PCRE_7_0}

 PCRE_DFA_EXEC_ALLOWED_OPTIONS = PCRE_ANCHORED + PCRE_NOTBOL + PCRE_NOTEOL +

				 PCRE_NOTEMPTY + PCRE_NO_UTF8_CHECK + PCRE_PARTIAL +

				 PCRE_DFA_SHORTEST + PCRE_DFA_RESTART +

				 PCRE_NEWLINE_BITS

				 {$IFDEF PCRE_7_7}

				 + PCRE_BSR_ANYCRLF + PCRE_BSR_UNICODE

				 {$ENDIF}

				 ;

{$ENDIF}

{ Exec-time and get/set-time error codes }

 PCRE_ERROR_NOMATCH        =  -1;

 PCRE_ERROR_NULL	   =  -2;

 PCRE_ERROR_BADOPTION      =  -3;

 PCRE_ERROR_BADMAGIC       =  -4;

 PCRE_ERROR_UNKNOWN_MODE   =  -5;

 PCRE_ERROR_NOMEMORY       =  -6;

 PCRE_ERROR_NOSUBSTRING    =  -7;

{$IFDEF PCRE_5_0}

 PCRE_ERROR_MATCHLIMIT     =  -8;

 PCRE_ERROR_CALLOUT        =  -9;  { Never used by PCRE itself }

 PCRE_ERROR_BADUTF8        = -10;

 PCRE_ERROR_BADUTF8_OFFSET = -11;

 PCRE_ERROR_PARTIAL        = -12;

 PCRE_ERROR_BADPARTIAL     = -13;

 PCRE_ERROR_INTERNAL       = -14;

 PCRE_ERROR_BADCOUNT       = -15;

{$ENDIF}

{$IFDEF PCRE_7_0}

 PCRE_ERROR_DFA_UITEM      = -16;

 PCRE_ERROR_DFA_UCOND      = -17;

 PCRE_ERROR_DFA_UMLIMIT    = -18;

 PCRE_ERROR_DFA_WSSIZE     = -19;

 PCRE_ERROR_DFA_RECURSE    = -20;

 PCRE_ERROR_RECURSIONLIMIT = -21;

 PCRE_ERROR_NULLWSLIMIT    = -22;

 PCRE_ERROR_BADNEWLINE     = -23;

{$ENDIF}

{ Request types for pcre_fullinfo() }

 PCRE_INFO_OPTIONS         =  0;

 PCRE_INFO_SIZE 	   =  1;

 PCRE_INFO_CAPTURECOUNT    =  2;

 PCRE_INFO_BACKREFMAX      =  3;

 PCRE_INFO_FIRSTBYTE       =  4;

 PCRE_INFO_FIRSTCHAR       =  4; { For backwards compatibility }

 PCRE_INFO_FIRSTTABLE      =  5;

{$IFDEF PCRE_5_0}

 PCRE_INFO_LASTLITERAL     =  6;

 PCRE_INFO_NAMEENTRYSIZE   =  7;

 PCRE_INFO_NAMECOUNT       =  8;

 PCRE_INFO_NAMETABLE       =  9;

 PCRE_INFO_STUDYSIZE       = 10;

 PCRE_INFO_DEFAULT_TABLES  = 11;

{$ENDIF PCRE_5_0}

{$IFDEF PCRE_7_7}

 PCRE_INFO_OKPARTIAL       = 12;

 PCRE_INFO_JCHANGED        = 13;

 PCRE_INFO_HASCRORLF       = 14;

{$ENDIF}

{ Request types for pcre_config() }

{$IFDEF PCRE_5_0}

 PCRE_CONFIG_UTF8       	    = 0;

 PCRE_CONFIG_NEWLINE    	    = 1;

 PCRE_CONFIG_LINK_SIZE  	    = 2;

 PCRE_CONFIG_POSIX_MALLOC_THRESHOLD = 3;

 PCRE_CONFIG_MATCH_LIMIT	    = 4;

 PCRE_CONFIG_STACKRECURSE           = 5;

 PCRE_CONFIG_UNICODE_PROPERTIES     = 6;

{$ENDIF PCRE_5_0}

{$IFDEF PCRE_7_0}

 PCRE_CONFIG_MATCH_LIMIT_RECURSION  = 7;

{$ENDIF}

{$IFDEF PCRE_7_7}

 PCRE_CONFIG_BSR		    = 8;

{$ENDIF}

{ Bit flags for the pcre_extra structure }

{$IFDEF PCRE_5_0}

 PCRE_EXTRA_STUDY_DATA  	  = $0001;

 PCRE_EXTRA_MATCH_LIMIT 	  = $0002;

 PCRE_EXTRA_CALLOUT_DATA	  = $0004;

 PCRE_EXTRA_TABLES      	  = $0008;

{$ENDIF PCRE_5_0}

{$IFDEF PCRE_7_0}

 PCRE_EXTRA_MATCH_LIMIT_RECURSION = $0010;

{$ENDIF}

Const

// DefaultOptions : integer = 0;

 DefaultLocaleTable : pointer = nil;

{$IFDEF PCRE_5_0}

{ The structure for passing additional data to pcre_exec(). This is defined in

such as way as to be extensible. Always add new fields at the end, in order to

remain compatible. }

type ppcre_extra = ^tpcre_extra;

     tpcre_extra = record

       flags : longint; 	       { Bits for which fields are set }

       study_data : pointer;           { Opaque data from pcre_study() }

       match_limit : longint;          { Maximum number of calls to match() }

       callout_data : pointer;         { Data passed back in callouts }

       tables : pointer;	       { Pointer to character tables }

       match_limit_recursion: longint; { Max recursive calls to match() }

     end;

type ppcre_callout_block = ^pcre_callout_block;

     pcre_callout_block = record

       version,

  (* ------------------------ Version 0 ------------------------------- *)

       callout_number : integer;

       offset_vector : pointer;

       subject : pchar;

       subject_length, start_match, current_position, capture_top,

       capture_last : integer;

       callout_data : pointer;

  (* ------------------- Added for Version 1 -------------------------- *)

       pattern_position, next_item_length : integer;

     end;

{$ENDIF PCRE_5_0}

{$OrgName+}

{$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL}

 { local replacement of external pcre memory management functions }

 function pcre_malloc( size : integer ) : pointer;

 procedure pcre_free( {var} p : pointer );

{$IFDEF PCRE_5_0}

 const pcre_stack_malloc: function ( size : integer ): pointer = pcre_malloc;

       pcre_stack_free: procedure ( {var} p : pointer ) = pcre_free;

 function pcre_callout(var p : ppcre_callout_block) : integer;

{$ENDIF PCRE_5_0}

{$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL}

Implementation

Uses strings, collect, messages, dnapp, commands, advance0, stringsx

    {$IFDEF VIRTUALPASCAL} ,vpsyslow {$ENDIF VIRTUALPASCAL};

Const

 MAGIC_NUMBER = $50435245; { 'PCRE' }

 MAX_MATCHES = 90; { changed in 3.5 version; should be divisible by 3, was 64}

Type

 PMatchArray = ^TMatchArray;

 TMatchArray = array[0..( MAX_MATCHES * 3 )] of integer;

 PRegExpCollection = ^TRegExpCollection;

 TRegExpCollection =  object(TSortedCollection)

   MaxRegExp : integer;

   SearchRegExp : shortstring;

   CompareModeInsert : boolean;

   constructor Init(AMaxRegExp:integer);

   procedure FreeItem(P: Pointer); virtual;

   function  Compare(P1, P2: Pointer): Integer; virtual;

   function  Find(ARegExp:shortstring;var P: PpcRegExp):boolean; virtual;

   function CheckNew(ARegExp:shortstring):PpcRegExp;virtual;

 end;

Var

 PRegExpCache : PRegExpCollection;

{$IFDEF VIRTUALPASCAL} {&Cdecl+} {$ENDIF VIRTUALPASCAL}

 { imported original pcre functions }

 function pcre_compile( const pattern : PChar; options : integer;

			var errorptr : PChar; var erroroffset : integer;

			const tables : PChar ) : pointer {pcre}; external;

{$IFDEF PCRE_7_0}

 function pcre_compile2( const pattern : PChar; options : integer;

			 var errorcodeptr : Integer;

			 var errorptr : PChar; var erroroffset : integer;

			 const tables : PChar ) : pointer {pcre}; external;

{$ENDIF}

{$IFDEF PCRE_5_0}

 function pcre_config( what : integer; where : pointer) : integer; external;

 function pcre_copy_named_substring( const code : pointer {pcre};

				     const subject : pchar;

				     var ovector : integer;

				     stringcount : integer;

				     const stringname : pchar;

				     var buffer : pchar;

				     size : integer) : integer; external;

 function pcre_copy_substring( const subject : pchar; var ovector : integer;

			       stringcount, stringnumber : integer;

			       var buffer : pchar; size : integer )

			       : integer; external;

 function pcre_exec( const argument_re : pointer {pcre};

		     const extra_data : pointer {pcre_extra};

{$ELSE}

 function pcre_exec( const external_re : pointer;

		     const external_extra : pointer;

{$ENDIF}

		     const subject : PChar;

		     length, start_offset, options : integer;

		     offsets : pointer;

		     offsetcount : integer ) : integer; external;

{$IFDEF PCRE_7_0}

 function pcre_dfa_exec( const argument_re : pointer {pcre};

			 const extra_data : pointer {pcre_extra};

			 const subject : pchar;

			 length, start_offset, options : integer;

			 offsets : pointer;

			 offsetcount : integer;

			 workspace : pointer;

			 wscount : integer ) : integer; external;

{$ENDIF}

{$IFDEF PCRE_5_0}

 procedure pcre_free_substring( const p : pchar ); external;

 procedure pcre_free_substring_list( var p : pchar ); external;

 function pcre_fullinfo( const argument_re : pointer {pcre};

			 const extra_data : pointer {pcre_extra};

			 what : integer;

			 where : pointer ) : integer; external;

 function pcre_get_named_substring( const code : pointer {pcre};

				    const subject : pchar;

				    var ovector : integer;

				    stringcount : integer;

				    const stringname : pchar;

				    var stringptr : pchar ) : integer; external;

 function pcre_get_stringnumber( const code : pointer {pcre};

				 const stringname : pchar ) : integer; external;

 function pcre_get_stringtable_entries( const code : pointer {pcre};

					const stringname : pchar;

					var firstptr,

					    lastptr : pchar ) : integer; external;

 function pcre_get_substring( const subject : pchar; var ovector : integer;

			      stringcount, stringnumber : integer;

			      var stringptr : pchar ) : integer; external;

 function pcre_get_substring_list( const subject : pchar; var ovector : integer;

				   stringcount : integer;

				   listptr : pointer {const char ***listptr}) : integer; external;

 function pcre_info( const argument_re : pointer {pcre};

		     var optptr : integer;

		     var first_byte : integer ) : integer; external;

 function pcre_maketables : pchar; external;

{$ENDIF}

{$IFDEF PCRE_7_0}

 function pcre_refcount( const argument_re : pointer {pcre};

			 adjust : integer ) : pchar; external;

{$ENDIF}

 function pcre_study( const external_re : pointer {pcre};

		      options : integer;

		      var errorptr : PChar ) : pointer {pcre_extra}; external;

{$IFDEF PCRE_5_0}

 function pcre_version : pchar; external;

{$ENDIF}

 function pcre_malloc( size : integer ) : pointer;

 begin

  GetMem( result, size );

 end;

 procedure pcre_free( {var} p : pointer );

 begin

  if (p <> nil) then

    FreeMem( p, 0 );

  {@p := nil;}

 end;

{$IFDEF PCRE_5_0}

(* Called from PCRE as a result of the (?C) item. We print out where we are in

the match. Yield zero unless more callouts than the fail count, or the callout

data is not zero. *)

 function pcre_callout;

 begin

 end;

{$ENDIF}

{$IFDEF VIRTUALPASCAL} {&Cdecl-} {$ENDIF VIRTUALPASCAL}

// Always include the newest version of the library

{$IFDEF PCRE_7_7}

  {$L pcre77.lib}

{$ELSE}

  {$IFDEF PCRE_7_0}

    {$L pcre70.lib}

  {$ELSE}

    {$IFDEF PCRE_5_0}

      {$L pcre50.lib}

    {$ELSE}

      {$IFDEF PCRE_3_7}

	{$L pcre37.lib}

      {$ENDIF PCRE_3_7}

    {$ENDIF PCRE_5_0}

  {$ENDIF PCRE_7_0}

{$ENDIF PCRE_7_7}

{TpcRegExp}

 constructor TpcRegExp.Init(const ARegExp:shortstring; AOptions:integer; ALocale : Pointer);

 var

  pRegExp : PChar;

 begin

  RegExp:=ARegExp;

  RegExpC:=nil;

  RegExpExt:=nil;

  Matches:=nil;

  MatchesCount:=0;

  Error:=true;

  ErrorMsg:=nil;

  ErrorPos:=0;

  RunTimeOptions := 0;

  if length(RegExp) < 255 then

   begin

    RegExp[length(RegExp)+1]:=#0;

    pRegExp:=@RegExp[1];

   end

  else

   begin

    GetMem(pRegExp,length(RegExp)+1);

    pRegExp:=strpcopy(pRegExp,RegExp);

   end;

  RegExpC := pcre_compile( pRegExp,

			   AOptions and PCRE_COMPILE_ALLOWED_OPTIONS,

			   ErrorMsg, ErrorPos, ALocale);

  if length(RegExp) = 255 then

   StrDispose(pRegExp);

  if RegExpC = nil then

   exit;

  ErrorMsg:=nil;

  RegExpExt := pcre_study( RegExpC, 0, ErrorMsg );

  if (RegExpExt = nil) and (ErrorMsg <> nil) then

   begin

    pcre_free(RegExpC);

    exit;

   end;

  GetMem(Matches,SizeOf(TMatchArray));

  Error:=false;

 end;

 destructor TpcRegExp.Done;

 begin

  if RegExpC <> nil then

    pcre_free(RegExpC);

  if RegExpExt <> nil then

    pcre_free(RegExpExt);

  if Matches <> nil then

    FreeMem(Matches,SizeOf(TMatchArray));

 end;

 function TpcRegExp.SearchNext( AStr: Pchar; ALen : longint ) : boolean;

 var Options: Integer;

 begin // must handle PCRE_ERROR_PARTIAL here

  Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and

	     PCRE_EXEC_ALLOWED_OPTIONS;

  if MatchesCount > 0 then

    MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, PMatchArray(Matches)^[1],

			     Options, Matches, MAX_MATCHES ) else

    MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, 0,

			     Options, Matches, MAX_MATCHES );

{  if MatchesCount = 0 then

    MatchesCount := MatchesCount div 3;}

  PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL;

  SearchNext := MatchesCount > 0;

 end;

 function TpcRegExp.Search( AStr: Pchar; ALen : longint):boolean;

 begin

  MatchesCount:=0;

  Search:=SearchNext(AStr,ALen);

  SourceLen:=ALen;

 end;

 function TpcRegExp.SearchOfs( AStr: Pchar; ALen, AOfs: longint ) : boolean;

 var Options: Integer;

 begin

  MatchesCount:=0;

  Options := (RunTimeOptions or startup.MiscMultiData.cfgRegEx.DefaultOptions) and

	     PCRE_EXEC_ALLOWED_OPTIONS;

  MatchesCount:=pcre_exec( RegExpC, RegExpExt, AStr, ALen, AOfs,

			   Options, Matches, MAX_MATCHES );

  PartialMatch := MatchesCount = PCRE_ERROR_PARTIAL;

  SearchOfs := MatchesCount > 0;

  SourceLen := ALen-AOfs;

 end;

 function TpcRegExp.MatchSub(ANom:integer; var Pos,Len:longint):boolean;

 begin

  if (MatchesCount > 0) and (ANom <= (MatchesCount-1)) then

   begin

    ANom:=ANom*2;