/[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 33 by dpavlin, Mon Mar 23 21:31:49 2009 UTC revision 46 by dpavlin, Wed Apr 15 13:50:07 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    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 $sth = $dbh->prepare(q{  my $objectclass_sql = {
42    
43    HrEduPerson => q{
44    
45          select          select
46                  userid                  as uid,                  concat('uid=',trim(userid),',dc=ffzg,dc=hr')    as dn,
47                  firstname               as givenName,                  'person
48                  surname                 as sn,                  organizationalPerson
49                  cardnumber              as otherPager,                  inetOrgPerson
50                  email                   as mail                  hrEduPerson'                                    as objectClass,
51    
52                    trim(userid)                                    as uid,
53                    firstname                                       as givenName,
54                    surname                                         as sn,
55                    concat(firstname,' ',surname)                   as cn,
56    
57                    -- SAFEQ specific mappings from UMgr-LDAP.conf
58                    cardnumber                                      as objectGUID,
59                    surname                                         as displayName,
60                    rfid_sid                                        as pager,
61                    email                                           as mail,
62                    categorycode                                    as ou,
63                    categorycode                                    as organizationalUnit,
64                    categorycode                                    as memberOf,
65                    categorycode                                    as department,
66                    concat('/home/',borrowernumber)                 as homeDirectory
67          from borrowers          from borrowers
68          where  
69                  cardnumber = ?  },
70  });  
71    organizationalUnit => q{
72    
73            select
74                    concat('ou=',categorycode)                      as dn,
75                    '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    # we need reverse LDAP -> SQL mapping for where clause
88    my $ldap_sql_mapping = {
89            'uid'           => 'userid',
90            'objectGUID'    => 'borrowernumber',
91            'displayName'   => 'surname',
92            'sn'            => 'surname',
93            'pager'         => 'rfid_sid',
94    };
95    
96    sub __sql_column {
97            my $name = shift;
98            $ldap_sql_mapping->{$name} || $name;
99    }
100    
101  use constant RESULT_OK => {  use constant RESULT_OK => {
102          'matchedDN' => '',          'matchedDN' => '',
# Line 63  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;
164          my $reqData = shift;          my $reqData = shift;
165          print "searching...\n";          print "searching...\n";
166    
167          warn "# request = ", dump($reqData);          warn "# " . localtime() . " request = ", dump($reqData);
168    
169          my $base = $reqData->{'baseObject'}; # FIXME use it?          my $base = $reqData->{'baseObject'}; # FIXME use it?
170    
171          my @entries;          my @entries;
172          if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {          if ( $reqData->{'filter'} ) {
173    
174                    my $sql_where = '';
175                    @values = ();
176    
177                  my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";                  foreach my $filter ( keys %{ $reqData->{'filter'} } ) {
178    
179                  $sth->execute( $value );                          warn "## filter $filter ", dump( $reqData->{'filter'}->{ $filter } ), "\n";
180    
181                  warn "# ", $sth->rows, " results for: $value\n";                          @limits = ();
182    
183                            if ( ref $reqData->{'filter'}->{ $filter } eq 'ARRAY' ) {
184    
185                                    foreach my $filter ( @{ $reqData->{'filter'}->{ $filter } } ) {
186                                            warn "### filter ",dump($filter),$/;
187                                            foreach my $how ( keys %$filter ) {
188                                                    if ( $how eq 'or' ) {
189                                                            __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
190                                                    } else {
191                                                            __ldap_search_to_sql( $how, $filter->{$how} );
192                                                    }
193                                                    warn "## limits ",dump(@limits), " values ",dump(@values);
194                                            }
195                                    }
196    
197                                    $sql_where .= ' ' . join( " $filter ", @limits );
198    
199                            } else {
200                                    __ldap_search_to_sql( $filter, $reqData->{'filter'}->{$filter} );
201                            }
202    
203                    }
204    
205                    if ( $sql_where ) {
206                            $sql_where = " where $sql_where";
207                    }
208    
209                    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?
213                    $sth->execute( @values );
214    
215                    warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
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 );                          $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.33  
changed lines
  Added in v.46
  ViewVC Help
Powered by ViewVC 1.1.26