use strict; use warnings; use utf8; # Datenbank zur Verwaltung von Nutzern package mydb; our %update; # Objekt erzeugen sub new { my $class=shift; my $file=shift; return undef unless($file); my $self={}; $self->{file} =$file; $self->{table} ={}; $self->{last} =0; bless($self,ref($class)||$class); $self->load; return $self; } # wenn Objekt zerstört, dann speichern sub DESTROY { shift->save(); } # db laden sub load { my $self=shift; $self->{update}=1; return 0 unless(-f $self->{file}); if(open(my $fh, '<', $self->{file})) { # zeilenweise lesen. while(<$fh>) { chomp; next unless($_); my $user=mydb::user->new($_,"$self"); if($user) { # user existiert schon # Benutzerdaten aktualisieren if($self->{table}->{$user->name}) { $self->{table}->{$user->name}->update($user); } # neuen User hinzufügen else { $self->{table}->{$user->name}=$user; } } } close($fh); $update{"$self"}=0; $self->{last}=-M $self->{file}; } } sub save { my $self=shift; if($update{"$self"} && %{$self->{table}}) { my $str=''; while(my ($n,$o)=each(%{$self->{table}})) { $str.= $o->to_string() if($o); } $self->_update(); if(open(my $fh, '>', $self->{file})) { print $fh $str; close($fh); delete($update{"$self"}); return 1; } return 0 } return 1; } sub del { my $self=shift; my $name=shift; $self->_update(); return 0 unless($name && exists($self->{table}->{$name})); delete($self->{table}->{$name}); $update{"$self"}=1; return 1; } sub has{ return exists($_[0]->{table}->{$_[1]}); } # user Objekt setzen/holen sub user { my $self=shift; return undef unless($_[0]); my $user; # es ist ein User-Objekt if(ref($_[0]) eq 'mydb::user') { $user=shift(); if(!$self->{table}->{$user->name()}) { $user->{parent}="$self"; $self->{table}->{$user->name()}=$user; $update{"$self"}=1; } } # es ist ein Hash mit den Werten des neuen Nutzers elsif(ref($_[0]) eq 'HASH') { if(!$self->{table}->{$_[0]->{name}}) { $user=mydb::user->new(shift(),"$self"); if($user) { $self->{table}->{$user->name()}=$user; $update{"$self"}=1; } } } # es ist ein String # also wird ein Nutzer verlangt else { my $name=shift(); $user=$self->{table}->{$name} if($name) } return $user; } sub user_name_list { return keys(%{shift()->{table}}); } sub user_list { return values(%{shift()->{table}}); } ######################################################################## sub _update { my $self=shift; return $self->load() if(-f $self->{file} && (!$self->{last} || -M $self->{file} != $self->{last})); return 1; } ######################################################################## ######################################################################## ######################################################################## # das Paket mydb::user ist die Klasse, # mit der die Daten zu einem Nutzer verwaltet werden package mydb::user; use Digest::MD5 qw(md5_hex); # Namen und Position der Werte in der DB-Datei my @options=qw(name pass rights mail active); # neues Objekt erzeugen. # es muss eine Hashrefenzen mit den Nutzerdaten übergeben werden sub new { my $class=shift; my $data=shift; my $parent=shift; # wenn data ein String, # dann string zwerlegen und in Hash wandeln # danach new mit hash-ref aufrufen. if(ref($data) ne 'HASH') { my @row=split(/#/,$data); my %data; for my $key (@options) { last unless(@row); my $val=shift(@row); $val=__unquote($val) if(defined($val)); $data{$key}=$val; } return new($class,\%data,$parent); } my $self={}; $self->{parent}=$parent; bless($self, $class); return undef unless($self->update($data)); return $self; } # werte aktualisieren sub update { my $self=shift; my $data=shift; # richtiges Refenzformat? return 0 if(ref($data) ne 'HASH' && ref($data) ne 'mydb::user'); # alle Werte vorhanden? return 0 unless(grep{defined($data->{$_})}@options); # werte neu setzten $self->{$_}=$data->{$_} for(@options); return 1; } # allgemeiner getter/setter sub _value { my $self=shift; my $name=shift; return undef unless(grep{ $name eq $_ }@options); my $val=shift; if(defined($val)) { $self->{$name}=$val; $update{$self->{parent}}=1 if($self->{parent}); } return $self->{$name}; } # namen lesen sub name { shift()->{name}; } # rechte setzen/lesen sub rights{ shift->_value('rights',@_); } # mail setzen/lesen sub mail { shift->_value('mail',@_); } # status setzen/lesen sub active{ shift->_value('active',@_); } # passwort setzen/lesen sub pass { my $self=shift; my $pass=shift; # passwort verschlüsseln wenn es gesetzt wird. $pass=md5_hex($pass) if($pass); $self->_value('pass', $pass); } # passwort prüfen sub chk { my $self=shift; my $pass=shift; return 0 unless($pass && $self->pass() eq md5_hex($pass)); return 1; } # Werte serialisieren. sub to_string { my $self=shift; return join('#',map{ __quote($self->{$_}) }@options)."\n"; } # string quoten # wird zum serialisieren gebraucht. sub __quote { my $str=shift; $str=~s/#/&raute;/g; return $str; } # string unquoten # wird zum deserialisieren gebraucht. sub __unquote { my $str=shift; $str=~s/\Q&raute;/#/g; return $str; } 1;