/[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 45 by dpavlin, Wed Apr 15 12:47:57 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 = 10; # 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    
# Line 31  my $dbh = DBI->connect($dsn . $database, Line 38  my $dbh = DBI->connect($dsn . $database,
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                    cardnumber                                      as objectGUID,
59                  surname                                         as displayName,                  surname                                         as displayName,
60                  rfid_sid                                        as pager,                  rfid_sid                                        as pager,
61                  email                                           as mail,                  email                                           as mail,
# Line 46  my $sql_select = q{ Line 63  my $sql_select = q{
63                  categorycode                                    as organizationalUnit,                  categorycode                                    as organizationalUnit,
64                  categorycode                                    as memberOf,                  categorycode                                    as memberOf,
65                  categorycode                                    as department,                  categorycode                                    as department,
                 borrowernumber                                  as objectGUID,  
66                  concat('/home/',borrowernumber)                 as homeDirectory                  concat('/home/',borrowernumber)                 as homeDirectory
67          from borrowers          from borrowers
68    
69    },
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  # we need reverse LDAP -> SQL mapping for where clause
# Line 60  my $ldap_sql_mapping = { Line 93  my $ldap_sql_mapping = {
93          'pager'         => 'rfid_sid',          'pager'         => 'rfid_sid',
94  };  };
95    
 # attributes which are same for whole set, but somehow  
 # LDAP clients are sending they anyway and we don't  
 # have them in database  
 my $ldap_ignore = {  
         'objectclass' => 1,  
 };  
   
96  sub __sql_column {  sub __sql_column {
97          my $name = shift;          my $name = shift;
98          $ldap_sql_mapping->{$name} || $name;          $ldap_sql_mapping->{$name} || $name;
# Line 103  sub __ldap_search_to_sql { Line 129  sub __ldap_search_to_sql {
129          if ( $how eq 'equalityMatch' && defined $what ) {          if ( $how eq 'equalityMatch' && defined $what ) {
130                  my $name = $what->{attributeDesc} || warn "ERROR: no attributeDesc?";                  my $name = $what->{attributeDesc} || warn "ERROR: no attributeDesc?";
131                  my $value = $what->{assertionValue} || warn "ERROR: no assertionValue?";                  my $value = $what->{assertionValue} || warn "ERROR: no assertionValue?";
132                  if ( ! $ldap_ignore->{ $name } ) {  
133                    if ( lc $name eq 'objectclass' ) {
134                            $objectclass = $value;
135                    } else {
136                          push @limits, __sql_column($name) . ' = ?';                          push @limits, __sql_column($name) . ' = ?';
137                          push @values, $value;                          push @values, $value;
                 } else {  
                         warn "IGNORED: $name = $value";  
138                  }                  }
139          } elsif ( $how eq 'substrings' ) {          } elsif ( $how eq 'substrings' ) {
140                  foreach my $substring ( @{ $what->{substrings} } ) {                  foreach my $substring ( @{ $what->{substrings} } ) {
# Line 179  sub search { Line 206  sub search {
206                          $sql_where = " where $sql_where";                          $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 );                  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 );
# Line 187  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;  
                         $dn .= ',' . $base unless $dn =~ m{dc}i;  
226    
227                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
228                          $entry->dn( $dn );                          $entry->dn( $dn );
                         $entry->add( objectClass => [  
                                 "person",  
                                 "organizationalPerson",  
                                 "inetOrgPerson",  
                                 "hrEduPerson",  
                         ] );  
229                          $entry->add( %$row );                          $entry->add( %$row );
230    
231                          #$entry->changetype( 'modify' );                          #$entry->changetype( 'modify' );
Legend:
Removed from v.45  
changed lines
  Added in v.46
  ViewVC Help
Powered by ViewVC 1.1.26