Seite 1 von 1

PB meets Perl

Verfasst: 02.04.2007 18:50
von Nero
So auf Kiffi's Wunsch hin poste ich das ganze mal hier :mrgreen:

Wer schon immer mal Perl in PB verwenden wollte kann das hiermit ganz gut tun.

Den Ursprünglichen Beitrag findet ihr HIER

Ich Poste hier erstmal die wichtigsten code Files was halt so bisher steht.

PerlEz_Include.pbi

Code: Alles auswählen

; Autor: Thomas (ts-soft) Schulz

Enumeration
  #plezNoError            ;	success
  #plezMoreSpace          ;	more space need To Return result
  #plezError              ;	returned error string in buffer
  #plezErrorMoreSpace     ;	more space need To Return error message
  #plezErrorBadFormat     ;	format string is invalid
  #plezException          ;	function call caused an exception
  #plezInvalidHandle      ;	hHandle was invalid
  #plezCallbackAlreadySet ;	second call To PerlEzSetMagicFunction fails
  #plezInvalidParams      ;	invalid parameter was passed To a routine
  #plezOutOfMemory        ;	cannot allocate more memory
EndEnumeration

Import "PerlEz.lib"
  PerlEzCreate(lpFileName.s = "", lpOptions.s = "") As "_PerlEzCreate@8"
  PerlEzCreateOpt(lpFileName.s, lpOptions.s, lpScriptOpts.s) As "_PerlEzCreateOpt@12"
  PerlEzDelete(hHandle.l) As "_PerlEzDelete@4"
  PerlEzEvalString(hHandle.l, lpString.s, lpBuffer.s, dwBufSize.l) As "_PerlEzEvalString@16"
  PerlEzCall1(hHandle.l, lpFunction.s, lpBuffer.s, dwBufSize.l, lpFormat.s, *lpVoid) As "_PerlEzCall1@24"
  PerlEzCall2(hHandle.l, lpFunction.s, lpBuffer.s, dwBufSize.l, lpFormat.s, *lpVoid, *lpVoid2) As "_PerlEzCall2@28"
  PerlEzCall4(hHandle.l, lpFunction.s, lpBuffer.s, dwBufSize.l, lpFormat.s, *lpVoid, *lpVoid2, *lpVoid3, *lpVoid4) As "_PerlEzCall4@36"
  PerlEzCall8(hHandle.l, lpFunction.s, lpBuffer.s, dwBufSize.l, lpFormat.s, *lpVoid, *lpVoid2, *lpVoid3, *lpVoid4, *lpVoid5, *lpVoid6, *lpVoid7, *lpVoid8) As "_PerlEzCall8@52"
  ;PerlEzCall() As "_PerlEzCall" ; diese Art der variablen Parameter wird nicht unterstützt in PB
  ;PerlEzCallContext() As "_PerlEzCallContext"; diese Art der variablen Parameter wird nicht unterstützt in PB
  PerlEzSetMagicScalarFunctions(hHandle.l, *lpfFetch, *lpfStore) As "_PerlEzSetMagicScalarFunctions@12"
  PerlEzSetMagicScalarName(hHandle.l, pVariableName.s) As "_PerlEzSetMagicScalarName@8"
EndImport
example.pb

Code: Alles auswählen

XIncludeFile "PerlEz_Include.pbi"
XIncludeFile "PerlTools_Include.pbi"

plHandle.l = PerlEzCreate("PerlTools.pl")

If plHandle <> 0
  Debug plRegEx(plHandle, "<a hreff='http://www.purebasic.fr/german'>PB Forum</a>", "s/(.*?)>(.*?)<\/a>/$2/g")
  Debug plStringField(plHandle, "hallo ich bin der text", 1)
  Debug plStringField(plHandle, "hallo ich bin  der text", 1, Space(2)); uses 2 spaces as separator!
  
  Dim String.s(0)
  plStringToArray(String(), plHandle, "hallo ich bin der text")
  Debug String(2)


  
  plEval(plHandle, "%NewHash = ('key1' => '123', 'key2' => '456')", 0)
  plEval(plHandle, "$NewHash{'test'} = 'ich bin ein hash Test';", 0) 
  
  Debug plEval(plHandle, "$NewHash{'test'};")  
  Debug plEval(plHandle, "$NewHash{'key2'};") 
  Debug plEval(plHandle, "$NewHash{'key1'};")

  For x = 0 To PeekL(@String() - 8) - 1
    Debug String(x)
  Next  
  Debug Space(1)  
  plSplice(plHandle, String(), 1, 0, "Neu1")
  plSplice(plHandle, String(), 4, 0, "Neu2")
  plSplice(plHandle, String(), 5, 1, "der_ist_ersetzt")  
  For x = 0 To PeekL(@String() - 8) - 1
    Debug String(x)
  Next

  
  PerlEzDelete(plHandle)
