PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

PurePerl »»» Implementierung von Perl in PB

https://www.purebasic.fr/german/viewtopic.php?t=12425

Seite 12 von 12

Verfasst: 03.04.2007 17:45
von ts-soft
Nero hat geschrieben:Eigentlich ja nur müssen dann paar module dazugelegt werden sonst funktioniert das nicht.
Leg zu :mrgreen:
Das Paket ist sowieso nicht das kleinste, dank perl58.dll :wink:

Verfasst: 03.04.2007 17:46
von Kiffi
Nero hat geschrieben:Eigentlich ja nur müssen dann paar module dazugelegt werden sonst funktioniert das nicht.
"nur" hört sich gut an :-)

Was wären das für Module? Sind das diese *.PM-Dinger im Lib-Ordner?
Kann man die auch mit perlez aufrufen?

Grüße ... Kiffi

Verfasst: 03.04.2007 17:54
von Nero
jup das sind die *.pm

einbinden im perlsript kannste die gewöhnlich per z.B:
use IO::File;
ect. sollte man eigenetlich auch über den eval von perlez einbinden können.

Das "nur" ist so ne sache die module haben untereinander fiese abhängigkeiten so das man oft nicht nur ein modul mit installieren muß >_<

Verfasst: 04.04.2007 21:39
von wasser
perl mit pure mischen ...lol.....ne...ne...ne...

dann eher mit phyton proggen....das ist fein aber auch nicht mit pure mischen.

wenn du perl mit pure mischt , dann kannste die sicherheitlsücken im internet nicht mehr ausmachen.


mfg

Verfasst: 04.04.2007 21:45
von wasser
...Seit ich eine neue Homepage aufbaue, setze ich konsequent auf CGI/Perl. ...

jeder macht hompage, aber keine guten.
jeder meint er macht die besten und werden von tag zu tag beschissener.
lol... homepage-führerschein....lol


warum quälts du dich damit noch ab: CGI/Perl > sicherheit....lol...

mfg

Verfasst: 04.04.2007 23:03
von AND51
> jeder macht hompage, aber keine guten.
> jeder meint er macht die besten
Ich habe auch nie behauptet, meine Homepage sei die Beste. Was ich behaupte und behaupten darf ist aber, dass die jetzige Version X Mal besser ist als alles, was ich bisher im Homepagebereich gemacht habe.
Was meinst du außerdem mit Sicherheitslücken?
Perl (auf Webservern) ist nicht unsicher. Nur, wenn man es falsch bedient. Aber ich will da nicht vorgreifen und evtl. von DIngen erzählen die du nicht verstehst oder die du nicht meintest.


Wir wollen außerdem nicht PB mit Perl mischen. Wir sind ja nicht die, die an PBs Entwicklungsschraube drehen. Dafür ist Fred zuständig. TS'si, Nero und ich wollten nur eine Art Zusatzmodul für PB entwickeln.
Nutzbar für jeden, der es auch will. Wenn du nicht willst, dann lässt du es; ganz einfach. :)

Verfasst: 06.04.2007 21:34
von Nero
So hab mich heut mal hingesetzt und ne kleine Demo für ne FlatFileDB gemacht.
Sind zwar nur die rudimentärsten funktionen und geht bestimmt auch an so manchen stellen kürzer aber zu mehr hat ich heut keine lust mehr *g*

Als erstes die FlatFile_Demo.pl

Code: Alles auswählen

#!
my (%DBHash, %Config);

# Parameter: dbPath
sub dbConfig
{
  $Config{'Path'} = $_[0];
}

# Parameter: dbName
sub dbOpen
{
   if (!-e "$Config{'Path'}$_[0].db") { open(db, ">$Config{'Path'}$_[0].db"); print db "ID||"; close(db); }

   open(db, "<$Config{'Path'}$_[0].db");
     while(my $Line = <db>)
     {
       push(@{$DBHash{"$_[0]"}{'Data'}}, [split(/\|\|/, $Line)]);
     }
   close(db);
   $DBHash{"$_[0]"}{'Rows'} = scalar(@{$DBHash{"$_[0]"}{'Data'}}) - 1;
   $DBHash{"$_[0]"}{'Cols'} = scalar(@{$DBHash{"$_[0]"}{'Data'}[0]}) - 2;
   for (my $x = 0;$x <= $DBHash{"$_[0]"}{'Cols'};$x++)
   {
     $DBHash{"$_[0]"}{'Index'}{$DBHash{"$_[0]"}{'Data'}[0][$x]} = $x;
   }
   return $_[0];
}

