#!/usr/bin/perl -w

use CGI qw/:standard :netscape/;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use Fcntl qw/:flock/;

##################################################
# adress_1.pl Copyright 1999 Dr. Thomas Wieland
# wieland@k-town.de
# fuer den Perl-Stammtisch im Rahmen des
# 1. Pirmasenser Internetclubs
##################################################


##################################################
# Variablendeklaration
##################################################

# Methode der Datenuebergabe im Formular GET oder POST
# POST, wenn Daten in URL nicht auftauchen sollen
my $method = 'GET';

# Name und Pfad des Datenfiles
my $file = "adress.dat";

# Feldnamen
my @dbfields = qw/id fname lname phone email street plz addr/;

# Filelocking Windows = 0 (nein) Linux = 1 (ja)
my $lock = 1;


##################################################
# Hauptprogramm
##################################################

# HTTP Header und HEAD Ausgeben
print header(), 
      start_html(-BGCOLOR => 'white', 
                 -title => 'Adress DB die Erste');


if (param('insert')) {
    # Insertroutine
    # nur notwendige Parameter uebergeben
    &Einfuegen(map { param($_) } @dbfields);
    &Ueberschrift;
    &Suchformular;
} elsif (param('delete')) {
    # Loeschroutine
    &Loeschen;
    &Ueberschrift;
    &Suchformular;
} elsif (defined param('search')) {
    # Suchroutine
    &Ueberschrift;
    &Suchen
} elsif (param('edit')) {
    # Aenderungsroutine
    &Ueberschrift;
    &get_data;
    &Eingabeformular;

} else {
    # wenn kein Parameter gesetzt ist
    &Ueberschrift;
    &Suchformular;
}

print end_html();


##################################################
# Subroutinen
##################################################

##################################################
sub Ueberschrift {
##################################################
    print center(h1("Adress DB die Erste")),
          hr;
}


##################################################
sub Suchformular {
##################################################
    # Suchformular ausgeben
    print start_form(-method => $method),
          # Link fuer alle Eintraege
          p(a({href => url() .  "?search="},
              " Alle Einträge")),
          # Eingabefeld
          p("Suchbegriff: ", 
            textfield(-name => 'lname')),
          # Kommentar
          p(" Bitte Nachname oder Vorname oder ". 
            "Anfangsbuchstabe eingeben ! "),
          # Buttons
          p(submit(-name => 'search',
                   -value => 'Suche starten'),
            submit(-name => 'edit',
                   -value => 'Neuer Eintrag')),
          end_form();
}

##################################################
sub Eingabeformular {
##################################################
    # Eingabeformular als Tabelle ausgeben
    print start_form(-method => $method),
          hidden(-name => 'id'),
          table({"border" => 1},
          TR(td("Vorname:"), 
             td(textfield(-name => 'fname', -size => 40))),
          TR(td("Nachname:"), 
             td(textfield(-name => 'lname', -size => 40))),
          TR(td("Telefon:"), 
             td(textfield(-name => 'phone', -size => 40))),
          TR(td("Email:"), 
             td(textfield(-name => 'email', -size => 40))),
	      TR(td("Straße:"), 
             td(textfield(-name => 'street', -size => 40))),
	      TR(td("PLZ:"), 
             td(textfield(-name => 'plz', -size => 10))),
          TR(td("Ort:"), 
             td(textfield(-name => 'addr', -size => 40))),
          ),
          # Buttons
          p(submit(-name  => 'insert', 
                   -value => 'Speichern'), 
            submit(-name  => 'delete', 
                   -value => 'Eintrag löschen')), 
          end_form();
}

##################################################
sub Einfuegen {
##################################################
    # Werte der Eingabe
    my  @werte = @_;

    # id existiert Eintrag aendern
    if (param('id')) {
        my @lines;
        my $id = param('id');
        open (DAT, "+<$file") or die "Can't open $file: $!";
        if ($lock) {
            flock(DAT, LOCK_EX|LOCK_NB) or &fehler;
            flock(DAT, LOCK_EX) or die "Can't lock $file: $!";
        }
        #File in ein Array einlesen
        while (<DAT>) {
            chomp;
            push @lines, $_;
        }
        # File auf 0 Zeilen kuerzen
        seek(DAT, 0, 0) or die "Can't rewind $file: $!";
        truncate(DAT, 0) or die "Can't truncate $file: $!";
        my $string = join '|', @werte;
        # Aenderungen schreiben
        foreach (@lines) {
            if (/^$id/) {
                print DAT $string."\n";
            } else {
                print DAT $_."\n";
            }
        }
        close (DAT) or die "Can't close $file: $!";

    # keine id vorhanden hinzufuegen	
    } else {
        # ein neuer Eintrag
        $werte[0] = time . $$;
        my $string = join '|', @werte;
        open (DAT, ">>$file") or die "Can't open $file: $!";
        if ($lock) {
            flock(DAT, LOCK_EX|LOCK_NB) or &fehler;
            flock(DAT, LOCK_EX) or die "Can't lock $file: $!";
        }
        print DAT $string."\n";
        close (DAT) or die "Can't close $file: $!";
    }

    # alle Parameter param('..') loeschen
    Delete_all();
}

