git.rot13.org Git - virtual-ldap/blob - lib/LDAP/Koha.pm

   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;