/[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 36 by dpavlin, Wed Mar 25 21:15:19 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 = 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
33  # attributes which won't pass through DBI  # attributes which won't pass through DBI
34  my $sql_select = 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  };  };
50    
51  # needed for where clause  # we need reverse LDAP -> SQL mapping for where clause
52  my $sql_ldap_mapping = {  my $ldap_sql_mapping = {
53          'userid'        => 'uid',          '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  # attributes which are same for whole set, but somehow
# Line 58  my $ldap_ignore = { Line 64  my $ldap_ignore = {
64          'objectclass' => 1,          'objectclass' => 1,
65  };  };
66    
 my $ldap_sql_mapping;  
 while ( my ($sql,$ldap) = each %$sql_ldap_mapping ) {  
         $ldap_sql_mapping->{ $ldap } = $sql;  
 }  
   
67  sub __sql_column {  sub __sql_column {
68          my $name = shift;          my $name = shift;
69          $ldap_sql_mapping->{$name} || $name;          $ldap_sql_mapping->{$name} || $name;
# Line 90  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;
# Line 104  sub search { Line 140  sub search {
140          if ( $reqData->{'filter'} ) {          if ( $reqData->{'filter'} ) {
141    
142                  my $sql_where = '';                  my $sql_where = '';
143                  my @values;                  @values = ();
144    
145                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
146    
147                          warn "## join_with $join_with\n";                          warn "## join_with $join_with\n";
148    
149                          my @limits;                          @limits = ();
150    
151                          foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {                          if ( ref $reqData->{'filter'}->{ $join_with } ) {
152                                  warn "### filter ",dump($filter),$/;  
153                                  foreach my $how ( keys %$filter ) {                                  foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
154                                          warn "### how $how\n";                                          warn "### filter ",dump($filter),$/;
155                                          if ( $how eq 'equalityMatch' && defined $filter->{$how} ) {                                          foreach my $how ( keys %$filter ) {
156                                                  my $name = $filter->{$how}->{attributeDesc} || warn "ERROR: no attributeDesc?";                                                  if ( $how eq 'or' ) {
157                                                  my $value = $filter->{$how}->{assertionValue} || warn "ERROR: no assertionValue?";                                                          __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
158                                                  if ( ! $ldap_ignore->{ $name } ) {                                                  } else {
159                                                                  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;  
                                                         }  
160                                                  }                                                  }
161                                          } elsif ( $how eq 'present' ) {                                                  warn "## limits ",dump(@limits), " values ",dump(@values);
                                                 push @limits, __sql_column( $filter->{$how} ) . ' IS NOT NULL';  
                                                 ## XXX add and length(foo) > 0 to avoid empty strings?  
                                         } else {  
                                                 warn "UNSUPPORTED: how $how ",dump( $filter );  
162                                          }                                          }
                                         warn "## limits ",dump(@limits), " values ",dump(@values);  
163                                  }                                  }
                         }  
164    
165                          $sql_where .= ' ' . join( " $join_with ", @limits );                                  $sql_where .= ' ' . join( " $join_with ", @limits );
166    
167                            } else {
168                                    __ldap_search_to_sql( $join_with, $reqData->{'filter'}->{$join_with} );
169                            }
170    
171                  }                  }
172    
# Line 166  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 . $base );                          $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.36  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.26