/[virtual-ldap]/lib/LDAP/Koha.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /lib/LDAP/Koha.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 35 - (hide annotations)
Mon Mar 23 22:00:26 2009 UTC (15 years ago) by dpavlin
File size: 2365 byte(s)
added cn

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 dpavlin 33 # Net::LDAP::Entry will lc all our attribute names anyway, so
30     # we don't really care about correctCapitalization for LDAP
31     # attributes which won't pass through DBI
32 dpavlin 32 my $sth = $dbh->prepare(q{
33     select
34     userid as uid,
35     firstname as givenName,
36     surname as sn,
37 dpavlin 35 concat(
38     firstname,
39     ' ',
40     surname
41     ) as cn,
42 dpavlin 32 cardnumber as otherPager,
43     email as mail
44     from borrowers
45     where
46     cardnumber = ?
47     });
48    
49     use constant RESULT_OK => {
50     'matchedDN' => '',
51     'errorMessage' => '',
52     'resultCode' => LDAP_SUCCESS
53     };
54    
55     # constructor
56     sub new {
57     my ($class, $sock) = @_;
58     my $self = $class->SUPER::new($sock);
59     print "connection from: ", $sock->peerhost(), "\n";
60     return $self;
61     }
62    
63     # the bind operation
64     sub bind {
65     my $self = shift;
66     my $reqData = shift;
67     warn "# bind ",dump($reqData);
68     return RESULT_OK;
69     }
70    
71     # the search operation
72     sub search {
73     my $self = shift;
74     my $reqData = shift;
75     print "searching...\n";
76    
77     warn "# request = ", dump($reqData);
78    
79     my $base = $reqData->{'baseObject'}; # FIXME use it?
80    
81     my @entries;
82     if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {
83    
84     my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";
85    
86     $sth->execute( $value );
87    
88     warn "# ", $sth->rows, " results for: $value\n";
89    
90     while (my $row = $sth->fetchrow_hashref) {
91    
92     warn "## row = ",dump( $row );
93    
94     my $dn = 'uid=' . $row->{uid} || die "no uid";
95     $dn =~ s{[@\.]}{,dc=}g;
96    
97     my $entry = Net::LDAP::Entry->new;
98     $entry->dn( $dn );
99     $entry->add( %$row );
100    
101     #warn "## entry ",dump( $entry );
102    
103     push @entries, $entry;
104     }
105    
106     } else {
107     warn "UNKNOWN request: ",dump( $reqData );
108     }
109    
110     return RESULT_OK, @entries;
111     }
112    
113     # the rest of the operations will return an "unwilling to perform"
114    
115     1;

  ViewVC Help
Powered by ViewVC 1.1.26