Bug 8674: Followup: Add POD for misc/batchdeletebiblios.pl

[koha_fer] / C4 / Auth_with_ldap.pm

diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm
index a2e346c..2f2bb27 100644 (file)
--- a/C4/Auth_with_ldap.pm
+++ b/C4/Auth_with_ldap.pm
@@ -35,7 +35,7 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $debug);
 
 BEGIN {
        require Exporter;
-       $VERSION = 3.10;        # set the version for version checking
+    $VERSION = 3.07.00.049;    # set the version for version checking
        @ISA    = qw(Exporter);
        @EXPORT = qw( checkpw_ldap );
 }
@@ -47,7 +47,7 @@ BEGIN {
 # ~ then gets the LDAP entry
 # ~ and calls the memberadd if necessary
 
-sub ldapserver_error ($) {
+sub ldapserver_error {
        return sprintf('No ldapserver "%s" defined in KOHA_CONF: ' . $ENV{KOHA_CONF}, shift);
 }
 
@@ -70,8 +70,8 @@ my %config = (
        update => defined($ldap->{update}   ) ? $ldap->{update}    : 1,  # update from LDAP to Koha database for existing user
 );
 
-sub description ($) {
-       my $result = shift or return undef;
+sub description {
+       my $result = shift or return;
        return "LDAP error #" . $result->code
                        . ": " . $result->error_name . "\n"
                        . "# " . $result->error_text . "\n";
@@ -197,7 +197,7 @@ return(1, $cardnumber, $userid);
 # Edit KOHA_CONF so $memberhash{'xxx'} fits your ldap structure.
 # Ensure that mandatory fields are correctly filled!
 #
-sub ldap_entry_2_hash ($$) {
+sub ldap_entry_2_hash {
        my $userldapentry = shift;
        my %borrower = ( cardnumber => shift );
        my %memberhash;
@@ -209,7 +209,7 @@ sub ldap_entry_2_hash ($$) {
                        hashdump("LDAP key: ",$userldapentry->{$_});
                }
        }
-       my $x = $userldapentry->{attrs} or return undef;
+       my $x = $userldapentry->{attrs} or return;
        foreach (keys %$x) {
                $memberhash{$_} = join ' ', @{$x->{$_}};        
                $debug and print STDERR sprintf("building \$memberhash{%s} = ", $_, join(' ', @{$x->{$_}})), "\n";
@@ -228,10 +228,21 @@ sub ldap_entry_2_hash ($$) {
                ( substr($borrower{'firstname'},0,1)
                . substr($borrower{ 'surname' },0,1)
                . " ");
+
+       # check if categorycode exists, if not, fallback to default from koha-conf.xml
+       my $dbh = C4::Context->dbh;
+       my $sth = $dbh->prepare("SELECT categorycode FROM categories WHERE categorycode = ?");
+       $sth->execute( uc($borrower{'categorycode'}) );
+       unless ( my $row = $sth->fetchrow_hashref ) {
+               my $default = $mapping{'categorycode'}->{content};
+               $debug && warn "Can't find ", $borrower{'categorycode'}, " default to: $default for ", $borrower{userid};
+               $borrower{'categorycode'} = $default
+       }
+
        return %borrower;
 }
 
-sub exists_local($) {
+sub exists_local {
        my $arg = shift;
        my $dbh = C4::Context->dbh;
        my $select = "SELECT borrowernumber,cardnumber,userid,password FROM borrowers ";
@@ -260,16 +271,16 @@ sub _do_changepassword {
                my ($md5password, $cardnum) = $sth->fetchrow;
         ($digest eq $md5password) and return $cardnum;
                warn "Password mismatch after update to cardnumber=$cardnum (borrowernumber=$borrowerid)";
-               return undef;
+               return;
        }
        die "Unexpected error after password update to userid/borrowernumber: $userid / $borrowerid.";
 }
 
-sub update_local($$$$) {
-       my   $userid   = shift             or return undef;
-       my   $digest   = md5_base64(shift) or return undef;
-       my $borrowerid = shift             or return undef;
-       my $borrower   = shift             or return undef;
+sub update_local {
+       my   $userid   = shift             or return;
+       my   $digest   = md5_base64(shift) or return;
+       my $borrowerid = shift             or return;
+       my $borrower   = shift             or return;
        my @keys = keys %$borrower;
        my $dbh = C4::Context->dbh;
        my $query = "UPDATE  borrowers\nSET     " . 
@@ -357,7 +368,7 @@ C4::Auth - Authenticates Koha users
                | gonenoaddress       | tinyint(1)   | YES  |     | NULL    |                |
                | lost                | tinyint(1)   | YES  |     | NULL    |                |
                | debarred            | date         | YES  |     | NULL    |                |
-        | debarredcomment     | varchar(255) | YES  |     | NULL    |                |
+               | debarredcomment     | varchar(255) | YES  |     | NULL    |                |
                | contactname         | mediumtext   | YES  |     | NULL    |                |
                | contactfirstname    | text         | YES  |     | NULL    |                |
                | contacttitle        | text         | YES  |     | NULL    |                |