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	dpavlin	32	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;