/[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 46 by dpavlin, Wed Apr 15 13:50:07 2009 UTC
# Line 24  our $passwd   = 'unconfigured-password'; Line 24  our $passwd   = 'unconfigured-password';
24    
25  our $max_results = 3; # 100; # FIXME  our $max_results = 3; # 100; # FIXME
26    
27    our $objectclass = 'HrEduPerson';
28    
29    $SIG{__DIE__} = sub {
30            warn "!!! DIE ", @_;
31            die @_;
32    };
33    
34  require 'config.pl' if -e 'config.pl';  require 'config.pl' if -e 'config.pl';
35    
36  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;
37    
38  # Net::LDAP::Entry will lc all our attribute names anyway, so  # Net::LDAP::Entry will lc all our attribute names anyway, so
39  # we don't really care about correctCapitalization for LDAP  # we don't really care about correctCapitalization for LDAP
40  # attributes which won't pass through DBI  # attributes which won't pass through DBI
41  my $sql_select = q{  my $objectclass_sql = {
42    
43    HrEduPerson => q{
44    
45          select          select
46                    concat('uid=',trim(userid),',dc=ffzg,dc=hr')    as dn,
47                    'person
48                    organizationalPerson
49                    inetOrgPerson
50                    hrEduPerson'                                    as objectClass,
51    
52                  trim(userid)                                    as uid,                  trim(userid)                                    as uid,
53                  firstname                                               as givenName,                  firstname                                       as givenName,
54                  surname                                                 as sn,                  surname                                         as sn,
55                  concat(firstname,' ',surname)   as cn,                  concat(firstname,' ',surname)                   as cn,
56    
57                  -- SAFEQ specific mappings from UMgr-LDAP.conf                  -- SAFEQ specific mappings from UMgr-LDAP.conf
58                  concat(firstname,' ',surname)   as displayName,                  cardnumber                                      as objectGUID,
59                  cardnumber                                              as otherPager,                  surname                                         as displayName,
60                  email                                                   as mail,                  rfid_sid                                        as pager,
61                    email                                           as mail,
62                    categorycode                                    as ou,
63                  categorycode                                    as organizationalUnit,                  categorycode                                    as organizationalUnit,
64                  borrowernumber                                  as objectGUID,                  categorycode                                    as memberOf,
65                  concat('/home/',borrowernumber) as homeDirectory                  categorycode                                    as department,
66                    concat('/home/',borrowernumber)                 as homeDirectory
67          from borrowers          from borrowers
 };  
68    
69  # needed for where clause  },
 my $sql_ldap_mapping = {  
         'userid'                        => 'uid',  
         'borrowernumber'        => 'objectGUID',  
 };  
70    
71  # attributes which are same for whole set, but somehow  organizationalUnit => q{
72  # LDAP clients are sending they anyway and we don't  
73  # have them in database          select
74  my $ldap_ignore = {                  concat('ou=',categorycode)                      as dn,
75          'objectclass' => 1,                  'organizationalUnit
76                    top'                                            as objectClass,
77    
78                    hex(md5(categorycode)) % 10000                  as objectGUID,
79    
80                    categorycode                                    as ou,
81                    description                                     as displayName
82            from categories
83    
84    },
85  };  };
86    
87  my $ldap_sql_mapping;  # we need reverse LDAP -> SQL mapping for where clause
88  while ( my ($sql,$ldap) = each %$sql_ldap_mapping ) {  my $ldap_sql_mapping = {
89          $ldap_sql_mapping->{ $ldap } = $sql;          'uid'           => 'userid',
90  }          'objectGUID'    => 'borrowernumber',
91            'displayName'   => 'surname',
92            'sn'            => 'surname',
93            'pager'         => 'rfid_sid',
94    };
95    
96  sub __sql_column {  sub __sql_column {
97          my $name = shift;          my $name = shift;
# Line 93  sub bind { Line 120  sub bind {
120          return RESULT_OK;          return RESULT_OK;
121  }  }
122    
123    our @values;
124    our @limits;
125    
126    sub __ldap_search_to_sql {
127            my ( $how, $what ) = @_;
128            warn "### __ldap_search_to_sql $how ",dump( $what ),"\n";
129            if ( $how eq 'equalityMatch' && defined $what ) {
130                    my $name = $what->{attributeDesc} || warn "ERROR: no attributeDesc?";
131                    my $value = $what->{assertionValue} || warn "ERROR: no assertionValue?";
132    
133                    if ( lc $name eq 'objectclass' ) {
134                            $objectclass = $value;
135                    } else {
136                            push @limits, __sql_column($name) . ' = ?';
137                            push @values, $value;
138                    }
139            } elsif ( $how eq 'substrings' ) {
140                    foreach my $substring ( @{ $what->{substrings} } ) {
141                            my $name = $what->{type} || warn "ERROR: no type?";
142                            while ( my($op,$value) = each %$substring ) {
143                                    push @limits, __sql_column($name) . ' LIKE ?';
144                                    if ( $op eq 'any' ) {
145                                            $value = '%' . $value . '%';
146                                    } else {
147                                            warn "UNSUPPORTED: op $op - using plain $value";
148                                    }
149                                    push @values, $value;
150                            }
151                    }
152            } elsif ( $how eq 'present' ) {
153                    my $name = __sql_column( $what );
154                    push @limits, "$name IS NOT NULL and length($name) > 1";
155                    ## XXX length(foo) > 1 to avoid empty " " strings
156            } else {
157                    warn "UNSUPPORTED: $how ",dump( $what );
158            }
159    }
160    
161  # the search operation  # the search operation
162  sub search {  sub search {
163          my $self = shift;          my $self = shift;
# Line 107  sub search { Line 172  sub search {
172          if ( $reqData->{'filter'} ) {          if ( $reqData->{'filter'} ) {
173    
174                  my $sql_where = '';                  my $sql_where = '';
175                  my @values;                  @values = ();
176    
177                  foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {                  foreach my $filter ( keys %{ $reqData->{'filter'} } ) {
178    
179                          warn "## join_with $join_with\n";                          warn "## filter $filter ", dump( $reqData->{'filter'}->{ $filter } ), "\n";
180    
181                          my @limits;                          @limits = ();
182    
183                          foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {                          if ( ref $reqData->{'filter'}->{ $filter } eq 'ARRAY' ) {
184                                  warn "### filter ",dump($filter),$/;  
185                                  foreach my $how ( keys %$filter ) {                                  foreach my $filter ( @{ $reqData->{'filter'}->{ $filter } } ) {
186                                          warn "### how $how\n";                                          warn "### filter ",dump($filter),$/;
187                                          if ( $how eq 'equalityMatch' && defined $filter->{$how} ) {                                          foreach my $how ( keys %$filter ) {
188                                                  my $name = $filter->{$how}->{attributeDesc} || warn "ERROR: no attributeDesc?";                                                  if ( $how eq 'or' ) {
189                                                  my $value = $filter->{$how}->{assertionValue} || warn "ERROR: no assertionValue?";                                                          __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
190                                                  if ( ! $ldap_ignore->{ $name } ) {                                                  } else {
191                                                                  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;  
                                                         }  
192                                                  }                                                  }
193                                          } 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 );  
194                                          }                                          }
                                         warn "## limits ",dump(@limits), " values ",dump(@values);  
195                                  }                                  }
                         }  
196    
197                          $sql_where .= ' ' . join( " $join_with ", @limits );                                  $sql_where .= ' ' . join( " $filter ", @limits );
198    
199                            } else {
200                                    __ldap_search_to_sql( $filter, $reqData->{'filter'}->{$filter} );
201                            }
202    
203                  }                  }
204    
# Line 158  sub search { Line 206  sub search {
206                          $sql_where = " where $sql_where";                          $sql_where = " where $sql_where";
207                  }                  }
208    
209                  warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );                  my $sql_select = $objectclass_sql->{ $objectclass } || die "can't find SQL query for $objectclass";
210    
211                    warn "# SQL:\n$sql_select\n$sql_where\n# DATA: ",dump( @values );
212                  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?
213                  $sth->execute( @values );                  $sth->execute( @values );
214    
# Line 166  sub search { Line 216  sub search {
216    
217                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
218    
219                            die "no objectClass column in $sql_select" unless defined $row->{objectClass};
220    
221                            $row->{objectClass} = [ split(/\s+/, $row->{objectClass}) ] if $row->{objectClass} =~ m{\n};
222    
223                          warn "## row = ",dump( $row );                          warn "## row = ",dump( $row );
224    
225                          my $dn = 'uid=' . $row->{uid} || die "no uid";                          my $dn = delete( $row->{dn} ) || die "no dn in $sql_select";
                         $dn =~ s{[@\.]}{,dc=}g;  
226    
227                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
228                          $entry->dn( $dn . $base );                          $entry->dn( $dn );
229                          $entry->add( %$row );                          $entry->add( %$row );
230    
231                          #warn "### entry ",dump( $entry );                          #$entry->changetype( 'modify' );
232    
233                            warn "### entry ",$entry->dump( \*STDERR );
234    
235                          push @entries, $entry;                          push @entries, $entry;
236                  }                  }
Legend:
Removed from v.38  
changed lines
  Added in v.46
  ViewVC Help
Powered by ViewVC 1.1.26