/[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 35 by dpavlin, Mon Mar 23 22:00:26 2009 UTC revision 39 by dpavlin, Wed Mar 25 22:57:01 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
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 => 0 }) || die $DBI::errstr;
# Line 29  my $dbh = DBI->connect($dsn . $database, Line 31  my $dbh = DBI->connect($dsn . $database,
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 $sth = $dbh->prepare(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,                  cardnumber                                      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          where  };
50                  cardnumber = ?  
51  });  # we need reverse LDAP -> SQL mapping for where clause
52    my $ldap_sql_mapping = {
53            'uid'           => 'userid',
54            'objectGUID'    => 'borrowernumber',
55            'displayName'   => 'surname',
56            'sn'            => 'surname',
57            'pager'         => 'cardnumber',
58    };
59    
60    # attributes which are same for whole set, but somehow
61    # LDAP clients are sending they anyway and we don't
62    # have them in database
63    my $ldap_ignore = {
64            'objectclass' => 1,
65    };
66    
67    sub __sql_column {
68            my $name = shift;
69            $ldap_sql_mapping->{$name} || $name;
70    }
71    
72  use constant RESULT_OK => {  use constant RESULT_OK => {
73          'matchedDN' => '',          'matchedDN' => '',
# Line 68  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;
132          my $reqData = shift;          my $reqData = shift;
133          print "searching...\n";          print "searching...\n";
134    
135          warn "# request = ", dump($reqData);          warn "# " . localtime() . " request = ", dump($reqData);
136    
137          my $base = $reqData->{'baseObject'}; # FIXME use it?          my $base = $reqData->{'baseObject'}; # FIXME use it?
138    
139          my @entries;          my @entries;
140          if ( $reqData->{'filter'}->{'equalityMatch'}->{'attributeDesc'} eq 'otherPager' ) {          if ( $reqData->{'filter'} ) {
141    
142                    my $sql_where = '';
143                    @values = ();
144    
145                    foreach my $join_with ( keys %{ $reqData->{'filter'} } ) {
146    
147                            warn "## join_with $join_with\n";
148    
149                  my $value = $reqData->{'filter'}->{'equalityMatch'}->{'assertionValue'} || die "no value?";                          @limits = ();
150    
151                            foreach my $filter ( @{ $reqData->{'filter'}->{ $join_with } } ) {
152                                    warn "### filter ",dump($filter),$/;
153                                    foreach my $how ( keys %$filter ) {
154                                            if ( $how eq 'or' ) {
155                                                    __ldap_search_to_sql( %$_ ) foreach ( @{ $filter->{$how} } );
156                                            } else {
157                                                    __ldap_search_to_sql( $how, $filter->{$how} );
158                                            }
159                                            warn "## limits ",dump(@limits), " values ",dump(@values);
160                                    }
161                            }
162    
163                            $sql_where .= ' ' . join( " $join_with ", @limits );
164    
165                    }
166    
167                    if ( $sql_where ) {
168                            $sql_where = " where $sql_where";
169                    }
170    
171                  $sth->execute( $value );                  warn "# SQL:\n$sql_select $sql_where\n# DATA: ",dump( @values );
172                    my $sth = $dbh->prepare( $sql_select . $sql_where . " LIMIT $max_results" ); # XXX remove limit?
173                    $sth->execute( @values );
174    
175                  warn "# ", $sth->rows, " results for: $value\n";                  warn "# ", $sth->rows, " results for ",dump( $reqData->{'filter'} );
176    
177                  while (my $row = $sth->fetchrow_hashref) {                  while (my $row = $sth->fetchrow_hashref) {
178    
# Line 95  sub search { Line 182  sub search {
182                          $dn =~ s{[@\.]}{,dc=}g;                          $dn =~ s{[@\.]}{,dc=}g;
183    
184                          my $entry = Net::LDAP::Entry->new;                          my $entry = Net::LDAP::Entry->new;
185                          $entry->dn( $dn );                          $entry->dn( $dn . $base );
186                          $entry->add( %$row );                          $entry->add( %$row );
187    
188                          #warn "## entry ",dump( $entry );                          #warn "### entry ",dump( $entry );
189    
190                          push @entries, $entry;                          push @entries, $entry;
191                  }                  }
Legend:
Removed from v.35  
changed lines
  Added in v.39
  ViewVC Help
Powered by ViewVC 1.1.26