PureBasic Forums - English

Posted: **Mon Apr 23, 2007 6:54 pm**

This sourcecode is:

PB 4 compatible
EnableExplicit compatible
Debugger compatible (no ASM, no hacks)
Threadsafe in all cases
100% native PureBasic code

This code is free for use in any project and/or application as long as you give me credits in your product.

This code has a testing-unit running when compiled with debugger-support.
(it tests itself for beeing fully operational)

This code is threadsafe, but the objects themselves aren't!
(It's easier to implement this in the calling application)

Docs:
This Code is OOP-code. This means you create objects with which you can work:

Code: Select all

object.ExStringField = ExStringField(String$[,Separators$[,SeparatorsSeparator$[,flags]]])

object: The object you can work with
String$: The string that should be seperated
Separator$: One or more separators which are separated by the SeparatorsSeparator$ (default: Space and Tabulator)
SeparatorsSeparator$: The string that separates the separators (default: "|" )
flags: #ExStringField_Flag_NoEmptyFields and/or #ExStringField_Flag_IgnoreDoublequotes

Then you can call following methods on those objects:

Code: Select all

Result$ = object\GetNextField()

Result$: The next field or "" if no more fields are availble

Code: Select all

Result$ = object\GetRemainingFields()

Result$: The rest of the string beginning after the current separator with all following separators intact

Code: Select all

Result = object\IsNextField()

Result: True(1) if the end of the String isn't reached else False(0)

Code: Select all

object\Destroy()

Destroys the object.

Code: Select all

; Author: DaDummy

; EnableExplicit

; This one may also consist of multiple chars but is treated as a single separator
#ExStringField_DefaultSeparatorsSeparator = "|"

; Flags
#ExStringField_Flag_NoEmptyFields      = %00000001
#ExStringField_Flag_IgnoreDoublequotes = %00000010

Structure ExStringField_Properties
  VTable.l
  String.s
  Separators.s
  SeparatorsSeparator.s
  pos.l
  len.l
  sCount.l
  flags.l
EndStructure

Interface ExStringField ; methods
  destroy()
  GetNextField.s()
  GetRemainingFields.s()
  IsNextField.l()
EndInterface

Declare   ExStringField_Destroy(*This.ExStringField_Properties)
Declare.s ExStringField_GetNextField(*This.ExStringField_Properties)       ; Returns the next field or "" if no more fields are availble
Declare.s ExStringField_GetRemainingFields(*This.ExStringField_Properties) ; Returns the rest of the string beginning after the current separator with all following separators intact
Declare.l ExStringField_IsNextField(*This.ExStringField_Properties)        ; Returns True if the end of the String isn't reached

; Constructor
Procedure.l ExStringField(String.s, Separators.s = (" " + #ExStringField_DefaultSeparatorsSeparator + #TAB$), SeparatorsSeparator.s = #ExStringField_DefaultSeparatorsSeparator, flags.l = 0)
  Protected i.l, count.l, *This.ExStringField_Properties
  
  ; Create object
  *This = AllocateMemory(SizeOf(ExStringField_Properties))
  
  ; Always look out for memory problems
  If *This = #Null
    ProcedureReturn #Null
  EndIf
  
  ; Set properties
  With *This
    \VTable              = AllocateMemory(SizeOf(ExStringField))
    \String              = String
    \Separators          = Separators
    \SeparatorsSeparator = SeparatorsSeparator
    \pos                 = 1
    \len                 = Len(String)+1
    \flags               = flags
  EndWith
  
  ; Always look out for memory problems
  If *This\VTable = #Null
    ; Free strings ;)
    With *This
      \String              = ""
      \Separators          = ""
      \SeparatorsSeparator = ""
    EndWith
    
    ; Free memory
    FreeMemory(*This)
    
    ProcedureReturn #Null 
  EndIf
  
  ; Define Methods
  PokeL(*This\VTable + OffsetOf(ExStringField\destroy           ()), @ExStringField_Destroy           ())
  PokeL(*This\VTable + OffsetOf(ExStringField\GetNextField      ()), @ExStringField_GetNextField      ())
  PokeL(*This\VTable + OffsetOf(ExStringField\GetRemainingFields()), @ExStringField_GetRemainingFields())
  PokeL(*This\VTable + OffsetOf(ExStringField\IsNextField       ()), @ExStringField_IsNextField       ())
  
  ; Correct handling for an empty SeparatorsSeparator
  If *This\SeparatorsSeparator = ""
    *This\SeparatorsSeparator = #ExStringField_DefaultSeparatorsSeparator
  EndIf
  
  ; Remove empty separators inside the Separator string
  While FindString(*This\Separators, *This\SeparatorsSeparator+*This\SeparatorsSeparator, 1)
    *This\Separators = ReplaceString(*This\Separators, *This\SeparatorsSeparator+*This\SeparatorsSeparator, SeparatorsSeparator)
  Wend
  ; Remove empty separators at the beginning of the Separator string
  While Left(*This\Separators, 1) = *This\SeparatorsSeparator
    *This\Separators = Right(*This\Separators, Len(*This\Separators)-1)
  Wend
  ; Remove empty separators at the end of the Separator string
  While Right(*This\Separators, 1) = *This\SeparatorsSeparator
    *This\Separators = Left(*This\Separators, Len(*This\Separators)-1)
  Wend
  
  ; Correct handling for an empty Separator
  If *This\Separators = ""
    *This\Separators = (" " + *This\SeparatorsSeparator + #TAB$)
  EndIf
  
  ; Count separators
  *This\sCount = CountString(*This\Separators, SeparatorsSeparator)+1
  
  ProcedureReturn *This
EndProcedure

; Destructor
Procedure   ExStringField_Destroy(*This.ExStringField_Properties)
  ; Free strings ;)
  With *This
    \String              = ""
    \Separators          = ""
    \SeparatorsSeparator = ""
  EndWith
  
  ; Free memory
  FreeMemory(*This\VTable)
  FreeMemory(*This       )
EndProcedure

Procedure.s ExStringField_GetNextField(*This.ExStringField_Properties)       ; Returns the next field or "" if no more fields are availble
  Protected oldPos.l, midPos.l, curPos.l, i.l
  Protected cSeparator.s, retVal.s
  
  Repeat
    If *This\pos = *This\len
      ProcedureReturn ""
    EndIf
    
    oldPos = *This\pos
    midPos = 0
    ; Fields beginning with a doublequote have a second one at their end
    If *This\flags & #ExStringField_Flag_IgnoreDoublequotes = 0 And Mid(*This\String, oldPos, 1) = #DOUBLEQUOTE$
      *This\pos = FindString(*This\String, #DOUBLEQUOTE$, oldPos)
      If *This\pos = 0
        *This\pos = *This\len
      EndIf
    Else
      For i = 1 To *This\sCount
        cSeparator = StringField(*This\Separators, i, *This\SeparatorsSeparator)
        curPos = FindString(*This\String, cSeparator, oldPos)
        If midPos = 0 Or (midPos > curPos And curPos <> 0)
          midPos    = curPos
          *This\pos = curPos + Len(cSeparator)
        EndIf
      Next
      If midPos = 0
        midPos    = *This\len
        *This\pos = *This\len
      EndIf
    EndIf
  Until *This\flags & #ExStringField_Flag_NoEmptyFields = 0 Or midPos-oldPos > 0
  
  retVal = Mid(*This\String, oldPos, midPos-oldPos)
  
  ProcedureReturn retVal
EndProcedure

Procedure.s ExStringField_GetRemainingFields(*This.ExStringField_Properties) ; Returns the rest of the string beginning after the current separator with all following separators intact
  Protected len.l
  Protected retVal.s
  
  If *This\pos = *This\len
    ProcedureReturn ""
  EndIf
  
  len       = *This\len-*This\pos
  *This\pos + len
  
  retVal = Right(*This\String, len)
  
  ProcedureReturn retVal
EndProcedure

Procedure.l ExStringField_IsNextField(*This.ExStringField_Properties)        ; Returns True if the end of the String isn't reached
  If *This\pos = *This\len
    ProcedureReturn #False
  Else
    ProcedureReturn #True
  EndIf
EndProcedure

CompilerIf #PB_Compiler_Debugger
Define.s sval1, sval2
Define.l lval1, lval2
Define.s text, sep, sepsep
Define.ExStringField object

Macro AssertS(val1, val2)
  sval1 = val1
  sval2 = val2
  If sval1 <> sval2
    Debug Str(#PB_Compiler_Line)+": "+Chr('"')+sval1+Chr('"')+"<>"+Chr('"')+sval2+Chr('"')
  EndIf
EndMacro

Macro AssertL(val1, val2)
  lval1 = val1
  lval2 = val2
  If lval1 <> lval2
    Debug Str(#PB_Compiler_Line)+": "+Chr('"')+Str(lval1)+Chr('"')+"<>"+Chr('"')+Str(lval2)+Chr('"')
  EndIf
EndMacro

text   = ""
object = ExStringField(text)
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab  abc a abcd"
object = ExStringField(text)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abc")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab  abc a abcd"
object = ExStringField(text)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetRemainingFields(), " abc a abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab //abc a//abcd"
sep    = " |//"
object = ExStringField(text,sep)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abc")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab //abc a//abcd"
sep    = " |//"
object = ExStringField(text,sep)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetRemainingFields(), "//abc a//abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab //abc a//abcd"
sep    = " \//"
sepsep = "\"
object = ExStringField(text,sep,sepsep)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abc")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab //abc a//abcd"
sep    = " \//"
sepsep = "\"
object = ExStringField(text,sep,sepsep)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetRemainingFields(), "//abc a//abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab //abc a//abcd"
sep    = " \//"
sepsep = "\"
object = ExStringField(text,sep,sepsep,#ExStringField_Flag_NoEmptyFields)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abc")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "abcd")
AssertL(object\IsNextField(), #False)
object\destroy()

text   = "a ab //abc a//abcd"
sep    = " \//"
sepsep = "\"
object = ExStringField(text,sep,sepsep,#ExStringField_Flag_NoEmptyFields)
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "a")
AssertL(object\IsNextField(), #True)
AssertS(object\GetNextField(), "ab")
AssertL(object\IsNextField(), #True)
AssertS(object\GetRemainingFields(), "//abc a//abcd")
AssertL(object\IsNextField(), #False)
object\destroy()
CompilerEndIf

Edit (04/23/2007 20:22): small fix
Edit (04/24/2007 14:09): code is now always threadsafe
Edit (05/10/2007 14:51): Added some more Assert-checks and added the IgnoreDoublequotes flag

Posted: **Tue Apr 24, 2007 1:16 am**

Very cool.
And thanks for sharing.

And now just a little criticism to your OOP style.

VTable.l should be a pointer. 'Cause it links to a memoryblock.
You could renounce for Data if you would you a simple memoryblock for the VTable in which you could poke the methode-references.

In example:

Code: Select all

Procedure CreateObject_cRESLINKER ()
  Protected *This.cRESLINKER = AllocateMemory (SizeOf (cRESLINKER))
  If Not *This  
     ProcedureReturn #Null
  EndIf
  *This\VTABLE = AllocateMemory (SizeOf(IcRESLINKER))
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\AddResource          ()) , @cRESLINKER_AddResource          ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\AddResourceFromFile  ()) , @cRESLINKER_AddResourceFromFile  ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\DeleteResource       ()) , @cRESLINKER_DeleteResource       ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\CountResources       ()) , @cRESLINKER_CountResources       ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\GetResourceRef       ()) , @cRESLINKER_GetResourceRef       ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\GetResourceName      ()) , @cRESLINKER_GetResourceName      ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\Load                 ()) , @cRESLINKER_Load                 ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\Save                 ()) , @cRESLINKER_Save                 ())
  PokeL (*This\VTABLE + OffsetOf (IcRESLINKER\Done                 ()) , @cRESLINKER_Done                 ())
  
  ProcedureReturn *This
EndProcedure

Posted: **Tue Apr 24, 2007 1:15 pm**

Changed, thanks Hroudtwolf!

Also your way of allocating the object makes the objects 100% threadsafe because of the missing LinkedList.

And this change might solve problems that could possible occour with external modules getting an invalid access if trying to read from that DataSection...

Posted: **Tue Apr 24, 2007 6:01 pm**

Actually, you can use a datasection without read it, it's faster (no more Allocate/Poke sequence):

Code: Select all

Procedure CreateObject_cRESLINKER ()
  Protected *This.cRESLINKER = AllocateMemory (SizeOf (cRESLINKER))
  If Not *This 
     ProcedureReturn #Null
  EndIf
  *This\VTABLE = ?YourCoolVTable
 
  ProcedureReturn *This
EndProcedure 

DataSection

YourCoolVTable:  
  Data.l @cRESLINKER_AddResource          ()
  Data.l @cRESLINKER_AddResourceFromFile  ()
  Data.l @cRESLINKER_DeleteResource       ()
  ; Complete it :) ...