EndIf
PerlTools_Include.pbi

Code: Alles auswählen

; Autor: Thomas (ts-soft) Schulz
; Autor: Janko (Nero) Glock

XIncludeFile "PerlEz_Include.pbi"
XIncludeFile "EscapeString_Include.pbi"

Procedure plDebugErrorString(error.l)
  Select error
    Case #plezNoError             : Debug "success"
    Case #plezMoreSpace           : Debug "more space need To Return result"
    Case #plezError               : Debug "returned error string in buffer"
    Case #plezErrorMoreSpace      : Debug "more space need To Return error message"
    Case #plezErrorBadFormat      : Debug "format string is invalid"
    Case #plezException           : Debug "function call caused an exception"
    Case #plezInvalidHandle       : Debug "hHandle was invalid"
    Case #plezCallbackAlreadySet  : Debug "second call To PerlEzSetMagicFunction fails"
    Case #plezInvalidParams       : Debug "invalid parameter was passed To a routine"
    Case #plezOutOfMemory         : Debug "cannot allocate more memory"
    Default                       : Debug "unknown error"
  EndSelect
EndProcedure


; Führt einen übergeben String alls Programmcode aus
Procedure.s plEval(plHandle.l, evalString.s, ReturnBuffer.l = 1, BufferSize.l = 1024)
  Protected buffer.s = Space(BufferSize)
  Result = PerlEzEvalString(plHandle, evalString, buffer, BufferSize);
  If Result = #plezNoError    
    If ReturnBuffer = 1
      ProcedureReturn buffer  
    EndIf
  Else
    plDebugErrorString(Result)
  EndIf   
EndProcedure

; Gibt ein Feld zwischen Seperator zurück (beginnend bei 0)
Procedure.s plStringField(plHandle.l, String.s, Field.l, Seperator.s = " ", BufferSize.l = 1024)
   ProcedureReturn plEval(plHandle, "(split(('"+Seperator+"'), '"+ String +"'))["+Str(Field)+"]", 1, BufferSize)
EndProcedure

; Suchen und Ersetzen mittels PerlRegEx
Procedure.s plRegEx(plHandle.l, String.s, RegEx.s, BufferSize.l = 1024)
   Protected EscString.s = esc("$String=\q"+String+"\q;")
   ProcedureReturn plEval(plHandle, EscString+"$String =~ "+RegEx+"; $String;", 1, BufferSize)
EndProcedure

; Zerlegt einen String anhand eines beliebig langen Seperators in ein Array 
Procedure plStringToArray(MyArray.s(1), plHandle.l, String.s, Seperator.s = " ", BufferSize.l = 1024)
  Protected buffer.s = Space(BufferSize)
  Protected Rows.l
  plEval(plHandle, "my @WorkArray;", 0, BufferSize)
  Rows.l = Val(plEval(plHandle, "@WorkArray = split(/"+Seperator+"/, '"+String+"');", 1, BufferSize))
  
  ReDim MyArray.s(Rows - 1)
  For x = 0 To Rows - 1
    MyArray(x) = plEval(plHandle, "@WorkArray["+Str(x)+"];", 1, BufferSize)
  Next
EndProcedure

