/[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

Diff of /lib/LDAP/Koha.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 32 by dpavlin, Mon Mar 23 20:26:48 2009 UTC revision 44 by dpavlin, Wed Apr 15 11:06:27 2009 UTC
# Line 22  our $database = 'koha'; Line 22  our $database = 'koha';
22  our $user     = 'unconfigured-user';  our $user     = 'unconfigured-user';
23  our $passwd   = 'unconfigured-password';  our $passwd   = 'unconfigured-password';
24    
25    our $max_results = 10; # 100; # FIXME
26    
27  require 'config.pl' if -e 'config.pl';  require 'config.pl' if -e 'config.pl';
28    
29  my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError => 1, AutoCommit => 0 }) || die $DBI::errstr;  my $dbh = DBI->connect($dsn . $database, $user,$passwd, { RaiseError => 1, AutoCommit => 1 }) || die $DBI::errstr;
30    
31  my $sth = $dbh->prepare(q{  # Net::LDAP::Entry will lc all our attribute names anyway, so
32    # we don't really care about correctCapitalization for LDAP
33    # attributes which won't pass through DBI
34    my $sql_select = q{
35          select          select
36                  userid                  as uid,                  trim(userid)                                    as uid,
37                  firstname               as givenName,                  firstname                                       as givenName,
38                  surname                 as sn,                  surname                                         as sn,
39                  cardnumber              as otherPager,                  concat(firstname,' ',surname)                   as cn,
40                  email                   as mail  
41                    -- SAFEQ specific mappings from UMgr-LDAP.conf
42                    surname                                         as displayName,
43                    rfid_sid                                        as pager,
44                    email                                           as mail,
45                    categorycode                                    as ou,
46                    categorycode                                    as organizationalUnit,
47                    categorycode                                    as memberOf,
48                    categorycode                                    as department,
49                    borrowernumber                                  as objectGUID,
50                    concat('/home/',borrowernumber)                 as homeDirectory
51          from borrowers          from borrowers
52          where  };
53                  cardnumber = ?  
54  });  # we need reverse LDAP -> SQL mapping for where clause
55    my $ldap_sql_mapping = {
56            'uid'           => 'userid',
57            'objectGUID'    => 'borrowernumber',
58            'displayName'   => 'surname',
59            'sn'            => 'surname',
60            'pager'         => 'rfid_sid',
61    };
62    
63    # attributes which are same for whole set, but somehow
64    # LDAP clients are sending they anyway and we don't
65    # have them in database
66    my $ldap_ignore = {
67            'objectclass' => 1,
68    };
69    
70    sub __sql_column {
71            my $name = shift;
72            $ldap_sql_mapping->{$name} || $name;
73    }
74    
75  use constant RESULT_OK => {  use constant RESULT_OK => {
76          'matchedDN' => '',          'matchedDN' => '',
# Line 60  sub bind { Line 94  sub bind {
94          return RESULT_OK;          return RESULT_OK;
95  }  }
96    
97    our @values;
98    our @limits;
99    
100    sub __ldap_search_to_sql {
101            my ( $how, $what ) = @_;
102            warn "### __ldap_search_to_sql $how ",dump( $what ),"\n";
103            if ( $how eq 'equalityMatch' && defined $what ) {
104                    my $name = $what->{attributeDesc} || warn "ERROR: no attributeDesc?";
105                    my $value = $what->{assertionValue} || warn "ERROR: no assertionValue?";
106                    if ( ! $ldap_ignore->{ $name } ) {
107                            push @limits, __sql_column($name) . ' = ?';
108                            push @values, $value;
109                    } else {
110                            warn "IGNORED: $name = $value";
111                    }
112            } elsif ( $how eq 'substrings' ) {
113                    foreach my $substring ( @{ $what->{substrings} } ) {
114                            my $name = $what->{type} || warn "ERROR: no type?";
115                            while ( my($op,$value) = each %$substring ) {
116                                    push @limits, __sql_column($name) . ' LIKE ?';
117                                    if ( $op eq 'any' ) {
118                                            $value = '%' . $value . '%';
119                                    } else {
120                                            warn "UNSUPPORTED: op $op - using plain $value";
121                                    }
122                                    push @values, $value;
123                            }
124                    }
125            } elsif ( $how eq 'present' ) {
126                    my $name = __sql_column( $what );
127                    push @limits, "$name IS NOT NULL and length($name) > 1";
128                    ## XXX length(foo) > 1 to avoid empty " " strings
129            } else {
130                    warn "UNSUPPORTED: $how ",dump( $what );
131            }
132    }
133    
134  # the search operation  # the search operation
135  sub search {  sub search {
136          my $self = shift;          my $self = shift;
137          my $reqData = shift;          my $reqData = shift;
138          print "searching...\n";          print "searching...\n";
139    
140          warn "# request = ", dump($reqData);          warn "# " . localtime() . " request = ", dump($reqData);
141    
142          my $base = $reqData->{'baseObject'}; # FIXME use it?          my $base = $reqData->{'baseObject'}; # FIXME use it?
143    
144          my @entries;          my @entries;
145          if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {          if ( $reqData->{'filter'} ) {
146    
147                  my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";                  my $sql_where = '';
148                    @values = ();
149    
150                  $sth->execute( $value );                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
151    
152                  warn "# ", $sth->rows, " results for: $value\n";                          warn "## join_with $join_with ", dump( $reqData->{'filter'}->{ $join_with } ), "\n";
153    
154                            @limits = ();
155    
156                            if ( ref $reqData->{'filter'}->{ $join_with } eq 'ARRAY' ) {
157    
158                                    foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
159                                            warn "### filter ",dump($filter),$/;
160                                            foreach my $how ( keys %$filter ) {
161                                                    if ( $how eq 'or' ) {
162                                                            __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
163                                                    } else {
164                                                            __ldap_search_to_sql( $how, $filter->{$how} );
165                                                    }
166                                                    warn "## limits ",dump(@limits), " values ",dump(@values);
167                                            }
168                                    }
169    
170                                    $sql_where .= ' ' . join( " $join_with ", @limits );
171    
172                            } else {
173                                    __ldap_search_to_sql( $join_with, $reqData->{'filter'}->{$join_with} );
174                            }
175    
176                    }
177    
178                    if ( $sql_where ) {
179                            $sql_where = " where $sql_where";
180                    }
181    
182                    warn "# SQL:\n$sql_select\n$sql_where\n# DATA: ",dump( @values );
183                    my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
184                    $sth->execute( @values );
185    
186                    warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
187    
188                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
189    
# Line 85  sub search { Line 191  sub search {
191    
192                          my $dn = 'uid=' . $row->{uid} || die "no uid";                          my $dn = 'uid=' . $row->{uid} || die "no uid";
193                          $dn =~ s{[@\.]}{,dc=}g;                          $dn =~ s{[@\.]}{,dc=}g;
194                            $dn .= ',' . $base unless $dn =~ m{dc}i;
195    
196                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
197                          $entry->dn( $dn );                          $entry->dn( $dn );
198                            $entry->add( objectClass => [
199                                    "person",
200                                    "organizationalPerson",
201                                    "inetOrgPerson",
202                                    "hrEduPerson",
203                            ] );
204                          $entry->add( %$row );                          $entry->add( %$row );
205    
206                          #warn "## entry ",dump( $entry );                          #$entry->changetype( 'modify' );
207    
208                            warn "### entry ",$entry->dump( \*STDERR );
209    
210                          push @entries, $entry;                          push @entries, $entry;
211                  }                  }
Legend:
Removed from v.32  
changed lines
  Added in v.44
  ViewVC Help
Powered by ViewVC 1.1.26