EndDataSection

Posted: **Wed Apr 25, 2007 12:32 pm**

Fred wrote:Actually, you can use a datasection without read it, it's faster (no more Allocate/Poke sequence):

Code: Select all

Procedure CreateObject_cRESLINKER ()
  Protected *This.cRESLINKER = AllocateMemory (SizeOf (cRESLINKER))
  If Not *This 
     ProcedureReturn #Null
  EndIf
  *This\VTABLE = ?YourCoolVTable
 
  ProcedureReturn *This
EndProcedure 

DataSection

YourCoolVTable:  
  Data.l @cRESLINKER_AddResource          ()
  Data.l @cRESLINKER_AddResourceFromFile  ()
  Data.l @cRESLINKER_DeleteResource       ()
  ; Complete it :) ...
EndDataSection

But on the other hand incorrect handling by one client application(acutally writing into the vtable) might destroy the vtable for all applications if this class is exported in an dll...

Posted: **Thu May 10, 2007 1:56 pm**

*update*

Added some more Assert-checks and added the IgnoreDoublequotes flag

Posted: **Thu May 10, 2007 3:13 pm**

This looks very interesting and while I haven't had time to study it (plus it looks like it's over my head anyway

, it appears to offer a solution to the "free memory" on strings dilemma? (for which Freak posted an earlier solution), along with lots of other nice features.

Very impressive. Thanks

cheers

PureBasic Forums - English

ExStringField in OOP style

ExStringField in OOP style