lib/LDAP/Koha.pm

package LDAP::Koha;

use strict;
use warnings;
use Data::Dump qw/dump/;

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

use DBI;

# XXX test with:
#
# ldapsearch -h localhost -p 2389 -b dc=ffzg,dc=hr -x 'otherPager=200903160021'
#

our $dsn      = 'DBI:mysql:dbname=';
our $database = 'koha';
our $user     = 'unconfigured-user';
our $passwd   = 'unconfigured-password';

require 'config.pl' if -e 'config.pl';

my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;

my $sth = $dbh->prepare(q{
        select
                userid                  as uid,
                firstname               as givenName,
                surname                 as sn,
                cardnumber              as otherPager,
                email                   as mail
        from borrowers
        where
                cardnumber = ?
});

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

# constructor
sub new {
        my ($class, $sock) = @_;
        my $self = $class->SUPER::new($sock);
        print "connection from: ", $sock->peerhost(), "\n";
        return $self;
}

# the bind operation
sub bind {
        my $self = shift;
        my $reqData = shift;
        warn "# bind ",dump($reqData);
        return RESULT_OK;
}

# the search operation
sub search {
        my $self = shift;
        my $reqData = shift;
        print "searching...\n";

        warn "# request = ", dump($reqData);

        my $base = $reqData->{'baseObject'}; # FIXME use it?

        my @entries;
        if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {

                my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";

                $sth->execute( $value );

                warn "# ", $sth->rows, " results for: $value\n";

                while (my $row = $sth->fetchrow_hashref) {

                        warn "## row = ",dump( $row );

                        my $dn = 'uid=' . $row->{uid} || die "no uid";
                        $dn =~ s{[@\.]}{,dc=}g;

                        my $entry = Net::LDAP::Entry->new;
                        $entry->dn( $dn );
                        $entry->add( %$row );

                        #warn "## entry ",dump( $entry );

                        push @entries, $entry;
                }

        } else {
                warn "UNKNOWN request: ",dump( $reqData );
        }

        return RESULT_OK, @entries;
}

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

1;
1	package LDAP::Koha;
2
3	use strict;
4	use warnings;
5	use Data::Dump qw/dump/;
6
7	use lib '../lib';
8	use Net::LDAP::Constant qw(LDAP_SUCCESS);
9	use Net::LDAP::Server;
10	use base 'Net::LDAP::Server';
11	use fields qw();
12
13	use DBI;
14
15	# XXX test with:
16	#
17	# ldapsearch -h localhost -p 2389 -b dc=ffzg,dc=hr -x 'otherPager=200903160021'
18	#
19
20	our $dsn = 'DBI:mysql:dbname=';
21	our $database = 'koha';
22	our $user = 'unconfigured-user';
23	our $passwd = 'unconfigured-password';
24
25	require 'config.pl' if -e 'config.pl';
26
27	my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError => 1, AutoCommit => 0 }) \|\| die $DBI::errstr;
28
29	my $sth = $dbh->prepare(q{
30	select
31	userid as uid,
32	firstname as givenName,
33	surname as sn,
34	cardnumber as otherPager,
35	email as mail
36	from borrowers
37	where
38	cardnumber = ?
39	});
40
41	use constant RESULT_OK => {
42	'matchedDN' => '',
43	'errorMessage' => '',
44	'resultCode' => LDAP_SUCCESS
45	};
46
47	# constructor
48	sub new {
49	my ($class, $sock) = @_;
50	my $self = $class->SUPER::new($sock);
51	print "connection from: ", $sock->peerhost(), "\n";
52	return $self;
53	}
54
55	# the bind operation
56	sub bind {
57	my $self = shift;
58	my $reqData = shift;
59	warn "# bind ",dump($reqData);
60	return RESULT_OK;
61	}
62
63	# the search operation
64	sub search {
65	my $self = shift;
66	my $reqData = shift;
67	print "searching...\n";
68
69	warn "# request = ", dump($reqData);
70
71	my $base = $reqData->{'baseObject'}; # FIXME use it?
72
73	my @entries;
74	if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {
75
76	my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} \|\| die "no value?";
77
78	$sth->execute( $value );
79
80	warn "# ", $sth->rows, " results for: $value\n";
81
82	while (my $row = $sth->fetchrow_hashref) {
83
84	warn "## row = ",dump( $row );
85
86	my $dn = 'uid=' . $row->{uid} \|\| die "no uid";
87	$dn =~ s{[@\.]}{,dc=}g;
88
89	my $entry = Net::LDAP::Entry->new;
90	$entry->dn( $dn );
91	$entry->add( %$row );
92
93	#warn "## entry ",dump( $entry );
94
95	push @entries, $entry;
96	}
97
98	} else {
99	warn "UNKNOWN request: ",dump( $reqData );
100	}
101
102	return RESULT_OK, @entries;
103	}
104
105	# the rest of the operations will return an "unwilling to perform"
106
107	1;