# Parameter: HashID
sub dbRowNums { return $DBHash{"$_[0]"}{'Rows'}; }

# Parameter: HashID
sub dbColNums { return $DBHash{"$_[0]"}{'Cols'}; }

# Parameter: HashID
sub dbFree { delete $DBHash{"$_[0]"}; }

# Parameter: HashID, Index, RowEntry
sub dbSelectRow
{
  return 0 if(!$_[0] || !$_[1] || !$_[2]);
  for (my $x = 0;$x <= $DBHash{"$_[0]"}{'Rows'};$x++)
  {
    $DBHash{"$_[0]"}{'SelectedRow'} = $x if ($DBHash{"$_[0]"}{'Data'}[$x][$DBHash{"$_[0]"}{'Index'}{$_[1]}] eq $_[2]);
  }
  $DBHash{"$_[0]"}{'LastIndex'} = 0;
  $DBHash{"$_[0]"}{'LastEdit'}  = 0;
  return 1;
}

# Zuvor dbSelectRow() aufrufen!
# Parameter: HashID, Index (optional)
sub dbGetField
{
  return 0 if(!$_[0]);
  return $DBHash{"$_[0]"}{'Data'}[$DBHash{"$_[0]"}{'SelectedRow'}][$DBHash{"$_[0]"}{'Index'}{$_[1]}] if ($_[1] && $DBHash{"$_[0]"}{'Index'}{$_[1]});
         $DBHash{"$_[0]"}{'LastIndex'} = 0 if ($DBHash{"$_[0]"}{'LastIndex'} > $DBHash{"$_[0]"}{'Cols'});
  return $DBHash{"$_[0]"}{'Data'}[$DBHash{"$_[0]"}{'SelectedRow'}][$DBHash{"$_[0]"}{'LastIndex'}++];
}

# Zuvor dbSelectRow() aufrufen!
# Parameter: HashID, Entry, Index (optional)
sub dbSetField
{
  return 0 if(!$_[0] || !$_[1]);
  return $DBHash{"$_[0]"}{'Data'}[$DBHash{"$_[0]"}{'SelectedRow'}][$DBHash{"$_[0]"}{'Index'}{$_[2]}] = $_[1] if ($_[2] && $DBHash{"$_[0]"}{'Index'}{$_[2]});
         $DBHash{"$_[0]"}{'LastEdit'} = 0 if ($DBHash{"$_[0]"}{'LastEdit'} > $DBHash{"$_[0]"}{'Cols'});
         $DBHash{"$_[0]"}{'Data'}[$DBHash{"$_[0]"}{'SelectedRow'}][$DBHash{"$_[0]"}{'LastEdit'}++] = $_[1];
  return 1;
}

# Parameter: HashID
sub addRow
{
  return 0 if(!$_[0]);
  $DBHash{"$_[0]"}{'Rows'}++;
  $DBHash{"$_[0]"}{'Data'}[$DBHash{"$_[0]"}{'Rows'}][0] = $DBHash{"$_[0]"}{'Rows'};
  return 1;
}

# Parameter: HashID, IndexName
sub addIndex
{
  return 0 if(!$_[0]);
  $DBHash{"$_[0]"}{'Cols'}++;
  $DBHash{"$_[0]"}{'Index'}{"$_[1]"} = $DBHash{"$_[0]"}{'Cols'};
  $DBHash{"$_[0]"}{'Data'}[0][$DBHash{"$_[0]"}{'Cols'}] = $_[1];
  for (my $x = 1;$x <= $DBHash{"$_[0]"}{'Cols'};$x++)
  {
    $DBHash{"$_[0]"}{'Data'}[$x][$DBHash{"$_[0]"}{'Cols'}] = " ";
  }  
  return 1;
}

