/[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 36 by dpavlin, Wed Mar 25 21:15:19 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,                  userid                  as uid,
37                  firstname               as givenName,                  firstname               as givenName,
# Line 42  my $sth = $dbh->prepare(q{ Line 44  my $sth = $dbh->prepare(q{
44                  cardnumber              as otherPager,                  cardnumber              as otherPager,
45                  email                   as mail                  email                   as mail
46          from borrowers          from borrowers
47          where  };
48                  cardnumber = ?  
49  });  # needed for where clause
50    my $sql_ldap_mapping = {
51            'userid'        => 'uid',
52    };
53    
54    # attributes which are same for whole set, but somehow
55    # LDAP clients are sending they anyway and we don't
56    # have them in database
57    my $ldap_ignore = {
58            'objectclass' => 1,
59    };
60    
61    my $ldap_sql_mapping;
62    while ( my ($sql,$ldap) = each %$sql_ldap_mapping ) {
63            $ldap_sql_mapping->{ $ldap } = $sql;
64    }
65    
66    sub __sql_column {
67            my $name = shift;
68            $ldap_sql_mapping->{$name} || $name;
69    }
70    
71  use constant RESULT_OK => {  use constant RESULT_OK => {
72          'matchedDN' => '',          'matchedDN' => '',
# Line 74  sub search { Line 96  sub search {
96          my $reqData = shift;          my $reqData = shift;
97          print "searching...\n";          print "searching...\n";
98    
99          warn "# request = ", dump($reqData);          warn "# " . localtime() . " request = ", dump($reqData);
100    
101          my $base = $reqData->{'baseObject'}; # FIXME use it?          my $base = $reqData->{'baseObject'}; # FIXME use it?
102    
103          my @entries;          my @entries;
104          if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {          if ( $reqData->{'filter'} ) {
105    
106                    my $sql_where = '';
107                    my @values;
108    
109                    foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
110    
111                            warn "## join_with $join_with\n";
112    
113                            my @limits;
114    
115                            foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
116                                    warn "### filter ",dump($filter),$/;
117                                    foreach my $how ( keys %$filter ) {
118                                            warn "### how $how\n";
119                                            if ( $how eq 'equalityMatch' && defined $filter->{$how} ) {
120                                                    my $name = $filter->{$how}->{attributeDesc} || warn "ERROR: no attributeDesc?";
121                                                    my $value = $filter->{$how}->{assertionValue} || warn "ERROR: no assertionValue?";
122                                                    if ( ! $ldap_ignore->{ $name } ) {
123                                                                    push @limits, __sql_column($name) . ' = ?';
124                                                                    push @values, $value;
125                                                    }
126                                            } elsif ( $how eq 'substrings' ) {
127                                                    foreach my $substring ( @{ $filter->{$how}->{substrings} } ) {
128                                                            my $name = $filter->{$how}->{type} || warn "ERROR: no type?";
129                                                            while ( my($op,$value) = each %$substring ) {
130                                                                    push @limits, __sql_column($name) . ' LIKE ?';
131                                                                    if ( $op eq 'any' ) {
132                                                                            $value = '%' . $value . '%';
133                                                                    } else {
134                                                                            warn "UNSUPPORTED: op $op - using plain $value";
135                                                                    }
136                                                                    push @values, $value;
137                                                            }
138                                                    }
139                                            } elsif ( $how eq 'present' ) {
140                                                    push @limits, __sql_column( $filter->{$how} ) . ' IS NOT NULL';
141                                                    ## XXX add and length(foo) > 0 to avoid empty strings?
142                                            } else {
143                                                    warn "UNSUPPORTED: how $how ",dump( $filter );
144                                            }
145                                            warn "## limits ",dump(@limits), " values ",dump(@values);
146                                    }
147                            }
148    
149                  my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";                          $sql_where .= ' ' . join( " $join_with ", @limits );
150    
151                    }
152    
153                    if ( $sql_where ) {
154                            $sql_where = " where $sql_where";
155                    }
156    
157                  $sth->execute( $value );                  warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );
158                    my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
159                    $sth->execute( @values );
160    
161                  warn "# ", $sth->rows, " results for: $value\n";                  warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
162    
163                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
164    
# Line 95  sub search { Line 168  sub search {
168                          $dn =~ s{[@\.]}{,dc=}g;                          $dn =~ s{[@\.]}{,dc=}g;
169    
170                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
171                          $entry->dn( $dn );                          $entry->dn( $dn . $base );
172                          $entry->add( %$row );                          $entry->add( %$row );
173    
174                          #warn "## entry ",dump( $entry );                          #warn "### entry ",dump( $entry );
175    
176                          push @entries, $entry;                          push @entries, $entry;
177                  }                  }
Legend:
Removed from v.35  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26