File Coverage

blib/lib/CGI/Lazy/Authn.pm

Criterion	Covered	Total	%
statement	9	76	11.8
branch	0	10	0.0
condition	0	18	0.0
subroutine	3	17	17.6
pod	2	14	14.2
total	14	135	10.3

package CGI::Lazy::Authn;

use strict;

use CGI::Lazy::Globals;
use Digest::MD5;

#----------------------------------------------------------------------------------------
sub activeField {
	my $self = shift;

	return $self->{_activeField};
}

#----------------------------------------------------------------------------------------
sub authenticate {
	my $self = shift;

	my $extraFields = $self->extraFields;
	my @extraFields;
	my @binds;

	my $username = $self->q->param($self->userField);
	my $passwd = $self->q->param($self->passwdField);

	return unless $username && $passwd;

	$passwd = $self->passwdhash($username, $passwd);

	push @binds, $username;
	push @binds, $passwd;

	#$self->q->util->debug->edump($passwd);

	foreach my $webfield (keys %$extraFields) {
		push @extraFields, $extraFields->{$webfield};
		push @binds, $self->q->param($webfield);
	}

	my $query = 'select * from '. $self->table. ' where '. $self->userField . ' = ? and '. $self->passwdField . ' = ? and '. $self->activeField .' = 1 ';

	foreach (@extraFields) {
		$query .= " and $_ = ?";
	}

	my $result = $self->q->db->gethashlist($query, @binds);

	if ($result->[0]) {
		$self->q->session->data->authn({username => $username, authenticated => 1, id => $result->[0]->{$self->primarykey}});

		return 1;
	} else {
		return 0;
	}
}

#----------------------------------------------------------------------------------------
sub check {
	my $self = shift;

	my $session = $self->q->session;

	if  (!$session->expired && $session->data->authn && $session->data->authn->{username} && $session->data->authn->{authenticated}) {
		return 1;
	} else {
		if ($self->authenticate) {
			return $self->authenticate;
		} else {
			return $self->redirectLogin;
		}
	}
}

#----------------------------------------------------------------------------------------
sub extraFields {
	my $self = shift;

	return $self->{_extraFields};
}

#----------------------------------------------------------------------------------------
sub q {
	my $self = shift;

	return $self->{_q};
}

#----------------------------------------------------------------------------------------
sub new {
	my $class = shift;
	my $q = shift;

	my $self = {
		_q		=> $q,

	};

	$self->{_table} = $q->plugin->authn->{table};
	$self->{_template} = $q->plugin->authn->{template};
	$self->{_primarykey} = $q->plugin->authn->{primarykey};
	$self->{_salt} = $q->plugin->authn->{salt};
	$self->{_extraFields} = $q->plugin->authn->{extraFields};
	$self->{_userField} = $q->plugin->authn->{userField} || 'username';
	$self->{_passwdField} = $q->plugin->authn->{passwdField} || $q->plugin->authn->{passwordField} || 'password';
	$self->{_activeField} = $q->plugin->authn->{activeField} || 'active';

	bless $self, $class;

	die "Cannot use Authn without Session.  Please enable Session plugin" unless $self->q->session;

	return $self;
}

#----------------------------------------------------------------------------------------
sub passwdField {
	my $self = shift;

	return $self->{_passwdField};
}

#----------------------------------------------------------------------------------------
sub passwdhash {
	my $self = shift;
	my $username = shift;
	my $passwd = shift;


	return Digest::MD5::md5_base64($username.$passwd.$self->salt);
}

#----------------------------------------------------------------------------------------
sub primarykey	{
	my $self = shift;

	return $self->{_primarykey};
}

#----------------------------------------------------------------------------------------
sub redirectLogin {
	my $self = shift;

	my $tmplvars = {};

	print $self->q->template($self->template)->process($tmplvars);

	return;
}

#----------------------------------------------------------------------------------------
sub salt {
	my $self = shift;

	return $self->{_salt};
}

#----------------------------------------------------------------------------------------
sub table {
	my $self = shift;

	return $self->{_table};
}

#----------------------------------------------------------------------------------------
sub template {
	my $self = shift;

	return $self->{_template};
}

#----------------------------------------------------------------------------------------
sub userField {
	my $self = shift;

	return $self->{_userField};
}

1

__END__