File Coverage

blib/lib/HTTP/Server/Simple/Authen.pm

Criterion	Covered	Total	%
statement	9	27	33.3
branch	0	6	0.0
condition	0	4	0.0
subroutine	3	7	42.8
pod	2	4	50.0
total	14	48	29.1

package HTTP::Server::Simple::Authen;

use strict;
our $VERSION = '0.04';

use Carp;
use MIME::Base64;

sub do_authenticate {
    my $self = shift;
    if (($ENV{HTTP_AUTHORIZATION} || '') =~ /^Basic (.*?)$/) {
        my($user, $pass) = split /:/, (MIME::Base64::decode($1) || ':');
        if ($self->authen_handler->authenticate($user, $pass)) {
            return $user;
        }
    }

    return;
}

sub authen_realm { "Authorized area" }

sub authen_handler {
    my $class = ref(shift);
    Carp::croak("You have to override $class\::authen_handler to return Authen::Simple object");
}

sub authenticate {
    my $self = shift;
    my $user = $self->do_authenticate();
    unless (defined $user) {
        my $realm = $self->authen_realm();
        print "HTTP/1.0 401\r\n";
        print qq(WWW-Authenticate: Basic realm="$realm"\r\n\r\n);
        print "Authentication required.";
        return;
    }
    return $user;
}

1;
__END__