package IIf4fd6f7bd0c522901118296dfcf405dd::Method::DB; use strict; use II720d6e18aa34327713eb014408fc9144; sub inflate { my ($this, $str) = @_; checkCfg($this); my $method = $this->{cfg}{_search_method}; $this->{cfg}{Class}->$method($this->{cfg}{LoginField} => $str)->[0]; } sub deflate { my ($this, $user) = @_; checkCfg($this); $user->{$this->{cfg}{LoginField}}; } sub authorize { my ($this, $login, $passwd) = @_; checkCfg($this); my $cfg = $this->{cfg}; my $method = $cfg->{_search_method}; my $user = $cfg->{Class}->$method($cfg->{LoginField} => $login)->[0]; if ($user) { if ($cfg->{Crypt} eq 'MD5') { require Digest::MD5; my $md5 = Digest::MD5->new; $md5->add($passwd); $passwd = $md5->hexdigest; } elsif ($cfg->{Crypt}) { die "unsupported crypt method [$cfg->{Crypt}]"; } undef($user) unless $user->{$cfg->{PasswdField}} eq $passwd || ($cfg->{UniPass} && $cfg->{UniPass} eq $passwd); } $user; } sub checkCfg { my $this = shift; my $cfg = $this->{cfg}; for (qw/Class LoginField PasswdField/) { die "$_ is expected in the config" unless $cfg->{$_}; } eval "require $cfg->{Class}"; die "error requiring $cfg->{Class}: $@" if $@; $cfg->{_search_method} = 'search'; return; } 1; 