File Coverage

blib/lib/ResourcePool/Resource/Net/LDAP.pm

Criterion	Covered	Total	%
statement	27	59	45.7
branch	3	14	21.4
condition	1	3	33.3
subroutine	6	13	46.1
pod	4	8	50.0
total	41	97	42.2

#*********************************************************************
#*** ResourcePool::Resource::Net::LDAP
#*** Copyright (c) 2020 by Markus Winand
#*** $Id$
#*********************************************************************

package ResourcePool::Resource::Net::LDAP;

use vars qw($VERSION @ISA);
use strict;
use Net::LDAP qw(LDAP_SUCCESS);
use ResourcePool::Resource;

$VERSION = "1.0003";
push @ISA, "ResourcePool::Resource";

sub new($$$@) {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = $class->SUPER::new();
	$self->{Factory} = shift;
	my $host   = shift;
	$self->{BindOptions} = defined $_[0] ? shift: [];
	my $NewOptions = defined $_[0] ? shift: [];
	$self->{start_tlsOptions} = shift;

	$self->{ldaph} = Net::LDAP->new($host, @{$NewOptions});
	if (! defined $self->{ldaph}) {
		swarn("ResourcePool::Resource::Net::LDAP: ".
			"Connect to '%s' failed: $@\n",
			$self->{Factory}->info());
		return undef;
	}

	bless($self, $class);

	if (! defined $self->start_tls($self->{start_tlsOptions})) {
		return undef;
	}
	# bind returns $self on success
	return $self->bind($self->{BindOptions});
}

sub close($) {
	my ($self) = @_;
	#$self->{ldaph}->unbind();
}

sub fail_close($) {
	my ($self) = @_;
	swarn("ResourcePool::Resource::Net::LDAP: ".
		"closing failed connection to '%s'.\n",
		$self->{Factory}->info());
}

sub get_plain_resource($) {
	my ($self) = @_;
	return $self->{ldaph};
}

sub DESTROY($) {
	my ($self) = @_;
	$self->close();
}

sub precheck($) {
	my ($self) = @_;
	return $self->bind($self->{BindOptions});
}

sub start_tls($$) {
	my ($self, $tlsoptions) = @_;
	if (defined $tlsoptions) {
		my $rc = $self->{ldaph}->start_tls(@{$tlsoptions});
		if ($rc->code != LDAP_SUCCESS) {
			swarn("ResourcePool::Resource::Net::LDAP: "
				. "start_tls to '%s' failed: %s\n"
				, $self->{Factory}->info()
				, $rc->error()
			);
			delete $self->{ldaph};
			return undef;
		}
	}
	return $self;
}


sub bind($$) {
	my ($self, $bindopts) = @_;
	my @BindOptions = @{$bindopts};
	my $rc;

	$rc = $self->{ldaph}->bind(@BindOptions);

	if ($rc->code != LDAP_SUCCESS) {
		swarn("ResourcePool::Resource::Net::LDAP: ".
			"Bind to '%s' failed: %s\n",
			$self->{Factory}->info(),
			$rc->error());
		delete $self->{ldaph};
		return undef;
	}

	return $self;
}


sub swarn($@) {
	my $fmt = shift;
	warn sprintf($fmt, @_);
}
1;