/[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 43 by dpavlin, Fri Mar 27 16:55:53 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  # 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                  surname                                         as displayName,
43                  )                               as cn,                  rfid_sid                                        as pager,
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  });  # we need reverse LDAP -> SQL mapping for where clause
52    my $ldap_sql_mapping = {
53            'uid'           => 'userid',
54            'objectGUID'    => 'borrowernumber',
55            'displayName'   => 'surname',
56            'sn'            => 'surname',
57            'pager'         => 'rfid_sid',
58    };
59    
60    # attributes which are same for whole set, but somehow
61    # LDAP clients are sending they anyway and we don't
62    # have them in database
63    my $ldap_ignore = {
64            'objectclass' => 1,
65    };
66    
67    sub __sql_column {
68            my $name = shift;
69            $ldap_sql_mapping->{$name} || $name;
70    }
71    
72  use constant RESULT_OK => {  use constant RESULT_OK => {
73          'matchedDN' => '',          'matchedDN' => '',
# Line 68  sub bind { Line 91  sub bind {
91          return RESULT_OK;          return RESULT_OK;
92  }  }
93    
94    our @values;
95    our @limits;
96    
97    sub __ldap_search_to_sql {
98            my ( $how, $what ) = @_;
99            warn "### how $how\n";
100            if ( $how eq 'equalityMatch' && defined $what ) {
101                    my $name = $what->{attributeDesc} || warn "ERROR: no attributeDesc?";
102                    my $value = $what->{assertionValue} || warn "ERROR: no assertionValue?";
103                    if ( ! $ldap_ignore->{ $name } ) {
104                            push @limits, __sql_column($name) . ' = ?';
105                            push @values, $value;
106                    }
107            } elsif ( $how eq 'substrings' ) {
108                    foreach my $substring ( @{ $what->{substrings} } ) {
109                            my $name = $what->{type} || warn "ERROR: no type?";
110                            while ( my($op,$value) = each %$substring ) {
111                                    push @limits, __sql_column($name) . ' LIKE ?';
112                                    if ( $op eq 'any' ) {
113                                            $value = '%' . $value . '%';
114                                    } else {
115                                            warn "UNSUPPORTED: op $op - using plain $value";
116                                    }
117                                    push @values, $value;
118                            }
119                    }
120            } elsif ( $how eq 'present' ) {
121                    my $name = __sql_column( $what );
122                    push @limits, "$name IS NOT NULL and length($name) > 1";
123                    ## XXX length(foo) > 1 to avoid empty " " strings
124            } else {
125                    warn "UNSUPPORTED: how $how what ",dump( $what );
126            }
127    }
128    
129  # the search operation  # the search operation
130  sub search {  sub search {
131          my $self = shift;          my $self = shift;
132          my $reqData = shift;          my $reqData = shift;
133          print "searching...\n";          print "searching...\n";
134    
135          warn "# request = ", dump($reqData);          warn "# " . localtime() . " request = ", dump($reqData);
136    
137          my $base = $reqData->{'baseObject'}; # FIXME use it?          my $base = $reqData->{'baseObject'}; # FIXME use it?
138    
139          my @entries;          my @entries;
140          if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {          if ( $reqData->{'filter'} ) {
141    
142                  my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";                  my $sql_where = '';
143                    @values = ();
144    
145                  $sth->execute( $value );                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
146    
147                  warn "# ", $sth->rows, " results for: $value\n";                          warn "## join_with $join_with\n";
148    
149                            @limits = ();
150    
151                            if ( ref $reqData->{'filter'}->{ $join_with } ) {
152    
153                                    foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
154                                            warn "### filter ",dump($filter),$/;
155                                            foreach my $how ( keys %$filter ) {
156                                                    if ( $how eq 'or' ) {
157                                                            __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
158                                                    } else {
159                                                            __ldap_search_to_sql( $how, $filter->{$how} );
160                                                    }
161                                                    warn "## limits ",dump(@limits), " values ",dump(@values);
162                                            }
163                                    }
164    
165                                    $sql_where .= ' ' . join( " $join_with ", @limits );
166    
167                            } else {
168                                    __ldap_search_to_sql( $join_with, $reqData->{'filter'}->{$join_with} );
169                            }
170    
171                    }
172    
173                    if ( $sql_where ) {
174                            $sql_where = " where $sql_where";
175                    }
176    
177                    warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );
178                    my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
179                    $sth->execute( @values );
180    
181                    warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
182    
183                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
184    
# Line 93  sub search { Line 186  sub search {
186    
187                          my $dn = 'uid=' . $row->{uid} || die "no uid";                          my $dn = 'uid=' . $row->{uid} || die "no uid";
188                          $dn =~ s{[@\.]}{,dc=}g;                          $dn =~ s{[@\.]}{,dc=}g;
189                            $dn .= ',' . $base unless $dn =~ m{dc}i;
190    
191                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
192                          $entry->dn( $dn );                          $entry->dn( $dn );
193                            $entry->add( objectClass => [
194                                    "person",
195                                    "organizationalPerson",
196                                    "inetOrgPerson",
197                                    "hrEduPerson",
198                            ] );
199                          $entry->add( %$row );                          $entry->add( %$row );
200    
201                          #warn "## entry ",dump( $entry );                          #$entry->changetype( 'modify' );
202    
203                            warn "### entry ",$entry->dump( \*STDERR );
204    
205                          push @entries, $entry;                          push @entries, $entry;
206                  }                  }
Legend:
Removed from v.35  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.26