package PersonenDB;
use strict;
use warnings;
use IO::File;
use Fcntl qw(:flock :seek);
use utf8;

# Trenner
my $separator=";";
# Zeilenende
my $lineend="\x0A";

my @force_names=qw(vorname nachname address);
my @optional_names=qw(person website email dienstzeit dienstgrad dienststellung einheit nummer typ);
my @all_names=(@force_names,@optional_names);

my @typen=(
 ['Minenleger',     'KSS Projekt 1159 (Koni-class)'     ],
 ['Minenleger',     'MSR Projekt 89.2 (Kondor-class)'   ],
 ['U-Jagd',         'U-Jagd Projekt 133 (Parchim-class)'],
 ['Landungsschiff', 'LSM Projekt 108 (Frosch-class)'    ],
);

sub typen{ return @typen; }
sub key_names{ return @all_names; }

# PersonenDB->new($filename);
sub new
{
  my $class=shift;
  my $filename=shift;

  my $self={};
  $self->{filename}=$filename;
  $self->{data}    =undef;
  $self->{fh}      =undef;
  $self->{error}   ='';

  bless($self,$class);

  $self->read();

  return $self;
}

sub error
{
  my $self=shift;
  my $err=$self->{error};
  $self->{error}='';
  return $err;
}

# Benutzer Sortieren
sub sort
{
  my $self=shift;

  @{$self->{data}}=sort __sort @{$self->{data}};

  return 1;
}

# generisches Golen von Nutzern
sub get_by
{
  my $self=shift;
  my $key=shift;
  my $val=shift;

  return __filter($self->{data},$key,$val);
}

# alle benutzer mit dem Vornamen
sub get_by_vorname
{
  my $self=shift;
  my $name=shift;

  return __filter($self->{data},'vorname',$name);
}

# alle Benutzer mit dem Nachnamen
sub get_by_nachname
{
  my $self=shift;
  my $name=shift;

  return __filter($self->{data},'nachname',$name);
}

# alle nutzer mit dem Vormanem und namen
sub get_by_name
{
  my $self=shift;
  my $vorname=shift;
  my $nachname=shift;

  my @l=__filter($self->{data},'nachname',$vorname);
  @l=__filter(\@l,'vorname',$nachname);
  return @l;
}

# allen Nutzter mit der Email
sub get_by_email
{
  my $self=shift;
  my $email=shift;
  return __filter($self->{data},'email',$email);
}

# Existiert person?
sub exists
{
  my $self=shift;
  my $user=shift;
  my @l=$self->get_by_name($user->{vorname},$user->{nachname});
  unless(@l)
  {
    @l=$self->get_by_email($user->{email});
    return 0 unless(@l);
  }
  return 1;
}

# daten lesen
sub read
{
  my $self=shift;

  # Datei öffnen:
  return 0 unless($self->_open());

  my $fh=$self->{fh};

  # Datei sperren
  flock($fh,LOCK_EX);

  # zum Anfang der Datei
  $fh->seek(0,SEEK_SET);

  # Liste leeren
  $self->{data}=[];

  # format:
  #   Vorname\0Name\0Wohnort\0Webseite\0Mailadresse\0Dienstzeit\0Dienstgrad\0Dienststellung\x0A
  # zeilen die mir '\s*#' starten werden ignoriert!
  local $/=$lineend;
  while(my $line=<$fh>)
  {
    chomp($line);
    next if($line=~/^\s*#/);
    $line=~s/^\s*//;
    next unless($line);

    my @data=map{__unquote($_)}split($separator,$line);
    push(@{$self->{data}},{map{$all_names[$_] => $data[$_]}(0..$#all_names)});
  }

  # Datei entsperren
  flock($fh,LOCK_UN);

  # Liste sortieren:
  $self->sort();


  return 1;
}

# Person hinzufügen
sub add
{
  my $self=shift;
  my $data=shift;

  # nicht hinzufügen wenn nicht alle wichtigen daten vorhanden
  for(@force_names)
  {
    unless($data->{$_})
    {
      $self->{error}.= sprintf("%s ist Leer!\n",$_);
      return 0;
    }
  }

  # unnötige werde auf '' setzen.
  for(@optional_names)
  { $data->{$_}='' unless($data->{$_}); }

  # testen ob die Emailadersse korrekt ist
  if($data->{'email'})
  {
    unless($data->{'email'}=~/^[\w._%+-]+@[\w.-]+\.\w{2,4}$/)
    {
      $self->{error}.= sprintf("%s ist keine korrekte Emailadresse!\n",$data->{'email'});
      return 0;
    }
  }

  # nicht hinzufügen wenn schon vorhanen
  if($self->exists($data))
  {
    $self->{error}.= "Der Name ist schon Eingetragen!\n";
    return 0;
  }

  # Datei öffnen wenn nicht schon offen:
  return 0 unless($self->_open());

  # Daten serialisieren
  my $string="  ".join($separator,map{__quote($data->{$_})}@all_names).$lineend;

  my $fh=$self->{fh};

  # Datei sperren
  flock($fh,LOCK_EX);

  # zum Ende der Datei:
  $fh->seek(0,SEEK_END);

  # schreiben
  $fh->print($string);

  #das schreiben der Daten erzwingen
  $fh->flush();
  $fh->sync();

  # Datei Entsperren
  flock($fh,LOCK_UN);

  # zur Liste hinzufügen
  push(@{$self->{data}},$data);

  # sortieren
  $self->sort();

  return 1;
}

# alle Daten
sub all
{
  my $self=shift;
  return @{$self->{data}};
}

########################################################################
# privat

sub _open
{
  my $self=shift;
  # Datei öffnen wenn nicht offen
  $self->{fh}=IO::File->new() unless($self->{fh});
  if(!$self->{fh}->opened())
  {
    unless($self->{fh}->open($self->{filename},"+>>"))
    {
      $self->{error}.= "Die Datenbank lässt sich nicht öffnen!\n";
      return 0;
    }
  }
  return 1;
}

# sortierung
sub __sort
{
  for (qw(nachname address vorname))
  {
    my $x=lc($a->{$_}) cmp lc($b->{$_});
    return $x if($x != 0);
  }
  return 0;
}

# Geschützte Zeichen Entwerten
sub __quote
{
  my $val=shift;
  $val=~s/(%|\Q$separator\E|\Q$lineend\E)/'%'.join('%',map{sprintf('%03u',ord($_))}split('',$1))/egs;
  return $val;
}

# Entwertung rückgängig machen
sub __unquote
{
  my $val=shift;
  $val=~s/%(\d\d\d)/chr($1)/egs;
  return $val;
}

sub __filter
{
  my @liste=@{shift()};
  my $key=shift;
  my $value=shift;

  for my $pos (reverse(0..$#liste))
  {
    my $v=$liste[$pos];
    splice(@liste,$pos,1) if(!exists($v->{$key}) || $v->{$key} ne $value);
  }

  return @liste;
}

1;