/[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 38 by dpavlin, Wed Mar 25 22:06:00 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 = 3; # 100; # FIXME  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
# Line 34  my $dbh = DBI->connect($dsn . $database, Line 34  my $dbh = DBI->connect($dsn . $database,
34  my $sql_select = q{  my $sql_select = q{
35          select          select
36                  trim(userid)                                    as uid,                  trim(userid)                                    as uid,
37                  firstname                                               as givenName,                  firstname                                       as givenName,
38                  surname                                                 as sn,                  surname                                         as sn,
39                  concat(firstname,' ',surname)   as cn,                  concat(firstname,' ',surname)                   as cn,
40    
41                  -- SAFEQ specific mappings from UMgr-LDAP.conf                  -- SAFEQ specific mappings from UMgr-LDAP.conf
42                  concat(firstname,' ',surname)   as displayName,                  surname                                         as displayName,
43                  cardnumber                                              as otherPager,                  rfid_sid                                        as pager,
44                  email                                                   as mail,                  email                                           as mail,
45                    categorycode                                    as ou,
46                  categorycode                                    as organizationalUnit,                  categorycode                                    as organizationalUnit,
47                    categorycode                                    as memberOf,
48                    categorycode                                    as department,
49                  borrowernumber                                  as objectGUID,                  borrowernumber                                  as objectGUID,
50                  concat('/home/',borrowernumber) as homeDirectory                  concat('/home/',borrowernumber)                 as homeDirectory
51          from borrowers          from borrowers
52  };  };
53    
54  # needed for where clause  # we need reverse LDAP -> SQL mapping for where clause
55  my $sql_ldap_mapping = {  my $ldap_sql_mapping = {
56          'userid'                        => 'uid',          'uid'           => 'userid',
57          'borrowernumber'        => 'objectGUID',          'objectGUID'    => 'borrowernumber',
58            'displayName'   => 'surname',
59            'sn'            => 'surname',
60            'pager'         => 'rfid_sid',
61  };  };
62    
63  # attributes which are same for whole set, but somehow  # attributes which are same for whole set, but somehow
# Line 61  my $ldap_ignore = { Line 67  my $ldap_ignore = {
67          'objectclass' => 1,          'objectclass' => 1,
68  };  };
69    
 my $ldap_sql_mapping;  
 while ( my ($sql,$ldap) = each %$sql_ldap_mapping ) {  
         $ldap_sql_mapping->{ $ldap } = $sql;  
 }  
   
70  sub __sql_column {  sub __sql_column {
71          my $name = shift;          my $name = shift;
72          $ldap_sql_mapping->{$name} || $name;          $ldap_sql_mapping->{$name} || $name;
# Line 93  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;
# Line 107  sub search { Line 145  sub search {
145          if ( $reqData->{'filter'} ) {          if ( $reqData->{'filter'} ) {
146    
147                  my $sql_where = '';                  my $sql_where = '';
148                  my @values;                  @values = ();
149    
150                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
151    
152                          warn "## join_with $join_with\n";                          warn "## join_with $join_with ", dump( $reqData->{'filter'}->{ $join_with } ), "\n";
153    
154                          my @limits;                          @limits = ();
155    
156                          foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {                          if ( ref $reqData->{'filter'}->{ $join_with } eq 'ARRAY' ) {
157                                  warn "### filter ",dump($filter),$/;  
158                                  foreach my $how ( keys %$filter ) {                                  foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
159                                          warn "### how $how\n";                                          warn "### filter ",dump($filter),$/;
160                                          if ( $how eq 'equalityMatch' && defined $filter->{$how} ) {                                          foreach my $how ( keys %$filter ) {
161                                                  my $name = $filter->{$how}->{attributeDesc} || warn "ERROR: no attributeDesc?";                                                  if ( $how eq 'or' ) {
162                                                  my $value = $filter->{$how}->{assertionValue} || warn "ERROR: no assertionValue?";                                                          __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
163                                                  if ( ! $ldap_ignore->{ $name } ) {                                                  } else {
164                                                                  push @limits, __sql_column($name) . ' = ?';                                                          __ldap_search_to_sql( $how, $filter->{$how} );
                                                                 push @values, $value;  
                                                 }  
                                         } elsif ( $how eq 'substrings' ) {  
                                                 foreach my $substring ( @{ $filter->{$how}->{substrings} } ) {  
                                                         my $name = $filter->{$how}->{type} || warn "ERROR: no type?";  
                                                         while ( my($op,$value) = each %$substring ) {  
                                                                 push @limits, __sql_column($name) . ' LIKE ?';  
                                                                 if ( $op eq 'any' ) {  
                                                                         $value = '%' . $value . '%';  
                                                                 } else {  
                                                                         warn "UNSUPPORTED: op $op - using plain $value";  
                                                                 }  
                                                                 push @values, $value;  
                                                         }  
165                                                  }                                                  }
166                                          } elsif ( $how eq 'present' ) {                                                  warn "## limits ",dump(@limits), " values ",dump(@values);
                                                 my $name = __sql_column( $filter->{$how} );  
                                                 push @limits, "$name IS NOT NULL and length($name) > 1";  
                                                 ## XXX length(foo) > 1 to avoid empty " " strings  
                                         } else {  
                                                 warn "UNSUPPORTED: how $how ",dump( $filter );  
167                                          }                                          }
                                         warn "## limits ",dump(@limits), " values ",dump(@values);  
168                                  }                                  }
                         }  
169    
170                          $sql_where .= ' ' . join( " $join_with ", @limits );                                  $sql_where .= ' ' . join( " $join_with ", @limits );
171    
172                            } else {
173                                    __ldap_search_to_sql( $join_with, $reqData->{'filter'}->{$join_with} );
174                            }
175    
176                  }                  }
177    
# Line 158  sub search { Line 179  sub search {
179                          $sql_where = " where $sql_where";                          $sql_where = " where $sql_where";
180                  }                  }
181    
182                  warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );                  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?                  my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
184                  $sth->execute( @values );                  $sth->execute( @values );
185    
# Line 170  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 . $base );                          $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.38  
changed lines
  Added in v.44
  ViewVC Help
Powered by ViewVC 1.1.26