/[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 42 by dpavlin, Fri Mar 27 16:52:05 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    
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                    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,
62                    categorycode                                    as ou,
63                  categorycode                                    as organizationalUnit,                  categorycode                                    as organizationalUnit,
64                  borrowernumber                                  as objectGUID,                  categorycode                                    as memberOf,
65                    categorycode                                    as department,
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 57  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 96  our @limits; Line 125  our @limits;
125    
126  sub __ldap_search_to_sql {  sub __ldap_search_to_sql {
127          my ( $how, $what ) = @_;          my ( $how, $what ) = @_;
128          warn "### how $how\n";          warn "### __ldap_search_to_sql $how ",dump( $what ),"\n";
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;
138                  }                  }
# Line 122  sub __ldap_search_to_sql { Line 154  sub __ldap_search_to_sql {
154                  push @limits, "$name IS NOT NULL and length($name) > 1";                  push @limits, "$name IS NOT NULL and length($name) > 1";
155                  ## XXX length(foo) > 1 to avoid empty " " strings                  ## XXX length(foo) > 1 to avoid empty " " strings
156          } else {          } else {
157                  warn "UNSUPPORTED: how $how what ",dump( $what );                  warn "UNSUPPORTED: $how ",dump( $what );
158          }          }
159  }  }
160    
# Line 142  sub search { Line 174  sub search {
174                  my $sql_where = '';                  my $sql_where = '';
175                  @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                          @limits = ();                          @limits = ();
182    
183                          if ( ref $reqData->{'filter'}->{ $join_with } ) {                          if ( ref $reqData->{'filter'}->{ $filter } eq 'ARRAY' ) {
184    
185                                  foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {                                  foreach my $filter ( @{ $reqData->{'filter'}->{ $filter } } ) {
186                                          warn "### filter ",dump($filter),$/;                                          warn "### filter ",dump($filter),$/;
187                                          foreach my $how ( keys %$filter ) {                                          foreach my $how ( keys %$filter ) {
188                                                  if ( $how eq 'or' ) {                                                  if ( $how eq 'or' ) {
# Line 162  sub search { Line 194  sub search {
194                                          }                                          }
195                                  }                                  }
196    
197                                  $sql_where .= ' ' . join( " $join_with ", @limits );                                  $sql_where .= ' ' . join( " $filter ", @limits );
198    
199                          } else {                          } else {
200                                  __ldap_search_to_sql( $join_with, $reqData->{'filter'}->{$join_with} );                                  __ldap_search_to_sql( $filter, $reqData->{'filter'}->{$filter} );
201                          }                          }
202    
203                  }                  }
# Line 174  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 182  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.42  
changed lines
  Added in v.46
  ViewVC Help
Powered by ViewVC 1.1.26