Webbasierte Adressdatenbank
AdressDB die Erste
Liebe Perl-Stammtischler, lasst euch nicht von den 330 Zeilen Perl-Skript abschrecken, das sieht alles
schlimmer aus als es ist. Das Script gibt es natürlich hier, einfach anklicken,
und als adress_1.pl abspeichern.
>Für die ganz Ungeduldigen jetzt eine Kurzanleitung zur Installation: Das Skript ins cgi-bin Verzeichnis des
Webservers stellen und ausführbar machen (Linux Rechte 755), Eine Datei adress.dat als leeres File erstellen.
Diese Datei sollte unter Linux die
Rechte 666 bekommen, ggfs den Pfad in Zeile 25 an die eigenen Gegebenheiten anpassen. In Zeile 31 die Locking
Anweisung an das Betriebssystem anpassen und los gehts.
Wird das Programm aufgerufen erhält man folgende Ausgabe:
Bild 1: Startmaske
Hier kann man entweder ein Vorname oder Nachname oder ein Teil dessen eingeben, und die Suche starten (Groß- Klein- Schreibung wird ignoriert), oder man wechselt mit "Neuer Eintrag" in die Eingabemaske:
Bild 2: Eingabemaske
Wenn alle Daten eingegeben sind, einfach den "Speichern" Button drücken, und schon wandert der Datensatz in das File: adress.dat; danach erhält man wieder die Startmaske. Wenn man einen Suchbegriff spezifiziert hat, oder alle Einträge anwählt erhält man Bild 3:
Bild 3: Suchergebnis
Hier werden die Datensätze der Suche als Tabelle dargestellt. Der Link unter dem Namen ruft das Skript erneut auf, übergibt aber die ID des Datensatzen. Damit erhält man wieder Bild 2 mit den Daten des Datensatzes. Den kann man jetzt löschen oder ändern.
Wie funktioniert's?
In Zeile 3 - 6 laden wir alle notwendigen Module. Zuerst CGI.pm mit den Standardbefehlen und den Netscape HTML
Erweiterungen (hier als funktionsorientierte Schnittstelle), zur vereinfachten Nutzung der CGI Schnittstelle.
Carp, auch aus der CGI Famile, zur Ausgabe von
Fehlermeldungen auf dem Browser. Strict um unsichere Konstruckte zu unterbinden und Fcntl zur Nutzung der Lock
Konstanten. In den Zeilen 20 - 31 werden die wichtigsten Variablen deklariert. Von Zeile 34 bis 71 folgt das
Hauptprogramm. Hier geben wir erst mal einen gültigen HTTP Heder und die HTML-Head Anweisung aus. Danach stellen
wir mit param('insert')
fest, ob der Insert Parameter gesetzt wurde. Wenn ja übergeben
wir mit map
der Unterroutine Einfuegen
die vom Formular kommenden
Parameter. map
erzeugt aus den Feldnamen und der param
Anweisung
ein Array, das die Eingabedaten enthält, und ist etwa den folgenden Zeilen gleichzusetzten:
my @werte; foreach (@dbfields) { push @werte, param($_); } &Einfuegen(@werte);
Im nächsten Teil verzweigen wir bei Bedraf zur Löschroutine, danach zur Suchroutine, bzw zur Änderungsroutine.
Werden keine Paramter beim Skriptaufruf mitgegeben, geben wir nur eine Überschrift und das Suchformular aus (Bild 1).
Das Suchformular erzeugen wir in 86 bis 106. Dazu verwenden wir die Methode start_form()
aus
dem CGI Modul. (Bitte die Doku dazu lesen!!) Die Funktion a({href => ..} ..)
erzeugt,
oh Wunder, einen Hyperlink, url()
eine selbstreferenzierende URL auf unser Skript. In den
Zeilen 108 bis 136 folgt dann das Eingabeformular. Auch hier wird wieder mit start_form()
ein
Formular erzeugt. Mit TR()
und td()
machen wir uns das Leben
leichter beim Erstellen von Tabellen. Der Befehl hidden()
zaubert ein Hidden Field in das
Formular, in dem bei einer Änderung die eindeutige ID unseres Datensatzes steht, falls es eine Neueingabe ist,
steht hier natürlich noch nichts drin. Das Einfügen und Ändern von Datensätzen übernimmt der Teil von Zeile 138 bis 188.
Hier stellen wir erst einmal fest, ob eine eindeutige ID beim Aufruf übergeben wurde, wenn ja, dann ist es eine Änderung,
wenn nein, dann ist es ein Einfügen. Beim Ändern lesen wir erst alle Datensätze aus der Datei, leeren die Datei und
schreiben alles, inclusive des geänderten Datensatzes wieder zurück. Beim Hinzufügen, öffnen wir die Datei im Append Modus,
erzeugen aus der Systemzeit und der Prozeßid eine eindeutige ID und setzen den Datensatz mit join
zu einem String zusammen und hängen den an die Adressdatei an. Die Funktion Suchen
folgt dann in
den Zeilen 190 bis 266. Dieser Funktion geben wir den Suchstring mit (falls vorhanden). Dann lesen wir Zeile für Zeile
aus der Datei und vergleichen den Nachnamen und, oder Vornamen mit dem Suchstring. Wird kein Suchparameter übergeben,
oder gleich "Alle Einträge" gewählt, lesen wir alle Datensätze ein. Die Datensätze befinden sich dann in der
List of List @LoL
. Jetzt müssen wir nur noch sortieren, und alles als Tabelle ausgeben.
Dabei unterlegen wir das Namensfeld mit einem Link auf unser Skript, das die Parameter edit
und id
übergibt, Damit wir dann eine gefüllte Eingabemaske erhalten um den Datensatz löschen
oder ändern zu können. Unter der E-Mail Adresse liegt dann ein mailto:e-mail
um einfach eine
E-Mail an den betreffenden abschicken zu können. Die Funktion get_data
(286-292) holt anhand
der ID den Datensatz aus der Datei und belegt damit die Eingabefelder des Formulars vor. In den Zeilen 294 bis 323
folgt dann die Funktion zum Löschen eines Datensatzes. Das geht analog dem Ändern, lediglich schreiben wir hier nur die
nicht zu löschenden Datesäte wieder zurück. Zum Schluß folgt noch eine Fehlerroutine, damit wir den Benutzer darauf
hinweisen können, wenn ein Lock des Datenfiles nicht möglich ist.
Mit Sicherheit geht das Ganze auch anders, oder wie eine alte Perl Weisheit lautet TIMTOWTDI
"Es gibt mehr als ein Weg es zu tun". Die Zweite Version des Skripts wird auch auf einem Textfile als Datenbasis
beruhen. Hier werden wir allerdings nicht so viele Klimmzüge machen müssen, denn wir nutzen dann SQL Befehle um Datensätze zu
ändern, löschen oder hinzuzufügen. Das Skript wird voraussichtlich nur 100 bis 150 Zeilen umfassen. Allerdings sollte
nicht unerwähnt bleiben das die Grundidee (noch zu erstellende Variante 2) zu diesem Skript aus der Feder von
Michael Schilli stammt.
Das Script
adress_1.pl
1: #!/usr/bin/perl -w 2: 3: use CGI qw/:standard :netscape/; 4: use CGI::Carp qw/fatalsToBrowser/; 5: use strict; 6: use Fcntl qw/:flock/; 7: 8: ################################################## 9: # adress_1.pl Copyright 1999 Dr. Thomas Wieland 10: # wieland@k-town.de 11: # fuer den Perl-Stammtisch im Rahmen des 12: # 1. Pirmasenser Internetclubs 13: ################################################## 14: 15: 16: ################################################## 17: # Variablendeklaration 18: ################################################## 19: 20: # Methode der Datenuebergabe im Formular GET oder POST 21: # POST, wenn Daten in URL nicht auftauchen sollen 22: my $method = 'GET'; 23: 24: # Name und Pfad des Datenfiles 25: my $file = "adress.dat"; 26: 27: # Feldnamen 28: my @dbfields = qw/id fname lname phone email street plz addr/; 29: 30: # Filelocking Windows = 0 (nein) Linux = 1 (ja) 31: my $lock = 1; 32: 33: 34: ################################################## 35: # Hauptprogramm 36: ################################################## 37: 38: # HTTP Header und HEAD Ausgeben 39: print header(), 40: start_html(-BGCOLOR => 'white', 41: -title => 'Adress DB die Erste'); 42: 43: 44: if (param('insert')) { 45: # Insertroutine 46: # nur notwendige Parameter uebergeben 47: &Einfuegen(map { param($_) } @dbfields); 48: &Ueberschrift; 49: &Suchformular; 50: } elsif (param('delete')) { 51: # Loeschroutine 52: &Loeschen; 53: &Ueberschrift; 54: &Suchformular; 55: } elsif (defined param('search')) { 56: # Suchroutine 57: &Ueberschrift; 58: &Suchen 59: } elsif (param('edit')) { 60: # Aenderungsroutine 61: &Ueberschrift; 62: &get_data; 63: &Eingabeformular; 64: 65: } else { 66: # wenn kein Parameter gesetzt ist 67: &Ueberschrift; 68: &Suchformular; 69: } 70: 71: print end_html(); 72: 73: 74: ################################################## 75: # Subroutinen 76: ################################################## 77: 78: ################################################## 79: sub Ueberschrift { 80: ################################################## 81: print center(h1("Adress DB die Erste")), 82: hr; 83: } 84: 85: 86: ################################################## 87: sub Suchformular { 88: ################################################## 89: # Suchformular ausgeben 90: print start_form(-method => $method), 91: # Link fuer alle Eintraege 92: p(a({href => url() . "?search="}, 93: " Alle Einträge")), 94: # Eingabefeld 95: p("Suchbegriff: ", 96: textfield(-name => 'lname')), 97: # Kommentar 98: p(" Bitte Nachname oder Vorname oder ". 99: "Anfangsbuchstabe eingeben ! "), 100: # Buttons 101: p(submit(-name => 'search', 102: -value => 'Suche starten'), 103: submit(-name => 'edit', 104: -value => 'Neuer Eintrag')), 105: end_form(); 106: } 107: 108: ################################################## 109: sub Eingabeformular { 110: ################################################## 111: # Eingabeformular als Tabelle ausgeben 112: print start_form(-method => $method), 113: hidden(-name => 'id'), 114: table({"border" => 1}, 115: TR(td("Vorname:"), 116: td(textfield(-name => 'fname', -size => 40))), 117: TR(td("Nachname:"), 118: td(textfield(-name => 'lname', -size => 40))), 119: TR(td("Telefon:"), 120: td(textfield(-name => 'phone', -size => 40))), 121: TR(td("Email:"), 122: td(textfield(-name => 'email', -size => 40))), 123: TR(td("Straße:"), 124: td(textfield(-name => 'street', -size => 40))), 125: TR(td("PLZ:"), 126: td(textfield(-name => 'plz', -size => 10))), 127: TR(td("Ort:"), 128: td(textfield(-name => 'addr', -size => 40))), 129: ), 130: # Buttons 131: p(submit(-name => 'insert', 132: -value => 'Speichern'), 133: submit(-name => 'delete', 134: -value => 'Eintrag löschen')), 135: end_form(); 136: } 137: 138: ################################################## 139: sub Einfuegen { 140: ################################################## 141: # Werte der Eingabe 142: my @werte = @_; 143: 144: # id existiert Eintrag aendern 145: if (param('id')) { 146: my @lines; 147: my $id = param('id'); 148: open (DAT, "+<$file") or die "Can't open $file: $!"; 149: if ($lock) { 150: flock(DAT, LOCK_EX|LOCK_NB) or &fehler; 151: flock(DAT, LOCK_EX) or die "Can't lock $file: $!"; 152: } 153: #File in ein Array einlesen 154: while (<DAT>) { 155: chomp; 156: push @lines, $_; 157: } 158: # File auf 0 Zeilen kuerzen 159: seek(DAT, 0, 0) or die "Can't rewind $file: $!"; 160: truncate(DAT, 0) or die "Can't truncate $file: $!"; 161: my $string = join '|', @werte; 162: # Aenderungen schreiben 163: foreach (@lines) { 164: if (/^$id/) { 165: print DAT $string."\n"; 166: } else { 167: print DAT $_."\n"; 168: } 169: } 170: close (DAT) or die "Can't close $file: $!"; 171: 172: # keine id vorhanden hinzufuegen 173: } else { 174: # ein neuer Eintrag 175: $werte[0] = time . $$; 176: my $string = join '|', @werte; 177: open (DAT, ">>$file") or die "Can't open $file: $!"; 178: if ($lock) { 179: flock(DAT, LOCK_EX|LOCK_NB) or &fehler; 180: flock(DAT, LOCK_EX) or die "Can't lock $file: $!"; 181: } 182: print DAT $string."\n"; 183: close (DAT) or die "Can't close $file: $!"; 184: } 185: 186: # alle Parameter param('..') loeschen 187: Delete_all(); 188: } 189: 190: ################################################## 191: sub Suchen { 192: ################################################## 193: my (@LoL, @sortetLoL, $i); 194: open (DAT, "<$file") or die "Can't open $file: $!"; 195: if ($lock) { 196: flock(DAT, LOCK_SH|LOCK_NB) or &fehler; 197: flock(DAT, LOCK_SH) or die "Can't lock $file: $!"; 198: } 199: # Wurde ein Suchparameter eingegeben 200: if (param('lname')) { 201: my $regex = param('lname'); 202: while (<DAT>) { 203: chomp; 204: my @line = split /\|/; 205: if ($line[2] =~ /^$regex/i || $line[1] =~ /^$regex/i) { 206: push @LoL, [ @line ]; 207: } 208: } 209: } else { # alle Datensaetze 210: while (<DAT>) { 211: chomp; 212: push @LoL, [ split /\|/ ]; 213: } 214: } 215: close (DAT) or die "Can't close $file: $!"; 216: 217: # sortieren 218: @sortetLoL = sort { $a->[2] cmp $b->[2] # Name 219: || 220: $a->[1] cmp $b->[1] # Vorname 221: } @LoL; 222: 223: # Ausgabe der Suche 224: print "<center><TABLE BORDER=1>\n"; 225: # Tabellenueberschrift 226: print TR(map { th($_) } 227: qw/Name Telefon Email Straße PLZ Ort/); 228: # Tabellenzeilen 229: for $i ( 0 .. $#sortetLoL ) { 230: print "\n<TR>", 231: td(a({href => url() . "?id=$sortetLoL[$i]->[0]&edit=1"}, 232: "$sortetLoL[$i]->[2], $sortetLoL[$i]->[1]")); 233: if ($sortetLoL[$i]->[3]) { 234: print td($sortetLoL[$i]->[3]); 235: } else { 236: print td(" ") 237: }; 238: if ($sortetLoL[$i]->[4]) { 239: print td(a({href => "mailto:$sortetLoL[$i]->[4]"}, 240: "$sortetLoL[$i]->[4]")); 241: } else { 242: print td(" ") 243: }; 244: if ($sortetLoL[$i]->[5]) { 245: print td($sortetLoL[$i]->[5]); 246: } else { 247: print td(" ") 248: }; 249: if ($sortetLoL[$i]->[6]) { 250: print td($sortetLoL[$i]->[6]); 251: } else { 252: print td(" ") 253: }; 254: if ($sortetLoL[$i]->[7]) { 255: print td($sortetLoL[$i]->[7]); 256: } else { 257: print td(" ") 258: }; 259: } 260: print "</table>", 261: hr, a({href => url()}, "Zurück zum Anfang"), 262: "</center>"; 263: 264: # alle Parameter param('..') loeschen 265: Delete_all(); 266: } 267: 268: ################################################## 269: sub get_data { 270: ################################################## 271: # Daten fuer eine id holen um Eingabeformular 272: # zu fuellen 273: open (DAT, "<$file") or die "Can't open $file: $!"; 274: if ($lock) { 275: flock(DAT, LOCK_SH|LOCK_NB) or &fehler; 276: flock(DAT, LOCK_SH) or die "Can't lock $file: $!"; 277: } 278: while (<DAT>) { 279: chomp; 280: my @line = split /\|/; 281: if ($line[0] == param('id')) { 282: param(-name => 'fname', -value => $line[1]); 283: param(-name => 'lname', -value => $line[2]); 284: param(-name => 'phone', -value => $line[3]); 285: param(-name => 'email', -value => $line[4]); 286: param(-name => 'street', -value => $line[5]); 287: param(-name => 'plz', -value => $line[6]); 288: param(-name => 'addr', -value => $line[7]); 289: } 290: } 291: close (DAT) or die "Can't close $file: $!"; 292: } 293: 294: ################################################## 295: sub Loeschen { 296: ################################################## 297: my @lines; 298: my $id = param('id'); 299: open (DAT, "+<$file") or die "Can't open $file: $!"; 300: if ($lock) { 301: flock(DAT, LOCK_EX|LOCK_NB) or &fehler; 302: flock(DAT, LOCK_EX) or die "Can't lock $file: $!"; 303: } 304: #File in ein Array einlesen 305: while (<DAT>) { 306: chomp; 307: push @lines, $_; 308: } 309: # File auf 0 Zeilen kuerzen 310: seek(DAT, 0, 0) or die "Can't rewind $file: $!"; 311: truncate(DAT, 0) or die "Can't truncate $file: $!"; 312: # alle Datensaetze ausser dem zu loeschenden 313: # zurueckschreiben 314: foreach (@lines) { 315: if (!/^$id/) { 316: print DAT $_."\n"; 317: } 318: } 319: close (DAT) or die "Can't close $file: $!"; 320: 321: # alle Parameter param('..') loeschen 322: Delete_all(); 323: } 324: 325: ################################################## 326: sub fehler { 327: ################################################## 328: print "Leider ist die Anwendung im Moment nicht in der Lage ", 329: "Ihre Anfrage zu berabeiten.<br><br>", 330: "Bitte versuchen Sie es später erneut."; 331: print end_html(); 332: exit; 333: }
Literaturhinweise:
- O Reilly Perl Module Doku
- perldoc CGI
Zurück zum Anfang dieses Projekts.