; Manipulation von Arrays mittels Perl splice()
Procedure plSplice(plHandle.l, MyArray.s(1), splStart.l, splStop.l, String.s = "", BufferSize.l = 1024)
  Protected buffer.s = Space(BufferSize)

  plEval(plHandle, "my @WorkArray = ();", 0, BufferSize)
    
  For x = 0 To PeekL(@MyArray.s() - 8) - 1
    plEval(plHandle, "$WorkArray["+Str(x)+"] = '" + MyArray.s(x) + "';", 0, BufferSize)  
  Next
  
  If String <> ""
    plEval(plHandle, "splice(@WorkArray,"+Str(splStart)+","+Str(splStop)+","+String+");", 0, BufferSize) 
  Else
    plEval(plHandle, "splice(@WorkArray,"+Str(splStart)+","+Str(splStop)+");", 0, BufferSize) 
  EndIf
  
  Rows.l = Val(plEval(plHandle, "@WorkArray;", 1, BufferSize))  
  ReDim MyArray.s(Rows - 1)
  
  For x = 0 To Rows - 1
      MyArray.s(x) = plEval(plHandle, "@WorkArray["+Str(x)+"];", 1, BufferSize)
  Next
  
EndProcedure

; Verschlüsselt einen String
Procedure.s plCrypt(plHandle.l, String.s, Salt.s, BufferSize = 1024)
   ProcedureReturn plEval(plHandle, "crypt('"+String+"','"+Salt+"');", 1, BufferSize)
EndProcedure

; Löscht das letzte Zeichen eines String
Procedure.s plChop(plHandle.l, String.s, BufferSize = 1024)
   ProcedureReturn plEval(plHandle, "my $out = '"+String+"'; chop($out); return $out;", 1, BufferSize)
EndProcedure

; Gibt den Timestamp zurück
Procedure.s plTime(plHandle.l)
   ProcedureReturn plEval(plHandle, "time();", 1)
EndProcedure

EscapeString.pbi

Code: Alles auswählen

; Autor: Thomas (ts-soft) Schulz

Procedure.s EscapeString(string.s)
  Protected term.c = 0, ende.l = 0
  Protected *c.Character = @string

  While *c\c ! 0
    If *c\c = '\'
      *c\c = term
    EndIf
    *c + SizeOf(Character)
  Wend

  ende = *c
  *c   = @string

  While *c ! ende
    If *c\c = term
      *c + SizeOf(Character)
      Select *c\c
        Case term : *c\c = '\'
        Case 'a'  : *c\c =  7 ; bel
        Case 'b'  : *c\c =  8 ; backspace
        Case 't'  : *c\c =  9 ; Tab
        Case 'l'  : *c\c = 10 ; linefeed
        Case 'f'  : *c\c = 12 ; formfeed
        Case 'r'  : *c\c = 13 ; return
        Case 'n'              ; carriage return
          *c - SizeOf(Character)
          *c\c = 13
          *c + SizeOf(Character)
          *c\c = 10
        Case 'q'  : *c\c = 34 ; dquote
      EndSelect
    EndIf
    *c + SizeOf(Character)
  Wend

  *c = @string

  While *c ! ende
    If *c\c = 0
      CopyMemory(*c + SizeOf(Character), *c, ende - *c)
    EndIf
    *c + SizeOf(Character)
  Wend

  ProcedureReturn string
EndProcedure

Macro esc(string) ; user defined
  EscapeString(string)
EndMacro 
Ich habe nochmal alle nötigen Dateien gepackt und hochgeladen.
HIER

Verfasst: 03.04.2007 16:53
von Nero
Habe das ganze mal einem kleinem Update unterzogen

Die PerlTools.pl ist soweit nicht mehr nötig habe die Proceduren alle auf
Eval umgestellt

Dann ist die EscapeString_Include.pbi von ts-soft dazugekommen um das Arbeiten mit String zu erleichtern.

Verfasst: 06.04.2007 21:18
von Nero
Hab gerade ein weiteres Update des Paketes hochgeladen :)

Das Zip Archiv findet ihr weiterhin unter obigen Link.

Neu ist da nur ein Beispiel um zu zeigen wie man mit *.pl Datei umgehen
kann anhand einer kleinen FlatFileDB Demo.

Verfasst: 06.04.2007 21:41
von ts-soft
Funktioniert sehr gut :allright:

In example.pb ist Dir ein Fehler unterlaufen, der Dateiname muß weg, sonst
kein Handle :wink:

Code: Alles auswählen

plHandle.l = PerlEzCreate("")
So funzt es

Gruß
Thomas

Verfasst: 06.04.2007 21:56
von Nero
Ups :lol:
Habe es geändert und neu hochgeladen.