<Directory /home/httpd/test>
 AuthName test
 AuthType Basic
 PerlAuthenHandler TestAuth
 <Limit GET POST>
  require valid-user
 </Limit>
</Directory>

package TestAuth;

use     Apache::Constants   qw(OK AUTH_REQUIRED SERVER_ERROR);
use     Database;
use     Logger;
use     POSIX;

sub handler
{
    my  $req            =   shift;
    my  ($res,$passwd)  =   $req -> get_basic_auth_pw();
    my  $user           =   $req -> connection -> user();
    my  $date           =   POSIX::strftime("%c",localtime);

    if ( ! $res ) {
        $res = SERVER_ERROR;

        if ( ! $user ) {
            $req->note_basic_auth_failure();
            $res = AUTH_REQUIRED;
            Logger::std_warn ("TestAuth:User is empty:$user:$passwd:",  2 );
        } elsif ( my $cp = $rlda -> prepare(
                    'select password from users where
                    login = ?' ) ) {
            if ( $cp -> execute( $user ) ) {
                my  $r = $cp -> fetch();

                if ( $r || $DBI::err ==  0  ) {

                    if ( $r && $r -> [  0  ] &&
                            ( $passwd eq $r -> [  0  ] ) ) {
                        $res = OK;
                    } else {
                        $req->note_basic_auth_failure();
                        $res = AUTH_REQUIRED;

                        Logger::std_warn ("TestAuth:Input:$user:$passwd:",  2 );
                        if ( $r && $r -> [  0  ] ) {
                            Logger::std_warn ("TestAuth:Returned:$user:$r->[ 0 ]:",  2 );
                        } else {
                            Logger::std_warn ("TestAuth:Returned:$user:failed",  2 );
                        }
                    }
                } else {
                    Logger::std_warn ("Fetch: $DBI::errstr",  1 );
                }
            } else {
                Logger::std_warn ("Execute: $DBI::errstr",  1 );
            }
            $cp -> finish();
            $rlda -> disconnect() if $res != OK;
        } else {
            Logger::std_warn ("Prepare: $DBI::errstr",  1 );
        }
    }
    $res;
}

 1 ;