##################################################
sub Suchen {
##################################################
    my (@LoL, @sortetLoL, $i); 
    open (DAT, "<$file") or die "Can't open $file: $!";
    if ($lock) {
            flock(DAT, LOCK_SH|LOCK_NB) or &fehler;
            flock(DAT, LOCK_SH) or die "Can't lock $file: $!";
        }
    # Wurde ein Suchparameter eingegeben
    if (param('lname')) {
        my $regex  = param('lname');
        while (<DAT>) {
            chomp;
            my @line = split /\|/;
            if ($line[2] =~ /^$regex/i || $line[1] =~ /^$regex/i) {
                push @LoL, [ @line ];
            }
        }
    } else {  # alle Datensaetze
        while (<DAT>) {
            chomp;
            push @LoL, [ split /\|/ ];
        }
    }
    close (DAT) or die "Can't close $file: $!";

    # sortieren
    @sortetLoL = sort { $a->[2] cmp $b->[2]    # Name
                                 ||
                        $a->[1] cmp $b->[1]    # Vorname
                      } @LoL;
    
    # Ausgabe der Suche
    print "<center><TABLE BORDER=1>\n";
    # Tabellenueberschrift
    print TR(map { th($_) } 
      qw/Name Telefon Email Straße PLZ Ort/);
    # Tabellenzeilen
    for $i ( 0 .. $#sortetLoL ) {
        print "\n<TR>",
              td(a({href => url() . "?id=$sortetLoL[$i]->[0]&edit=1"}, 
                 "$sortetLoL[$i]->[2], $sortetLoL[$i]->[1]"));
        if ($sortetLoL[$i]->[3]) {
            print td($sortetLoL[$i]->[3]);
        } else {
            print td("&nbsp;")
        };
        if ($sortetLoL[$i]->[4]) {
            print td(a({href => "mailto:$sortetLoL[$i]->[4]"},
                     "$sortetLoL[$i]->[4]"));
        } else {
            print td("&nbsp;")
        };
        if ($sortetLoL[$i]->[5]) {
            print td($sortetLoL[$i]->[5]);
        } else {
            print td("&nbsp;")
        };
        if ($sortetLoL[$i]->[6]) {
            print td($sortetLoL[$i]->[6]);
        } else {
            print td("&nbsp;")
        };
        if ($sortetLoL[$i]->[7]) {
            print td($sortetLoL[$i]->[7]);
        } else {
            print td("&nbsp;")
        };
    }
    print "</table>",
          hr, a({href => url()}, "Zurück zum Anfang"), 
          "</center>";
    
    # alle Parameter param('..') loeschen
    Delete_all();
}

##################################################
sub get_data {
##################################################
    # Daten fuer eine id holen um Eingabeformular
    # zu fuellen
    open (DAT, "<$file") or die "Can't open $file: $!";
    if ($lock) {
            flock(DAT, LOCK_SH|LOCK_NB) or &fehler;
            flock(DAT, LOCK_SH) or die "Can't lock $file: $!";
        }
    while (<DAT>) {
        chomp;
        my @line = split /\|/;
        if ($line[0] == param('id')) {
            param(-name => 'fname',  -value => $line[1]);
            param(-name => 'lname',  -value => $line[2]);
            param(-name => 'phone',  -value => $line[3]);
            param(-name => 'email',  -value => $line[4]);
            param(-name => 'street', -value => $line[5]);
            param(-name => 'plz',    -value => $line[6]);
            param(-name => 'addr',    -value => $line[7]);
        }
    } 
    close (DAT) or die "Can't close $file: $!";
}

##################################################
sub Loeschen {
##################################################
    my @lines;
    my $id = param('id');
    open (DAT, "+<$file") or die "Can't open $file: $!";
    if ($lock) {
            flock(DAT, LOCK_EX|LOCK_NB) or &fehler;
            flock(DAT, LOCK_EX) or die "Can't lock $file: $!";
        }
    #File in ein Array einlesen
    while (<DAT>) {
        chomp;
        push @lines, $_;
    }
    # File auf 0 Zeilen kuerzen
    seek(DAT, 0, 0) or die "Can't rewind $file: $!";
    truncate(DAT, 0) or die "Can't truncate $file: $!";
    # alle Datensaetze ausser dem zu loeschenden
    # zurueckschreiben
    foreach (@lines) {
        if (!/^$id/) {
                print DAT $_."\n";
        }
    }
    close (DAT) or die "Can't close $file: $!";
    
    # alle Parameter param('..') loeschen
    Delete_all();
}

##################################################
sub fehler {
##################################################
    print "Leider ist die Anwendung im Moment nicht in der Lage ",
          "Ihre Anfrage zu berabeiten.<br><br>",
          "Bitte versuchen Sie es später erneut.";
    print end_html();
    exit;
}