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:

Startmaske
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:

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:

Suchergebnis
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:

Zurück zum Anfang dieses Projekts.