# Parameter: HashID, RowID
sub deleteRow
{
  return 0 if (!$_[0] || $_[1] < 1 || $_[1] > $DBHash{"$_[0]"}{'Rows'});
    splice(@{$DBHash{"$_[0]"}{'Data'}}, $_[1], 1);
    $DBHash{"$_[0]"}{'Rows'}--;
  return 1;
}

# Parameter: HashID, Index
sub deleteIndex
{
  return 0 if (!$_[0] || $_[1] eq "");
  my  @TempData;
  @TempData = @{$DBHash{"$_[0]"}{'Data'}};
  undef $DBHash{"$_[0]"}{'Data'};
  for (my $x = 0; $x <= $DBHash{"$_[0]"}{'Rows'};$x++)
  {
    for (my $y = 0; $y <= $DBHash{"$_[0]"}{'Cols'};$y++)
    {
      push(@{$DBHash{"$_[0]"}{'Data'}[$x]}, $TempData[$x][$y]) if($y != $DBHash{"$_[0]"}{'Index'}{"$_[1]"});
    }
  }  
  $DBHash{"$_[0]"}{'Cols'}--;
  return 1;
}

# Parameter: HashID, RowID, NewRowID
sub dbShift
{
  return 0 if (!$_[0] || $_[1] < 1 || $_[1] > $DBHash{"$_[0]"}{'Rows'} || $_[2] < 1 || $_[2] > $DBHash{"$_[0]"}{'Rows'});
  my @Temp = $DBHash{"$_[0]"}{'Data'}[$_[1]];
     splice(@{$DBHash{"$_[0]"}{'Data'}}, $_[1], 1);
     splice(@{$DBHash{"$_[0]"}{'Data'}}, $_[2], 0, @Temp);
     for ($x = 1;$x <= $DBHash{"$_[0]"}{'Rows'};$x++)
     {
       $DBHash{"$_[0]"}{'Data'}[$x][0] = $x;
     }
  return 1;
}

# Parameter: HashID
sub dbSave
{
  open(db, ">$Config{'Path'}$_[0].db");
    for (my $x = 0;$x <= $DBHash{"$_[0]"}{'Rows'};$x++)
    {
      for (my $y = 0;$y <= $DBHash{"$_[0]"}{'Cols'};$y++)
      {
        if (!$y && $x >= 1)
        {
          print db $x.'||';
        }
        else
        {
         if ($DBHash{"$_[0]"}{'Data'}[$x][$y])
         {
           chomp($DBHash{"$_[0]"}{'Data'}[$x][$y]);
           print db $DBHash{"$_[0]"}{'Data'}[$x][$y];
         }
          print db '||';
        }
      }
      print db "\n";
    }
  close(db);
}
Dann die flatfile.de

Code: Alles auswählen

ID||Vorname||Nachme||Email||
1||Rudi||Carrell||rudy@carrell.de||
2||Thomas||Gotschalk||thomas@gotschalk.de||
3||Steffan||Raab||steffan@raab.de||
4||Michael||Mittermeier||michael@mittermeier.de||
Und hier noch die FlatFile_Demo.pb

Code: Alles auswählen

; PureBasic Visual Designer v3.95 build 1485 (PB4Code)

XIncludeFile "PerlTools_Include.pbi"

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

Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
;
Enumeration
  #ListIcon_0
  #String_0
  #Button_0
  #Combo_0
  #Button_1
  #Button_2
  #Button_3
  #Editor_0
  #Button_4
  #Combo_1
  #String_1
  #Button_5
  #Button_6
  #Button_7    
EndEnumeration


