Big LDAP changes, module test for Context.pm, still more yet to come.

Signed-off-by: Chris Cormack <crc@liblime.com>
Signed-off-by: Joshua Ferraro <jmf@liblime.com>

diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm
index cc812a7..42f1c71 100644 (file)
--- a/C4/Auth_with_ldap.pm
+++ b/C4/Auth_with_ldap.pm
@@ -21,18 +21,17 @@ use strict;
 use Digest::MD5 qw(md5_base64);
 
 use C4::Context;
-use C4::Members qw(AddMember );
-
+use C4::Members qw(AddMember changepassword);
+use C4::Utils qw( :all );
 use Net::LDAP;
 use Net::LDAP::Filter;
-# use Net::LDAP qw(:all);
 
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
 
 BEGIN {
        require Exporter;
        $VERSION = 3.01;        # set the version for version checking
-       our $debug = $ENV{DEBUG} || 0;
+       $debug = $ENV{DEBUG} || 0;
        @ISA    = qw(Exporter C4::Auth);
        @EXPORT = qw( checkauth );
 }
@@ -128,37 +127,27 @@ C4::Auth - Authenticates Koha users
 # ~ then gets the LDAP entry
 # ~ and calls the memberadd if necessary
 
-use vars qw(%mapping @ldaphosts $base $ldapname $ldappassword);
-
-%mapping = (
-       firstname     => 'givenName',
-       surname       => 'sn',
-       address       => 'postalAddress',
-       city              => 'l',
-       zipcode       => 'postalCode',
-       branchcode    => 'branch',
-       emailaddress  => 'mail',
-       categorycode  => 'employeeType',
-       phone         => 'telephoneNumber',
-);
-
-my $prefhost;
-if ($prefhost = C4::Context->preference('ldapserver')) {       # assignment, not comparison
-       warn "Using preference from ldapserver: $prefhost";
-       (@ldaphosts) = split /\|/,$prefhost;    # Potentially multiple LDAP hosts!
-       $base = C4::Context->preference('ldapinfos') || '';             # probably will fail w/o base
-} else {
-       (@ldaphosts) = (qw(localhost));                 # Potentially multiple LDAP hosts!
-       $base = "dc=metavore,dc=com";                   # But only 1 base.
+sub ldapserver_error ($) {
+       return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
 }
 
-$ldapname     = "cn=Manager,$base";            # Your LDAP user.                               EDIT THIS LINE.
-$ldappassword = 'metavore';                            # Your LDAP user's password.    EDIT THIS LINE.
+use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
+my $context = C4::Context->new()       or die 'C4::Context->new failed';
+my $ldap = $context->{server}->{ldapserver}    or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
+my $prefhost  = $ldap->{hostname}      or die ldapserver_error('hostname');
+my $base      = $ldap->{base}          or die ldapserver_error('base');
+$ldapname     = $ldap->{user}          or die ldapserver_error('user');
+$ldappassword = $ldap->{pass}          or die ldapserver_error('pass');
+our %mapping  = %{$ldap->{mapping}}    or die ldapserver_error('mapping');
+my @mapkeys = keys %mapping;
+print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (  total  ): ", join ' ', @mapkeys, "\n";
+@mapkeys = grep {defined $mapping{$_}->{is}} @mapkeys;
+print STDERR "Got ", scalar(@mapkeys), " ldap mapkeys (populated): ", join ' ', @mapkeys, "\n";
 
 my %config = (
        anonymous => ($ldapname and $ldappassword) ? 0 : 1,
-       replicate => 1,         #    add from LDAP to Koha database for new user
-          update => 1,         # update from LDAP to Koha database for existing user
+       replicate => $ldap->{replicate} || 1,           #    add from LDAP to Koha database for new user
+          update => $ldap->{update}    || 1,           # update from LDAP to Koha database for existing user
 );
 
 sub description ($) {
@@ -175,7 +164,7 @@ sub checkauth {
     {
         return 2;      # Koha superuser account
     }
-    my $db = Net::LDAP->new(\@ldaphosts);
+    my $db = Net::LDAP->new([$prefhost]);
        #$debug and $db->debug(5);
        my $filter = Net::LDAP::Filter->new("uid=$userid") or die "Failed to create new Net::LDAP::Filter";
     my $res = ($config{anonymous}) ? $db->bind : $db->bind($ldapname, password=>$ldappassword);
@@ -211,34 +200,55 @@ sub checkauth {
        if (exists_local($userid)) {
                ($config{update}   ) and &update_local($userid,$password,%borrower);
        } else {
-               ($config{replicate}) and AddMember(%borrower);
+               ($config{replicate}) and warn "Replicating!!" and AddMember(%borrower);
        }
        return 1;
 }
 
 # Pass LDAP entry object and local cardnumber (userid).
 # Returns borrower hash.
-# Edit %mapping so $memberhash{'xxx'} fits your ldap structure.
+# Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure.
 # Ensure that mandatory fields are correctly filled!
 #
 sub ldap_entry_2_hash ($$) {
        my $userldapentry = shift;
        my %borrower = ( cardnumber => shift );
        my %memberhash;
-       my $x = $userldapentry->{asn}{attributes} or return undef;
+       print "keys(\%\$userldapentry) = " . join(', ', keys %$userldapentry), "\n";
+       print $userldapentry->dump();
+       foreach (keys %$userldapentry) {
+               print "\n\nLDAP key: $_\t", sprintf('(%s)', ref $userldapentry->{$_}), "\n";
+               hashdump("LDAP key: ",$userldapentry->{$_});
+       }
+       warn "->{asn}->{attributes} : " . $userldapentry->{asn}->{attributes} ;
+       my $x = $userldapentry->{asn}->{attributes} or return undef;
        my $key;
-       foreach my $k (@$x) {
-               foreach my $k2 ( keys %$k ) {
-                       if ($k2 eq 'type') {
-                               $key = $$k{$k2};
-                       } else {
-                               $memberhash{$key} .= map {$_ . " "} @$k{$k2};
-                       }
-               }
+
+# asn   (HASH)
+# LDAP key: ->{attributes} = ARRAY w/ 17 members.
+# LDAP key: ->{attributes}->{HASH(0x9234290)} = HASH w/ 2 keys.
+# LDAP key: ->{attributes}->{HASH(0x9234290)}->{type} = cn
+# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals} = ARRAY w/ 3 members.
+# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{           sss} = sss
+# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{   Steve Smith} = Steve Smith
+# LDAP key: ->{attributes}->{HASH(0x9234290)}->{vals}->{Steve S. Smith} = Steve S. Smith
+#                                      $x                              $anon
+# LDAP key: ->{attributes}->{HASH(0x9234490)} = HASH w/ 2 keys.
+# LDAP key: ->{attributes}->{HASH(0x9234490)}->{type} = o
+# LDAP key: ->{attributes}->{HASH(0x9234490)}->{vals} = ARRAY w/ 1 members.
+# LDAP key: ->{attributes}->{HASH(0x9234490)}->{vals}->{metavore} = metavore
+#                        $x=([ cn=>['sss','Steve Smith','Steve S. Smith'], sss, o=>['metavore'], ])
+# . . . . .
+
+       foreach my $anon (@$x) {
+               $key = $anon->{type} or next;
+               $memberhash{$key} = join " ", @{$anon->{vals}};
        }
-       foreach my $key (%mapping) {
-               my $data = $memberhash{$mapping{$key}}; 
-               defined $data or $data = ' ';
+       foreach my $key (keys %mapping) {
+               my  $data = $memberhash{$mapping{$key}->{is}}; 
+               unless (defined $data) { 
+                       $data = $mapping{$key}->{content} || '';        # default or failsafe ''
+               }
                $borrower{$key} = ($data ne '') ? $data : ' ' ;
        }
        $borrower{initials} = $memberhash{initials} || 
@@ -262,15 +272,15 @@ sub update_local($$%) {
        my $dbh = C4::Context->dbh;
        my $sth = $dbh->prepare("
 UPDATE borrowers 
-SET    firstname=?,surname=?,initials=?,streetaddress=?,city=?,phone=?, categorycode=?,branchcode=?,emailaddress=?,sort1=?
+SET    firstname=?,surname=?,initials=?,address=?,city=?,phone=?, categorycode=?,branchcode=?,email=?,sort1=?
 WHERE  cardnumber=?
        ");
        $sth->execute(
                $borrower{firstname},    $borrower{surname},
-               $borrower{initials},     $borrower{streetaddress},
+               $borrower{initials},     $borrower{address},
                $borrower{city},         $borrower{phone},
                $borrower{categorycode}, $borrower{branchcode},
-               $borrower{emailaddress}, $borrower{sort1},
+               $borrower{email},                $borrower{sort1},
                $userid
        );
 

diff --git a/C4/Members.pm b/C4/Members.pm
index f52530b..b69b08a 100644 (file)
--- a/C4/Members.pm
+++ b/C4/Members.pm
@@ -602,8 +602,8 @@ Modify borrower's data
 sub ModMember {
     my (%data) = @_;
     my $dbh = C4::Context->dbh;
-    $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth'} ) if ($data{'dateofbirth'} );
-    $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'} ) if ($data{'dateexpiry'} );
+    $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth' } ) if ($data{'dateofbirth' } );
+    $data{'dateexpiry'}   = format_date_in_iso( $data{ 'dateexpiry' } ) if ($data{ 'dateexpiry' } );
     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} ) if ($data{'dateenrolled'} );
     my $qborrower=$dbh->prepare("SHOW columns from borrowers");
     $qborrower->execute;
@@ -673,103 +673,58 @@ sub AddMember {
     $data{'dateofbirth'}  = format_date_in_iso( $data{'dateofbirth'} );
     $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'});
     $data{'dateexpiry'}   = format_date_in_iso( $data{'dateexpiry'}  );
+       # This query should be rewritten to use "?" at execute.
     my $query =
-        "insert into borrowers set cardnumber="
-      . $dbh->quote( $data{'cardnumber'} )
-      . ",surname="
-      . $dbh->quote( $data{'surname'} )
-      . ",firstname="
-      . $dbh->quote( $data{'firstname'} )
-      . ",title="
-      . $dbh->quote( $data{'title'} )
-      . ",othernames="
-      . $dbh->quote( $data{'othernames'} )
-      . ",initials="
-      . $dbh->quote( $data{'initials'} )
-      . ",streetnumber="
-      . $dbh->quote( $data{'streetnumber'} )
-      . ",streettype="
-      . $dbh->quote( $data{'streettype'} )
-      . ",address="
-      . $dbh->quote( $data{'address'} )
-      . ",address2="
-      . $dbh->quote( $data{'address2'} )
-      . ",zipcode="
-      . $dbh->quote( $data{'zipcode'} )
-      . ",city="
-      . $dbh->quote( $data{'city'} )
-      . ",phone="
-      . $dbh->quote( $data{'phone'} )
-      . ",email="
-      . $dbh->quote( $data{'email'} )
-      . ",mobile="
-      . $dbh->quote( $data{'mobile'} )
-      . ",phonepro="
-      . $dbh->quote( $data{'phonepro'} )
-      . ",opacnote="
-      . $dbh->quote( $data{'opacnote'} )
-      . ",guarantorid="
-      . $dbh->quote( $data{'guarantorid'} )
-      . ",dateofbirth="
-      . $dbh->quote( $data{'dateofbirth'} )
-      . ",branchcode="
-      . $dbh->quote( $data{'branchcode'} )
-      . ",categorycode="
-      . $dbh->quote( $data{'categorycode'} )
-      . ",dateenrolled="
-      . $dbh->quote( $data{'dateenrolled'} )
-      . ",contactname="
-      . $dbh->quote( $data{'contactname'} )
-      . ",borrowernotes="
-      . $dbh->quote( $data{'borrowernotes'} )
-      . ",dateexpiry="
-      . $dbh->quote( $data{'dateexpiry'} )
-      . ",contactnote="
-      . $dbh->quote( $data{'contactnote'} )
-      . ",B_address="
-      . $dbh->quote( $data{'B_address'} )
-      . ",B_zipcode="
-      . $dbh->quote( $data{'B_zipcode'} )
-      . ",B_city="
-      . $dbh->quote( $data{'B_city'} )
-      . ",B_phone="
-      . $dbh->quote( $data{'B_phone'} )
-      . ",B_email="
-      . $dbh->quote( $data{'B_email'} )
-      . ",password="
-      . $dbh->quote( $data{'password'} )
-      . ",userid="
-      . $dbh->quote( $data{'userid'} )
-      . ",sort1="
-      . $dbh->quote( $data{'sort1'} )
-      . ",sort2="
-      . $dbh->quote( $data{'sort2'} )
-      . ",contacttitle="
-      . $dbh->quote( $data{'contacttitle'} )
-      . ",emailpro="
-      . $dbh->quote( $data{'emailpro'} )
-      . ",contactfirstname="
-      . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
-      . $dbh->quote( $data{'sex'} ) . ",fax="
-      . $dbh->quote( $data{'fax'} )
-      . ",relationship="
-      . $dbh->quote( $data{'relationship'} )
-      . ",B_streetnumber="
-      . $dbh->quote( $data{'B_streetnumber'} )
-      . ",B_streettype="
-      . $dbh->quote( $data{'B_streettype'} )
-      . ",gonenoaddress="
-      . $dbh->quote( $data{'gonenoaddress'} )
-      . ",lost="
-      . $dbh->quote( $data{'lost'} )
-      . ",debarred="
-      . $dbh->quote( $data{'debarred'} )
-      . ",ethnicity="
-      . $dbh->quote( $data{'ethnicity'} )
-      . ",ethnotes="
-      . $dbh->quote( $data{'ethnotes'} );
-
+        "insert into borrowers set cardnumber=" . $dbh->quote( $data{'cardnumber'} )
+      . ",surname="    . $dbh->quote( $data{'surname'} )
+      . ",firstname="  . $dbh->quote( $data{'firstname'} )
+      . ",title="              . $dbh->quote( $data{'title'} )
+      . ",othernames="         . $dbh->quote( $data{'othernames'} )
+      . ",initials="   . $dbh->quote( $data{'initials'} )
+      . ",streetnumber=". $dbh->quote( $data{'streetnumber'} )
+      . ",streettype="         . $dbh->quote( $data{'streettype'} )
+      . ",address="    . $dbh->quote( $data{'address'} )
+      . ",address2="   . $dbh->quote( $data{'address2'} )
+      . ",zipcode="    . $dbh->quote( $data{'zipcode'} )
+      . ",city="               . $dbh->quote( $data{'city'} )
+      . ",phone="              . $dbh->quote( $data{'phone'} )
+      . ",email="              . $dbh->quote( $data{'email'} )
+      . ",mobile="             . $dbh->quote( $data{'mobile'} )
+      . ",phonepro="   . $dbh->quote( $data{'phonepro'} )
+      . ",opacnote="   . $dbh->quote( $data{'opacnote'} )
+      . ",guarantorid=" . $dbh->quote( $data{'guarantorid'} )
+      . ",dateofbirth=" . $dbh->quote( $data{'dateofbirth'} )
+      . ",branchcode="         . $dbh->quote( $data{'branchcode'} )
+      . ",categorycode=" . $dbh->quote( $data{'categorycode'} )
+      . ",dateenrolled=" . $dbh->quote( $data{'dateenrolled'} )
+      . ",contactname=" . $dbh->quote( $data{'contactname'} )
+      . ",borrowernotes=" . $dbh->quote( $data{'borrowernotes'} )
+      . ",dateexpiry="         . $dbh->quote( $data{'dateexpiry'} )
+      . ",contactnote=" . $dbh->quote( $data{'contactnote'} )
+      . ",B_address="  . $dbh->quote( $data{'B_address'} )
+      . ",B_zipcode="  . $dbh->quote( $data{'B_zipcode'} )
+      . ",B_city="             . $dbh->quote( $data{'B_city'} )
+      . ",B_phone="    . $dbh->quote( $data{'B_phone'} )
+      . ",B_email="    . $dbh->quote( $data{'B_email'} )
+      . ",password="   . $dbh->quote( $data{'password'} )
+      . ",userid="             . $dbh->quote( $data{'userid'} )
+      . ",sort1="              . $dbh->quote( $data{'sort1'} )
+      . ",sort2="              . $dbh->quote( $data{'sort2'} )
+      . ",contacttitle=" . $dbh->quote( $data{'contacttitle'} )
+      . ",emailpro="   . $dbh->quote( $data{'emailpro'} )
+      . ",contactfirstname=" . $dbh->quote( $data{'contactfirstname'} )
+         . ",sex="             . $dbh->quote( $data{'sex'} )
+         . ",fax="             . $dbh->quote( $data{'fax'} )
+      . ",relationship=" . $dbh->quote( $data{'relationship'} )
+      . ",B_streetnumber=" . $dbh->quote( $data{'B_streetnumber'} )
+      . ",B_streettype=" . $dbh->quote( $data{'B_streettype'} )
+      . ",gonenoaddress=" . $dbh->quote( $data{'gonenoaddress'} )
+      . ",lost="               . $dbh->quote( $data{'lost'} )
+      . ",debarred="   . $dbh->quote( $data{'debarred'} )
+      . ",ethnicity="  . $dbh->quote( $data{'ethnicity'} )
+      . ",ethnotes="   . $dbh->quote( $data{'ethnotes'} );
     my $sth = $dbh->prepare($query);
+       print "Executing SQL: $query";
     $sth->execute;
     $sth->finish;
     $data{'borrowernumber'} = $dbh->{'mysql_insertid'};

diff --git a/C4/Utils.pm b/C4/Utils.pm
new file mode 100644 (file)
index 0000000..ad38397
--- /dev/null
+++ b/C4/Utils.pm
@@ -0,0 +1,48 @@
+package C4::Utils;
+
+# Useful code I didn't feel like duplicating all over the place.
+#
+
+use strict;
+use warnings;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
+
+BEGIN {
+       require Exporter;
+       $VERSION = 1.00;        # set the version for version checking
+       $debug = $ENV{DEBUG} || 0;
+       @ISA    = qw(Exporter);
+       @EXPORT_OK = qw(&maxwidth &hashdump);
+       %EXPORT_TAGS = ( all => [qw(&maxwidth &hashdump)], );
+}
+
+
+sub maxwidth (@) {
+       (@_) or return 0;
+       return (sort {$a <=> $b} map {length} @_)[-1];
+}
+
+sub hashdump ($$) {
+       my $pre = shift;
+       my $val  = shift;
+       if (ref($val) =~ /HASH/) {
+               print "$pre = HASH w/ " . scalar(keys %$val) . " keys.\n";
+               my $w2 = maxwidth(keys %$val);
+               foreach (sort keys %$val) {
+                       &hashdump($pre . '->{' . sprintf('%' . $w2 .'s', $_) . '}', $val->{$_});
+               }
+               print "\n";
+       } elsif (ref($val) =~ /ARRAY/) {
+               print "$pre = ARRAY w/ " . scalar(@$val) . " members.\n";
+               my $w2 = maxwidth(@$val);
+               foreach (@$val) {
+                       &hashdump($pre . '->{' . sprintf('%' . $w2 .'s', $_) . '}', $_);
+               }
+               print "\n";
+       } else {
+               print "$pre = $val\n";
+       }
+}
+
+1;
+__END__

diff --git a/t/Auth_with_ldap.t b/t/Auth_with_ldap.t
index 2a4cfc7..92278d5 100755 (executable)
--- a/t/Auth_with_ldap.t
+++ b/t/Auth_with_ldap.t
@@ -5,11 +5,11 @@ use strict;
 use warnings;
 
 use Test::More;
-use vars qw(%cases $dbh $config $ldap);
+use vars qw(%cases $dbh $config $context $ldap);
 
 BEGIN {
        %cases = (
-               # users from example3.ldif
+               # users from t/LDAP/example3.ldif
                sss => 'password1',
                jts => 'password1',
                rch => 'password2',
@@ -27,11 +27,11 @@ sub do_checkauth (;$$) {
        return ($ret = checkauth($dbh,$user,$pass), sprintf("(%s,%s) returns '%s'",$user,$pass,$ret));
 }
 
-ok($dbh    = C4::Context->dbh(),               "Getting dbh from C4::Context");
-ok($config = C4::Context->config(),    "Getting config (hashref) from C4::Context");
-ok($ldap   = $config->{ldap},                  "Getting LDAP info from config");
+ok($context= C4::Context->new(),       "Getting new C4::Context object");
+ok($dbh    = C4::Context->dbh(),       "Getting dbh from C4::Context");
+ok($dbh    = $context->dbh(),          "Getting dbh from \$context object");
 
-diag("The basis of Authenticaiton is that we don't auth everybody.");
+diag("The basis of Authentication is that we don't auth everybody.");
 diag("Let's make sure we reject on bad calls.");
 my $ret;
 ok(!($ret = checkauth($dbh)),       "should reject (  no  arguments) returns '$ret'");

diff --git a/t/Context.t b/t/Context.t
index 6390b73..31b0684 100755 (executable)
--- a/t/Context.t
+++ b/t/Context.t
@@ -1,14 +1,49 @@
 #!/usr/bin/perl
 #
-# This Koha test module is a stub!  
-# Add more tests here!!!
 
 use strict;
 use warnings;
 
-use Test::More tests => 1;
+use Test::More tests => 91;
+use vars qw($debug $koha $dbh $config $ret);
 
 BEGIN {
-        use_ok('C4::Context');
+               $debug = $ENV{DEBUG} || 0;
+               diag("Note: The overall number of tests may vary by configuration.");
+               diag("First we need to check your environmental variables");
+               for (qw(KOHA_CONF PERL5LIB)) {
+                       ok($ret = $ENV{$_}, "ENV{$_} = $ret");
+               }
+               use_ok('C4::Context');
+               use_ok('C4::Utils', qw/ :all /);
 }
 
+ok($koha = C4::Context->new,  'C4::Context->new');
+ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
+ok($ret = C4::Context->KOHAVERSION, '  (function)  KOHAVERSION = ' . ($ret||''));
+ok($ret =       $koha->KOHAVERSION, '       $koha->KOHAVERSION = ' . ($ret||''));
+my @keys = keys %$koha;
+diag("Number of keys in \%\$koha: " . scalar @keys); 
+our $width = 0;
+if (ok(@keys)) { 
+       $width = maxwidth(@keys);
+       $debug and diag "widest key is $width";
+}
+foreach (sort @keys) {
+       ok(exists $koha->{$_}, 
+               '$koha->{' . sprintf('%' . $width . 's', $_)  . '} exists '
+               . ((defined $koha->{$_}) ? "and is defined." : "but is not defined.")
+       );
+}
+diag "Examining defined key values.";
+foreach (grep {defined $koha->{$_}} sort @keys) {
+       print "\n";
+       hashdump('$koha->{' . sprintf('%' . $width . 's', $_)  . '}', $koha->{$_});
+}
+ok($config = $koha->{config}, 'Getting $koha->{config} ');
+
+# diag("Examining configuration.");
+diag("Note: The overall number of tests may vary by configuration.  Disregard the projected number.");
+1;
+__END__
+