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.
