The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package MyDemoServer;

use strict;
use warnings;
use Data::Dumper;

use lib '../lib';
use Net::LDAP::Constant qw(LDAP_SUCCESS);
use Net::LDAP::Server;
use base 'Net::LDAP::Server';
use fields qw();

use constant RESULT_OK => {
	'matchedDN' => '',
	'errorMessage' => '',
	'resultCode' => LDAP_SUCCESS
};

# constructor
sub new {
	my $class = shift;
	my $self = $class->SUPER::new(@_);
	return $self;
}

# the bind operation
sub bind {
	my $self = shift;
	my $reqData = shift;
	print STDERR Dumper($reqData);
	return RESULT_OK;
}

# the search operation
sub search {
	my $self = shift;
	my $reqData = shift;
	print STDERR "Searching...\n";
	print STDERR Dumper($reqData);
	my $base = $reqData->{'baseObject'};
	
	# plain die if dn contains 'dying'
	die("panic") if $base =~ /dying/;
	
	# return a correct LDAPresult, but an invalid entry
	return RESULT_OK, {test => 1} if $base =~ /invalid entry/;

	# return an invalid LDAPresult
	return {test => 1} if $base =~ /invalid result/;

	my @entries;
	if ($reqData->{'scope'}) {
		# onelevel or subtree
		for (my $i=1; $i<11; $i++) {
			my $dn = "ou=test $i,$base";
			my $entry = Net::LDAP::Entry->new;
			$entry->dn($dn);
			$entry->add(
				dn => $dn,
				sn => 'value1',
				cn => [qw(value1 value2)]
			);
			push @entries, $entry;
		}
		
		my $entry1 = Net::LDAP::Entry->new;
		$entry1->dn("cn=dying entry,$base");
		$entry1->add(
			cn => 'dying entry',
			description => 'This entry will result in a dying error when queried'
		);
		push @entries, $entry1;

		my $entry2 = Net::LDAP::Entry->new;
		$entry2->dn("cn=invalid entry,$base");
		$entry2->add(
			cn => 'invalid entry',
			description => 'This entry will result in ASN1 error when queried'
		);
		push(@entries,$entry2);
		
		my $entry3 = Net::LDAP::Entry->new;
		$entry3->dn("cn=invalid result,$base");
		$entry3->add(
			cn => 'invalid result',
			description => 'This entry will result in ASN1 error when queried'
		);
		push @entries, $entry3;
	} else {
		# base
		my $entry = Net::LDAP::Entry->new;
		$entry->dn($base);
		$entry->add(
			dn => $base,
			sn => 'value1',
			cn => [qw(value1 value2)]
		);
		push @entries, $entry;
	}
	return RESULT_OK, @entries;
}

# the rest of the operations will return an "unwilling to perform"

1;