/[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 35 by dpavlin, Mon Mar 23 22:00:26 2009 UTC revision 38 by dpavlin, Wed Mar 25 22:06:00 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 = 3; # 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 => 0 }) || die $DBI::errstr;
# Line 29  my $dbh = DBI->connect($dsn . $database, Line 31  my $dbh = DBI->connect($dsn . $database,
31  # Net::LDAP::Entry will lc all our attribute names anyway, so  # Net::LDAP::Entry will lc all our attribute names anyway, so
32  # we don't really care about correctCapitalization for LDAP  # we don't really care about correctCapitalization for LDAP
33  # attributes which won't pass through DBI  # attributes which won't pass through DBI
34  my $sth = $dbh->prepare(q{  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                  concat(                  concat(firstname,' ',surname)   as cn,
40                          firstname,  
41                          ' ',                  -- SAFEQ specific mappings from UMgr-LDAP.conf
42                          surname                  concat(firstname,' ',surname)   as displayName,
43                  )                               as cn,                  cardnumber                                              as otherPager,
44                  cardnumber              as otherPager,                  email                                                   as mail,
45                  email                   as mail                  categorycode                                    as organizationalUnit,
46                    borrowernumber                                  as objectGUID,
47                    concat('/home/',borrowernumber) as homeDirectory
48          from borrowers          from borrowers
49          where  };
50                  cardnumber = ?  
51  });  # needed for where clause
52    my $sql_ldap_mapping = {
53            'userid'                        => 'uid',
54            'borrowernumber'        => 'objectGUID',
55    };
56    
57    # attributes which are same for whole set, but somehow
58    # LDAP clients are sending they anyway and we don't
59    # have them in database
60    my $ldap_ignore = {
61            'objectclass' => 1,
62    };
63    
64    my $ldap_sql_mapping;
65    while ( my ($sql,$ldap) = each %$sql_ldap_mapping ) {
66            $ldap_sql_mapping->{ $ldap } = $sql;
67    }
68    
69    sub __sql_column {
70            my $name = shift;
71            $ldap_sql_mapping->{$name} || $name;
72    }
73    
74  use constant RESULT_OK => {  use constant RESULT_OK => {
75          'matchedDN' => '',          'matchedDN' => '',
# Line 74  sub search { Line 99  sub search {
99          my $reqData = shift;          my $reqData = shift;
100          print "searching...\n";          print "searching...\n";
101    
102          warn "# request = ", dump($reqData);          warn "# " . localtime() . " request = ", dump($reqData);
103    
104          my $base = $reqData->{'baseObject'}; # FIXME use it?          my $base = $reqData->{'baseObject'}; # FIXME use it?
105    
106          my @entries;          my @entries;
107          if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {          if ( $reqData->{'filter'} ) {
108    
109                    my $sql_where = '';
110                    my @values;
111    
112                    foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
113    
114                            warn "## join_with $join_with\n";
115    
116                            my @limits;
117    
118                            foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
119                                    warn "### filter ",dump($filter),$/;
120                                    foreach my $how ( keys %$filter ) {
121                                            warn "### how $how\n";
122                                            if ( $how eq 'equalityMatch' && defined $filter->{$how} ) {
123                                                    my $name = $filter->{$how}->{attributeDesc} || warn "ERROR: no attributeDesc?";
124                                                    my $value = $filter->{$how}->{assertionValue} || warn "ERROR: no assertionValue?";
125                                                    if ( ! $ldap_ignore->{ $name } ) {
126                                                                    push @limits, __sql_column($name) . ' = ?';
127                                                                    push @values, $value;
128                                                    }
129                                            } elsif ( $how eq 'substrings' ) {
130                                                    foreach my $substring ( @{ $filter->{$how}->{substrings} } ) {
131                                                            my $name = $filter->{$how}->{type} || warn "ERROR: no type?";
132                                                            while ( my($op,$value) = each %$substring ) {
133                                                                    push @limits, __sql_column($name) . ' LIKE ?';
134                                                                    if ( $op eq 'any' ) {
135                                                                            $value = '%' . $value . '%';
136                                                                    } else {
137                                                                            warn "UNSUPPORTED: op $op - using plain $value";
138                                                                    }
139                                                                    push @values, $value;
140                                                            }
141                                                    }
142                                            } elsif ( $how eq 'present' ) {
143                                                    my $name = __sql_column( $filter->{$how} );
144                                                    push @limits, "$name IS NOT NULL and length($name) > 1";
145                                                    ## XXX length(foo) > 1 to avoid empty " " strings
146                                            } else {
147                                                    warn "UNSUPPORTED: how $how ",dump( $filter );
148                                            }
149                                            warn "## limits ",dump(@limits), " values ",dump(@values);
150                                    }
151                            }
152    
153                  my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";                          $sql_where .= ' ' . join( " $join_with ", @limits );
154    
155                    }
156    
157                    if ( $sql_where ) {
158                            $sql_where = " where $sql_where";
159                    }
160    
161                  $sth->execute( $value );                  warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );
162                    my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
163                    $sth->execute( @values );
164    
165                  warn "# ", $sth->rows, " results for: $value\n";                  warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
166    
167                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
168    
# Line 95  sub search { Line 172  sub search {
172                          $dn =~ s{[@\.]}{,dc=}g;                          $dn =~ s{[@\.]}{,dc=}g;
173    
174                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
175                          $entry->dn( $dn );                          $entry->dn( $dn . $base );
176                          $entry->add( %$row );                          $entry->add( %$row );
177    
178                          #warn "## entry ",dump( $entry );                          #warn "### entry ",dump( $entry );
179    
180                          push @entries, $entry;                          push @entries, $entry;
181                  }                  }
Legend:
Removed from v.35  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26