use strict;
use Parse::RecDescent;
use DBI;
use MIME::Base64;

my $host     = "localhost";
my $port     = 5432;
my $dbname   = "my_db";
my $username = "username";
my $password = "password";

# <...>

# In a search request, the server feeds us the scope and dereference fields
# in the numeric form used by the protocol.  ldapsearch(1) takes these
# fields as arguments in symbolic form.  These arrays convert between
# the two representations.

my @scopes = ("base", "onelevel", "subtree");
my @derefs = ("never", "search", "find", "always");

my $dataSource = "dbi:Pg:dbname=$dbname;host=$host;port=$port";

my $operation = <>;
chop($operation);

if ($operation eq "SEARCH") {
	my ($suffix, $base, $scope, $deref, $sizelimit, $timelimit, $filter);
	my ($attrsonly, @attrs);

	while (<>) {
		if (/^suffix: (.*)$/)       { $suffix = $1; }
		elsif (/^base: (.*)$/)      { $base = $1; }
		elsif (/^scope: (.*)$/)     { $scope = $scopes[$1]; }
		elsif (/^deref: (.*)$/)     { $deref = $derefs[$1]; }
		elsif (/^sizelimit: (.*)$/) { $sizelimit = $1; }
		elsif (/^timelimit: (.*)$/) { $timelimit = $1; }
		elsif (/^filter: (.*)$/)    { $filter = $1; }
		elsif (/^attrsonly: (.*)$/) { $attrsonly = $1; }
		elsif (/^attrs: (.*)$/)     { if ($1 eq "all") {
		                                  @attrs = ();
		                              } else {
		                                  @attrs = split / /, $1;
		                              }
		                            }
		# <...>
		LdapUserDatasDNAttrs($base, $filter);
		# <...>

	}
}

# <...>

sub LdapUserDatasDNAttrs {
	my ($suffix, $filter) = @_;

	my $sqlCond = TranslateLdapFilter($filter);

	my ($dnQualifier) = ($suffix =~ /^dnQualifier=([^,]+),/);

	print "dn: $suffix\n";
	print "objectClass: top\n";
	print "objectClass: person\n";
	print "objectClass: organizationalPerson\n";
	print "objectClass: inetOrgPerson\n";
	print "dnQualifier: $dnQualifier\n";

	my $dbh = DBI->connect($dataSource, $username, $password,
	                       {AutoCommit => 0, RaiseError => 1})
		|| die "Can't connect: $DBI::errstr";
	$dbh->commit;

	my $statement = "
		SELECT cn,
		       sn,
		       givenname,
		       o,
		       ou,
		       c,
		       l,
		       postalcode,
		       postaladdress,
		       mail,
		       telephonenumber,
		       facsimiletelephonenumber,
		       photoid,
		       certid,
		       description
		FROM ldap
		WHERE (dnqualifier = '$dnQualifier') AND ($sqlCond);
	";

	my $sth = $dbh->prepare($statement)
		|| die "Can't prepare: $DBI::errstr";
	$sth->execute
		|| die "Can't execute statement: $DBI::errstr";

	while(my @row = $sth->fetchrow_array) {
		my ($cn,
		    $sn,
		    $givenName,
		    $o,
		    $ou,
		    $c,
		    $l,
		    $postalCode,
		    $postalAddress,
		    $mail,
		    $telephoneNumber,
		    $facsimileTelephoneNumber,
		    $photoId,
		    $certId,
		    $description) = (@row);

		print "cn: $cn\n" if ($cn ne '');
		print "givenName: $givenName\n" if ($givenName ne '');
		print "sn: $sn\n" if ($sn ne '');
		print "o: $o\n" if ($o ne '');
		print "ou: $ou\n" if ($ou ne '');
		print "c: $c\n" if ($c ne '');
		print "l: $l\n" if ($l ne '');
		print "postalCode: $postalCode\n" if ($postalCode ne '');
		print "postalAddress: $postalAddress\n"
			if ($postalAddress ne '');
		print "mail: $mail\n" if ($mail ne '');
		print "telephoneNumber: $telephoneNumber\n"
			if ($telephoneNumber ne '');
		print "facsimileTelephoneNumber: $facsimileTelephoneNumber\n"
			if ($facsimileTelephoneNumber ne '');

		my $photo = '';
		my $photoFd = $dbh->func($photoId,
		                         $dbh->{pg_INV_READ},
		                         'lo_open');
		my $buff = '';
		while($dbh->func($photoFd, $buff, 57 * 1000, 'lo_read')) {
			$photo .= $buff;
		}
		$dbh->func($photoFd, 'lo_close');
		my $photoB64 = MIME::Base64::encode($photo, "\n ");

		print "jpegPhoto:: $photoB64\n";

		my $cert = '';
		my $certFd = $dbh->func($certId,
		                        $dbh->{pg_INV_READ},
		                        'lo_open');
		$buff = '';
		while($dbh->func($certFd, $buff, 57 * 1000, 'lo_read')) {
			$cert .= $buff;
		}
		my $certB64 = MIME::Base64::encode($cert, "\n ");

		print "userCertificate:: $certB64\n";

		print "description: $description\n" if ($description ne '');
	}
	print "\n";

	$dbh->commit;
	$sth->finish;
	$dbh->disconnect;
}

sub TranslateLdapFilter {
	my ($filter) = @_;
	my $grammar = q{
{ my $oper;

  sub decode {
    my ($str) = @_;
    $str =~ s/\\\\([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    return $str;
  }
}

translate: request

request: request_and
	| request_or
	| request_not
	| request_data

request_and: '(&' request request ')' # & operator
	{ "($item[2]) AND ($item[3])"; }

request_or: '(|' request request ')' # | operator
	{ "($item[2]) OR ($item[3])"; }

request_not: '(!' request ')' # ! operator
	{ "NOT ($item[2])"; }

request_data: '(' attr '=~' query ')' # sounds like
		{ "soundex($item{attr}) = soundex($item{query_value})"; }
	| '(' attr '=' query ')' # other forms
		{ "lower($item{attr}) $oper lower($item{query})"; }

attr: /[A-Za-z0-9]+/i
	{ "$item[1]"; }

query: /[^\)]*/
	{ my ($str) = decode($item[1]);
	  if(($str =~ tr/*/%/) > 0) {
	    $oper = 'LIKE';
	  } else {
	    $oper = '=';
	  }
	  "'$str'";
	}
};
	$::RD_HINT = 1;
	my $parser = new Parse::RecDescent($grammar) or die "Bad grammar!\n";
	return $parser->translate($filter);
}