Procedure Open_Window_0()
  If OpenWindow(#Window_0, 237, 95, 530, 443, "FlatFileDB Perl Demo",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_0))      
      ;-
      ListIconGadget(#ListIcon_0, 10, 10, 510, 110, "", 100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
      StringGadget(#String_0, 10, 140, 130, 20, "")
      ButtonGadget(#Button_0, 150, 140, 110, 20, "Index ertsellen")
      ComboBoxGadget(#Combo_0, 10, 170, 130, 100)
      ButtonGadget(#Button_1, 150, 170, 110, 20, "Index löschen")
      ButtonGadget(#Button_2, 400, 140, 120, 20, "Nach oben")
      ButtonGadget(#Button_3, 400, 170, 120, 20, "Nach unten")
      EditorGadget(#Editor_0, 10, 310, 510, 120, #PB_Editor_ReadOnly)
      ButtonGadget(#Button_4, 10, 280, 510, 20, "Änderungen Speichern")
      ComboBoxGadget(#Combo_1, 10, 220, 130, 100)
      StringGadget(#String_1, 150, 220, 240, 20, "")
      ButtonGadget(#Button_5, 400, 220, 120, 20, "Eintrag ändern")
      ButtonGadget(#Button_6, 10, 250, 130, 20, "Zeile einfügen")
      ButtonGadget(#Button_7, 150, 250, 130, 20, "Zeile löschen")      
    EndIf
  EndIf
EndProcedure


Open_Window_0()


Global dbHandle.s
Global Rows.l
Global Cols.l 

Procedure.s dbCall(plHandle.l, dbHandle.s, Sub.s, p1.s = "", p2.s = "", p3.s = "", p4.s = "", p5.s = "", p6.s = "", p7.s = "", BufferSize.l = 1024)
  Protected buffer.s = Space(BufferSize)
  Protected Result = PerlEzCall8(plHandle, Sub, buffer, BufferSize, "ssssss", @dbHandle, @p1, @p2, @p3, @p4, @p5, @p6, @p7);
  If Result = #plezNoError    
    ProcedureReturn buffer
  Else
    plDebugErrorString(Result)
  EndIf   
EndProcedure

Procedure getDBFile()  
ClearGadgetItemList(#Editor_0) 
  fString.s = ""
  OpenFile(0, "flatfile.db")
   For x = 0 To Rows
     fString + ReadString(0) +  Chr(13)
   Next
  CloseFile(0)
  SetGadgetText(#Editor_0, fString) 
EndProcedure


Procedure Refresh(plHandle.l)
   Rows = Val(dbCall(plHandle, dbHandle, "dbRowNums")) 
   Cols = Val(dbCall(plHandle, dbHandle, "dbColNums"))  
    
   FreeGadget(#ListIcon_0) 
   ListIconGadget(#ListIcon_0, 10, 10, 510, 110, "", 100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
   ClearGadgetItemList(#Combo_0) 
   ClearGadgetItemList(#Combo_1)
  
   For x = 0 To Rows    
   dbCall(plHandle, dbHandle, "dbSelectRow", "ID", Str(x))
   If x = 0
     dbCall(plHandle, dbHandle, "dbSelectRow", "ID", "ID")   
   EndIf
      

   If x <> 0
     AddGadgetItem(#ListIcon_0, x, "")  
   EndIf
     
     For y = 0 To Cols
       Text$ = dbCall(plHandle, dbHandle, "dbGetField") 
       If x = 0  
           If y <> 0 And Text$ <> ""
             AddGadgetItem(#Combo_0, y - 1, Text$) 
             AddGadgetItem(#Combo_1, y - 1, Text$)       
           EndIf       
         If y = 0 
           AddGadgetColumn(#ListIcon_0, y, Text$, 30)
         Else
           AddGadgetColumn(#ListIcon_0, y, Text$, 100)
         EndIf   
       EndIf  
       
     If x > 0   
       SetGadgetItemText(#ListIcon_0, x - 1, Text$, y) 
     EndIf          
     Next
   Next  
   SetGadgetState(#Combo_0, 0)
   SetGadgetState(#Combo_1, 0)
EndProcedure

dbCall(plHandle, dbHandle, "setPath", "./")
dbHandle = dbCall(plHandle, "flatfile", "dbOpen")
Rows     = Val(dbCall(plHandle, dbHandle, "dbRowNums")) 
Cols     = Val(dbCall(plHandle, dbHandle, "dbColNums")) 

getDBFile()

Refresh(plHandle)

Repeat ; Start of the event loop
  
  Event = WaitWindowEvent() ; This line waits until an event is received from Windows
  
  WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
  
  GadgetID = EventGadget() ; Is it a gadget event?
  
  EventType = EventType() ; The event type
  
  ;You can place code here, and use the result as parameters for the procedures
  
  If Event = #PB_Event_Gadget
     
    If GadgetID = #Button_0
      NewIndex$ = GetGadgetText(#String_0) 
      If NewIndex$ <> ""
       dbCall(plHandle, dbHandle, "addIndex", NewIndex$)
       SetGadgetText(#String_0, "")
       Refresh(plHandle)
      EndIf 
      
    ElseIf GadgetID = #Button_1
     Index.s = GetGadgetText(#Combo_0)  
         If Index <> ""          
          dbCall(plHandle, dbHandle, "deleteIndex", Index)
         EndIf
         Refresh(plHandle) 
    ElseIf GadgetID = #Button_2
      
      Item.l = GetGadgetState(#ListIcon_0) + 1
      If Item >= 1 
        dbCall(plHandle, dbHandle, "dbShift", Str(Item), Str(Item - 1))      
        Refresh(plHandle)
      EndIf
  
    ElseIf GadgetID = #Button_3
     
      Item.l = GetGadgetState(#ListIcon_0) + 1
      If Item <> -1
        dbCall(plHandle, dbHandle, "dbShift", Str(Item), Str(Item + 1))  
        Refresh(plHandle)
       EndIf
         
    ElseIf GadgetID = #Button_4
       dbCall(plHandle, dbHandle, "dbSave")  
       getDBFile()      
      
    ElseIf GadgetID = #Button_5
       NewEntry$ = GetGadgetText(#String_1)    
       NewEIndex$ = GetGadgetText(#Combo_1) 
       CurRow.l = GetGadgetState(#ListIcon_0) + 1 
       If CurRow <> -1 And NewEntry$ <> ""
         dbCall(plHandle.l, dbHandle.s, "dbSelectRow", "ID", Str(CurRow))
         dbCall(plHandle.l, dbHandle.s, "dbSetField", NewEntry$, NewEIndex$)
       EndIf 
       SetGadgetText(#String_1, "")
       Refresh(plHandle)  
       
    ElseIf GadgetID = #Button_6
      dbCall(plHandle, dbHandle, "addRow")    
      Refresh(plHandle) 
      
    ElseIf GadgetID = #Button_7  
      DelCurRow.l = GetGadgetState(#ListIcon_0) + 1  
      If DelCurRow <> -1
        dbCall(plHandle, dbHandle, "deleteRow", Str(DelCurRow))    
        Refresh(plHandle) 
      EndIf      
    EndIf
    
  EndIf
  
Until Event = #PB_Event_CloseWindow ; End of the event loop

PerlEzDelete(plHandle)
End
;

Verfasst: 07.04.2007 18:55
von Nero
Habe mir gerade mal die nötigen Module für die verwendung von DBI aus
dem Modul ordner mit nem progie extrahieren lassen.

Nun kann ich zwar auch MySql & was sonst so als standart DB bei perl dabei ist nutzen aber allein die ganzen Module die DBI brauch würden das ganze doch recht sehr aufblasen :mrgreen:.
Die Module allein wären um die 5MB :lol:
Das geht ja noch wen man sich selbst nen tool schreibt das niemand bekommt aber zum weitergeben eher nicht geeignet ^^
Dann doch lieber bei den standart Perlfunktionen bleiben da kann man ja schon ne ganze menge mit anstellen.

Verfasst: 07.04.2007 22:48
von AND51
Nero hat geschrieben:Dann die flatfile.de
Code:

Code: Alles auswählen

ID||Vorname||Nachme||Email|| 
1||Rudi||Carrell||rudy@carrell.de||
Treffendes Beispiel, das mit Rudi :lol:
Nimm doch lieber Dieter Nuhr! :wink:
Alle Zeiten sind UTC+02:00
Seite 12 von 12

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de