Bug 21336: Introduce administrative lockout
[koha-equinox.git] / Koha / Patron.pm
index ffdd7e3..769324a 100644 (file)
@@ -21,23 +21,62 @@ package Koha::Patron;
 use Modern::Perl;
 
 use Carp;
+use List::MoreUtils qw( any uniq );
+use JSON qw( to_json );
+use Text::Unaccent qw( unac_string );
 
 use C4::Context;
 use C4::Log;
+use Koha::AuthUtils;
 use Koha::Checkouts;
 use Koha::Database;
 use Koha::DateUtils;
+use Koha::Exceptions::Password;
 use Koha::Holds;
 use Koha::Old::Checkouts;
+use Koha::Patron::Attributes;
 use Koha::Patron::Categories;
 use Koha::Patron::HouseboundProfile;
 use Koha::Patron::HouseboundRole;
 use Koha::Patron::Images;
 use Koha::Patrons;
 use Koha::Virtualshelves;
+use Koha::Club::Enrollments;
+use Koha::Account;
+use Koha::Subscription::Routinglists;
 
 use base qw(Koha::Object);
 
+our $RESULTSET_PATRON_ID_MAPPING = {
+    Accountline          => 'borrowernumber',
+    Aqbasketuser         => 'borrowernumber',
+    Aqbudget             => 'budget_owner_id',
+    Aqbudgetborrower     => 'borrowernumber',
+    ArticleRequest       => 'borrowernumber',
+    BorrowerAttribute    => 'borrowernumber',
+    BorrowerDebarment    => 'borrowernumber',
+    BorrowerFile         => 'borrowernumber',
+    BorrowerModification => 'borrowernumber',
+    ClubEnrollment       => 'borrowernumber',
+    Issue                => 'borrowernumber',
+    ItemsLastBorrower    => 'borrowernumber',
+    Linktracker          => 'borrowernumber',
+    Message              => 'borrowernumber',
+    MessageQueue         => 'borrowernumber',
+    OldIssue             => 'borrowernumber',
+    OldReserve           => 'borrowernumber',
+    Rating               => 'borrowernumber',
+    Reserve              => 'borrowernumber',
+    Review               => 'borrowernumber',
+    SearchHistory        => 'userid',
+    Statistic            => 'borrowernumber',
+    Suggestion           => 'suggestedby',
+    TagAll               => 'borrowernumber',
+    Virtualshelfcontent  => 'borrowernumber',
+    Virtualshelfshare    => 'borrowernumber',
+    Virtualshelve        => 'owner',
+};
+
 =head1 NAME
 
 Koha::Patron - Koha Patron Object class
@@ -46,8 +85,225 @@ Koha::Patron - Koha Patron Object class
 
 =head2 Class Methods
 
+=head3 new
+
+=cut
+
+sub new {
+    my ( $class, $params ) = @_;
+
+    return $class->SUPER::new($params);
+}
+
+=head3 fixup_cardnumber
+
+Autogenerate next cardnumber from highest value found in database
+
+=cut
+
+sub fixup_cardnumber {
+    my ( $self ) = @_;
+    my $max = Koha::Patrons->search({
+        cardnumber => {-regexp => '^-?[0-9]+$'}
+    }, {
+        select => \'CAST(cardnumber AS SIGNED)',
+        as => ['cast_cardnumber']
+    })->_resultset->get_column('cast_cardnumber')->max;
+    $self->cardnumber(($max || 0) +1);
+}
+
+=head3 trim_whitespace
+
+trim whitespace from data which has some non-whitespace in it.
+Could be moved to Koha::Object if need to be reused
+
+=cut
+
+sub trim_whitespaces {
+    my( $self ) = @_;
+
+    my $schema  = Koha::Database->new->schema;
+    my @columns = $schema->source($self->_type)->columns;
+
+    for my $column( @columns ) {
+        my $value = $self->$column;
+        if ( defined $value ) {
+            $value =~ s/^\s*|\s*$//g;
+            $self->$column($value);
+        }
+    }
+    return $self;
+}
+
+=head3 plain_text_password
+
+$patron->plain_text_password( $password );
+
+stores a copy of the unencrypted password in the object
+for use in code before encrypting for db
+
+=cut
+
+sub plain_text_password {
+    my ( $self, $password ) = @_;
+    if ( $password ) {
+        $self->{_plain_text_password} = $password;
+        return $self;
+    }
+    return $self->{_plain_text_password}
+        if $self->{_plain_text_password};
+
+    return;
+}
+
+=head3 store
+
+Patron specific store method to cleanup record
+and do other necessary things before saving
+to db
+
 =cut
 
+sub store {
+    my ($self) = @_;
+
+    $self->_result->result_source->schema->txn_do(
+        sub {
+            if (
+                C4::Context->preference("autoMemberNum")
+                and ( not defined $self->cardnumber
+                    or $self->cardnumber eq '' )
+              )
+            {
+                # Warning: The caller is responsible for locking the members table in write
+                # mode, to avoid database corruption.
+                # We are in a transaction but the table is not locked
+                $self->fixup_cardnumber;
+            }
+
+            unless( $self->category->in_storage ) {
+                Koha::Exceptions::Object::FKConstraint->throw(
+                    broken_fk => 'categorycode',
+                    value     => $self->categorycode,
+                );
+            }
+
+            $self->trim_whitespaces;
+
+            unless ( $self->in_storage ) {    #AddMember
+
+                # Generate a valid userid/login if needed
+                $self->generate_userid
+                  if not $self->userid or not $self->has_valid_userid;
+
+                # Add expiration date if it isn't already there
+                unless ( $self->dateexpiry ) {
+                    $self->dateexpiry( $self->category->get_expiry_date );
+                }
+
+                # Add enrollment date if it isn't already there
+                unless ( $self->dateenrolled ) {
+                    $self->dateenrolled(dt_from_string);
+                }
+
+                # Set the privacy depending on the patron's category
+                my $default_privacy = $self->category->default_privacy || q{};
+                $default_privacy =
+                    $default_privacy eq 'default' ? 1
+                  : $default_privacy eq 'never'   ? 2
+                  : $default_privacy eq 'forever' ? 0
+                  :                                                   undef;
+                $self->privacy($default_privacy);
+
+
+                # Make a copy of the plain text password for later use
+                $self->plain_text_password( $self->password );
+
+                # Create a disabled account if no password provided
+                $self->password( $self->password
+                    ? Koha::AuthUtils::hash_password( $self->password )
+                    : '!' );
+
+                $self->borrowernumber(undef);
+
+                $self = $self->SUPER::store;
+
+                $self->add_enrolment_fee_if_needed;
+
+                logaction( "MEMBERS", "CREATE", $self->borrowernumber, "" )
+                  if C4::Context->preference("BorrowersLog");
+            }
+            else {    #ModMember
+
+                my $self_from_storage = $self->get_from_storage;
+                # FIXME We should not deal with that here, callers have to do this job
+                # Moved from ModMember to prevent regressions
+                unless ( $self->userid ) {
+                    my $stored_userid = $self_from_storage->userid;
+                    $self->userid($stored_userid);
+                }
+
+                # Password must be updated using $self->set_password
+                $self->password($self_from_storage->password);
+
+                if ( C4::Context->preference('FeeOnChangePatronCategory')
+                    and $self->category->categorycode ne
+                    $self_from_storage->category->categorycode )
+                {
+                    $self->add_enrolment_fee_if_needed;
+                }
+
+                # Actionlogs
+                if ( C4::Context->preference("BorrowersLog") ) {
+                    my $info;
+                    my $from_storage = $self_from_storage->unblessed;
+                    my $from_object  = $self->unblessed;
+                    my @skip_fields  = (qw/lastseen/);
+                    for my $key ( keys %{$from_storage} ) {
+                        next if any { /$key/ } @skip_fields;
+                        if (
+                            (
+                                  !defined( $from_storage->{$key} )
+                                && defined( $from_object->{$key} )
+                            )
+                            || ( defined( $from_storage->{$key} )
+                                && !defined( $from_object->{$key} ) )
+                            || (
+                                   defined( $from_storage->{$key} )
+                                && defined( $from_object->{$key} )
+                                && ( $from_storage->{$key} ne
+                                    $from_object->{$key} )
+                            )
+                          )
+                        {
+                            $info->{$key} = {
+                                before => $from_storage->{$key},
+                                after  => $from_object->{$key}
+                            };
+                        }
+                    }
+
+                    if ( defined($info) ) {
+                        logaction(
+                            "MEMBERS",
+                            "MODIFY",
+                            $self->borrowernumber,
+                            to_json(
+                                $info,
+                                { utf8 => 1, pretty => 1, canonical => 1 }
+                            )
+                        );
+                    }
+                }
+
+                # Final store
+                $self = $self->SUPER::store;
+            }
+        }
+    );
+    return $self;
+}
+
 =head3 delete
 
 $patron->delete
@@ -66,8 +322,7 @@ sub delete {
     $self->_result->result_source->schema->txn_do(
         sub {
             # Delete Patron's holds
-            # FIXME Should be $patron->get_holds
-            $_->delete for Koha::Holds->search( { borrowernumber => $self->borrowernumber } );
+            $self->holds->delete;
 
             # Delete all lists and all shares of this borrower
             # Consistent with the approach Koha uses on deleting individual lists
@@ -124,7 +379,7 @@ sub guarantor {
 sub image {
     my ( $self ) = @_;
 
-    return Koha::Patron::Images->find( $self->borrowernumber );
+    return scalar Koha::Patron::Images->find( $self->borrowernumber );
 }
 
 sub library {
@@ -141,7 +396,7 @@ Returns the guarantees (list of Koha::Patron) of this patron
 sub guarantees {
     my ( $self ) = @_;
 
-    return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
+    return Koha::Patrons->search( { guarantorid => $self->borrowernumber }, { order_by => { -asc => ['surname','firstname'] } } );
 }
 
 =head3 housebound_profile
@@ -198,6 +453,54 @@ sub siblings {
     );
 }
 
+=head3 merge_with
+
+    my $patron = Koha::Patrons->find($id);
+    $patron->merge_with( \@patron_ids );
+
+    This subroutine merges a list of patrons into the patron record. This is accomplished by finding
+    all related patron ids for the patrons to be merged in other tables and changing the ids to be that
+    of the keeper patron.
+
+=cut
+
+sub merge_with {
+    my ( $self, $patron_ids ) = @_;
+
+    my @patron_ids = @{ $patron_ids };
+
+    # Ensure the keeper isn't in the list of patrons to merge
+    @patron_ids = grep { $_ ne $self->id } @patron_ids;
+
+    my $schema = Koha::Database->new()->schema();
+
+    my $results;
+
+    $self->_result->result_source->schema->txn_do( sub {
+        foreach my $patron_id (@patron_ids) {
+            my $patron = Koha::Patrons->find( $patron_id );
+
+            next unless $patron;
+
+            # Unbless for safety, the patron will end up being deleted
+            $results->{merged}->{$patron_id}->{patron} = $patron->unblessed;
+
+            while (my ($r, $field) = each(%$RESULTSET_PATRON_ID_MAPPING)) {
+                my $rs = $schema->resultset($r)->search({ $field => $patron_id });
+                $results->{merged}->{ $patron_id }->{updated}->{$r} = $rs->count();
+                $rs->update({ $field => $self->id });
+            }
+
+            $patron->move_to_deleted();
+            $patron->delete();
+        }
+    });
+
+    return $results;
+}
+
+
+
 =head3 wants_check_for_previous_checkout
 
     $wants_check = $patron->wants_check_for_previous_checkout;
@@ -265,7 +568,7 @@ sub do_check_for_previous_checkout {
     return $old_issues->count;  # 0 || N
 }
 
-=head2 is_debarred
+=head3 is_debarred
 
 my $debarment_expiration = $patron->is_debarred;
 
@@ -284,7 +587,7 @@ sub is_debarred {
     return;
 }
 
-=head2 is_expired
+=head3 is_expired
 
 my $is_expired = $patron->is_expired;
 
@@ -295,12 +598,12 @@ Returns 1 if the patron is expired or 0;
 sub is_expired {
     my ($self) = @_;
     return 0 unless $self->dateexpiry;
-    return 0 if $self->dateexpiry eq '0000-00-00';
+    return 0 if $self->dateexpiry =~ '^9999';
     return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
     return 0;
 }
 
-=head2 is_going_to_expire
+=head3 is_going_to_expire
 
 my $is_going_to_expire = $patron->is_going_to_expire;
 
@@ -315,30 +618,76 @@ sub is_going_to_expire {
 
     return 0 unless $delay;
     return 0 unless $self->dateexpiry;
-    return 0 if $self->dateexpiry eq '0000-00-00';
+    return 0 if $self->dateexpiry =~ '^9999';
     return 1 if dt_from_string( $self->dateexpiry )->subtract( days => $delay ) < dt_from_string->truncate( to => 'day' );
     return 0;
 }
 
-=head2 update_password
+=head3 set_password
+
+    $patron->set_password({ password => $plain_text_password [, skip_validation => 1 ] });
+
+Set the patron's password.
+
+=head4 Exceptions
+
+The passed string is validated against the current password enforcement policy.
+Validation can be skipped by passing the I<skip_validation> parameter.
+
+Exceptions are thrown if the password is not good enough.
 
-my $updated = $patron->update_password( $userid, $password );
+=over 4
 
-Update the userid and the password of a patron.
-If the userid already exists, returns and let DBIx::Class warns
-This will add an entry to action_logs if BorrowersLog is set.
+=item Koha::Exceptions::Password::TooShort
+
+=item Koha::Exceptions::Password::WhitespaceCharacters
+
+=item Koha::Exceptions::Password::TooWeak
+
+=back
 
 =cut
 
-sub update_password {
-    my ( $self, $userid, $password ) = @_;
-    eval { $self->userid($userid)->store; };
-    return if $@; # Make sure the userid is not already in used by another patron
-    $self->password($password)->store;
-    logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
-    return 1;
+sub set_password {
+    my ( $self, $args ) = @_;
+
+    my $password = $args->{password};
+
+    unless ( $args->{skip_validation} ) {
+        my ( $is_valid, $error ) = Koha::AuthUtils::is_password_valid( $password );
+
+        if ( !$is_valid ) {
+            if ( $error eq 'too_short' ) {
+                my $min_length = C4::Context->preference('minPasswordLength');
+                $min_length = 3 if not $min_length or $min_length < 3;
+
+                my $password_length = length($password);
+                Koha::Exceptions::Password::TooShort->throw(
+                    length => $password_length, min_length => $min_length );
+            }
+            elsif ( $error eq 'has_whitespaces' ) {
+                Koha::Exceptions::Password::WhitespaceCharacters->throw();
+            }
+            elsif ( $error eq 'too_weak' ) {
+                Koha::Exceptions::Password::TooWeak->throw();
+            }
+        }
+    }
+
+    my $digest = Koha::AuthUtils::hash_password($password);
+    $self->update(
+        {   password       => $digest,
+            login_attempts => 0,
+        }
+    );
+
+    logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" )
+        if C4::Context->preference("BorrowersLog");
+
+    return $self;
 }
 
+
 =head3 renew_account
 
 my $new_expiry_date = $patron->renew_account
@@ -360,7 +709,9 @@ sub renew_account {
     }
     my $expiry_date = $self->category->get_expiry_date($date);
 
-    $self->dateexpiry($expiry_date)->store;
+    $self->dateexpiry($expiry_date);
+    $self->date_renewed( dt_from_string() );
+    $self->store();
 
     $self->add_enrolment_fee_if_needed;
 
@@ -368,7 +719,7 @@ sub renew_account {
     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 }
 
-=head2 has_overdues
+=head3 has_overdues
 
 my $has_overdues = $patron->has_overdues;
 
@@ -382,7 +733,7 @@ sub has_overdues {
     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 }
 
-=head2 track_login
+=head3 track_login
 
     $patron->track_login;
     $patron->track_login({ force => 1 });
@@ -401,7 +752,7 @@ sub track_login {
     $self->lastseen( dt_from_string() )->store;
 }
 
-=head2 move_to_deleted
+=head3 move_to_deleted
 
 my $is_moved = $patron->move_to_deleted;
 
@@ -413,6 +764,7 @@ This can be done before deleting a patron, to make sure the data are not complet
 sub move_to_deleted {
     my ($self) = @_;
     my $patron_infos = $self->unblessed;
+    delete $patron_infos->{updated_on}; #This ensures the updated_on date in deletedborrowers will be set to the current timestamp
     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 }
 
@@ -495,29 +847,78 @@ sub add_enrolment_fee_if_needed {
     my ($self) = @_;
     my $enrolment_fee = $self->category->enrolmentfee;
     if ( $enrolment_fee && $enrolment_fee > 0 ) {
-        # insert fee in patron debts
-        C4::Accounts::manualinvoice( $self->borrowernumber, '', '', 'A', $enrolment_fee );
+        $self->account->add_debit(
+            {
+                amount     => $enrolment_fee,
+                user_id    => C4::Context->userenv ? C4::Context->userenv->{'number'} : undef,
+                interface  => C4::Context->interface,
+                library_id => C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef,
+                type       => 'account'
+            }
+        );
     }
     return $enrolment_fee || 0;
 }
 
 =head3 checkouts
 
-my $issues = $patron->checkouts
+my $checkouts = $patron->checkouts
 
 =cut
 
 sub checkouts {
     my ($self) = @_;
-    my $issues = $self->_result->issues;
-    return Koha::Checkouts->_new_from_dbic( $issues );
+    my $checkouts = $self->_result->issues;
+    return Koha::Checkouts->_new_from_dbic( $checkouts );
+}
+
+=head3 pending_checkouts
+
+my $pending_checkouts = $patron->pending_checkouts
+
+This method will return the same as $self->checkouts, but with a prefetch on
+items, biblio and biblioitems.
+
+It has been introduced to replaced the C4::Members::GetPendingIssues subroutine
+
+It should not be used directly, prefer to access fields you need instead of
+retrieving all these fields in one go.
+
+=cut
+
+sub pending_checkouts {
+    my( $self ) = @_;
+    my $checkouts = $self->_result->issues->search(
+        {},
+        {
+            order_by => [
+                { -desc => 'me.timestamp' },
+                { -desc => 'issuedate' },
+                { -desc => 'issue_id' }, # Sort by issue_id should be enough
+            ],
+            prefetch => { item => { biblio => 'biblioitems' } },
+        }
+    );
+    return Koha::Checkouts->_new_from_dbic( $checkouts );
+}
+
+=head3 old_checkouts
+
+my $old_checkouts = $patron->old_checkouts
+
+=cut
+
+sub old_checkouts {
+    my ($self) = @_;
+    my $old_checkouts = $self->_result->old_issues;
+    return Koha::Old::Checkouts->_new_from_dbic( $old_checkouts );
 }
 
 =head3 get_overdues
 
 my $overdue_items = $patron->get_overdues
 
-Return the overdued items
+Return the overdue items
 
 =cut
 
@@ -534,6 +935,20 @@ sub get_overdues {
     );
 }
 
+=head3 get_routing_lists
+
+my @routinglists = $patron->get_routing_lists
+
+Returns the routing lists a patron is subscribed to.
+
+=cut
+
+sub get_routing_lists {
+    my ($self) = @_;
+    my $routing_list_rs = $self->_result->subscriptionroutinglists;
+    return Koha::Subscription::Routinglists->_new_from_dbic($routing_list_rs);
+}
+
 =head3 get_age
 
 my $age = $patron->get_age
@@ -545,6 +960,7 @@ Return the age of the patron
 sub get_age {
     my ($self)    = @_;
     my $today_str = dt_from_string->strftime("%Y-%m-%d");
+    return unless $self->dateofbirth;
     my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
 
     my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
@@ -583,7 +999,324 @@ sub holds {
     return Koha::Holds->_new_from_dbic($holds_rs);
 }
 
-=head3 type
+=head3 old_holds
+
+my $old_holds = $patron->old_holds
+
+Return all the historical holds for this patron
+
+=cut
+
+sub old_holds {
+    my ($self) = @_;
+    my $old_holds_rs = $self->_result->old_reserves->search( {}, { order_by => 'reservedate' } );
+    return Koha::Old::Holds->_new_from_dbic($old_holds_rs);
+}
+
+=head3 notice_email_address
+
+  my $email = $patron->notice_email_address;
+
+Return the email address of patron used for notices.
+Returns the empty string if no email address.
+
+=cut
+
+sub notice_email_address{
+    my ( $self ) = @_;
+
+    my $which_address = C4::Context->preference("AutoEmailPrimaryAddress");
+    # if syspref is set to 'first valid' (value == OFF), look up email address
+    if ( $which_address eq 'OFF' ) {
+        return $self->first_valid_email_address;
+    }
+
+    return $self->$which_address || '';
+}
+
+=head3 first_valid_email_address
+
+my $first_valid_email_address = $patron->first_valid_email_address
+
+Return the first valid email address for a patron.
+For now, the order  is defined as email, emailpro, B_email.
+Returns the empty string if the borrower has no email addresses.
+
+=cut
+
+sub first_valid_email_address {
+    my ($self) = @_;
+
+    return $self->email() || $self->emailpro() || $self->B_email() || q{};
+}
+
+=head3 get_club_enrollments
+
+=cut
+
+sub get_club_enrollments {
+    my ( $self, $return_scalar ) = @_;
+
+    my $e = Koha::Club::Enrollments->search( { borrowernumber => $self->borrowernumber(), date_canceled => undef } );
+
+    return $e if $return_scalar;
+
+    return wantarray ? $e->as_list : $e;
+}
+
+=head3 get_enrollable_clubs
+
+=cut
+
+sub get_enrollable_clubs {
+    my ( $self, $is_enrollable_from_opac, $return_scalar ) = @_;
+
+    my $params;
+    $params->{is_enrollable_from_opac} = $is_enrollable_from_opac
+      if $is_enrollable_from_opac;
+    $params->{is_email_required} = 0 unless $self->first_valid_email_address();
+
+    $params->{borrower} = $self;
+
+    my $e = Koha::Clubs->get_enrollable($params);
+
+    return $e if $return_scalar;
+
+    return wantarray ? $e->as_list : $e;
+}
+
+=head3 account_locked
+
+my $is_locked = $patron->account_locked
+
+Return true if the patron has reached the maximum number of login attempts
+(see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
+as an administrative lockout (independent of FailedLoginAttempts; see also
+Koha::Patron->lock).
+Otherwise return false.
+If the pref is not set (empty string, null or 0), the feature is considered as
+disabled.
+
+=cut
+
+sub account_locked {
+    my ($self) = @_;
+    my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
+    return 1 if $FailedLoginAttempts
+          and $self->login_attempts
+          and $self->login_attempts >= $FailedLoginAttempts;
+    return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
+    return 0;
+}
+
+=head3 can_see_patron_infos
+
+my $can_see = $patron->can_see_patron_infos( $patron );
+
+Return true if the patron (usually the logged in user) can see the patron's infos for a given patron
+
+=cut
+
+sub can_see_patron_infos {
+    my ( $self, $patron ) = @_;
+    return unless $patron;
+    return $self->can_see_patrons_from( $patron->library->branchcode );
+}
+
+=head3 can_see_patrons_from
+
+my $can_see = $patron->can_see_patrons_from( $branchcode );
+
+Return true if the patron (usually the logged in user) can see the patron's infos from a given library
+
+=cut
+
+sub can_see_patrons_from {
+    my ( $self, $branchcode ) = @_;
+    my $can = 0;
+    if ( $self->branchcode eq $branchcode ) {
+        $can = 1;
+    } elsif ( $self->has_permission( { borrowers => 'view_borrower_infos_from_any_libraries' } ) ) {
+        $can = 1;
+    } elsif ( my $library_groups = $self->library->library_groups ) {
+        while ( my $library_group = $library_groups->next ) {
+            if ( $library_group->parent->has_child( $branchcode ) ) {
+                $can = 1;
+                last;
+            }
+        }
+    }
+    return $can;
+}
+
+=head3 libraries_where_can_see_patrons
+
+my $libraries = $patron-libraries_where_can_see_patrons;
+
+Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos.
+The branchcodes are arbitrarily returned sorted.
+We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library)
+
+An empty array means no restriction, the patron can see patron's infos from any libraries.
+
+=cut
+
+sub libraries_where_can_see_patrons {
+    my ( $self ) = @_;
+    my $userenv = C4::Context->userenv;
+
+    return () unless $userenv; # For tests, but userenv should be defined in tests...
+
+    my @restricted_branchcodes;
+    if (C4::Context::only_my_library) {
+        push @restricted_branchcodes, $self->branchcode;
+    }
+    else {
+        unless (
+            $self->has_permission(
+                { borrowers => 'view_borrower_infos_from_any_libraries' }
+            )
+          )
+        {
+            my $library_groups = $self->library->library_groups({ ft_hide_patron_info => 1 });
+            if ( $library_groups->count )
+            {
+                while ( my $library_group = $library_groups->next ) {
+                    my $parent = $library_group->parent;
+                    if ( $parent->has_child( $self->branchcode ) ) {
+                        push @restricted_branchcodes, $parent->children->get_column('branchcode');
+                    }
+                }
+            }
+
+            @restricted_branchcodes = ( $self->branchcode ) unless @restricted_branchcodes;
+        }
+    }
+
+    @restricted_branchcodes = grep { defined $_ } @restricted_branchcodes;
+    @restricted_branchcodes = uniq(@restricted_branchcodes);
+    @restricted_branchcodes = sort(@restricted_branchcodes);
+    return @restricted_branchcodes;
+}
+
+sub has_permission {
+    my ( $self, $flagsrequired ) = @_;
+    return unless $self->userid;
+    # TODO code from haspermission needs to be moved here!
+    return C4::Auth::haspermission( $self->userid, $flagsrequired );
+}
+
+=head3 is_adult
+
+my $is_adult = $patron->is_adult
+
+Return true if the patron has a category with a type Adult (A) or Organization (I)
+
+=cut
+
+sub is_adult {
+    my ( $self ) = @_;
+    return $self->category->category_type =~ /^(A|I)$/ ? 1 : 0;
+}
+
+=head3 is_child
+
+my $is_child = $patron->is_child
+
+Return true if the patron has a category with a type Child (C)
+
+=cut
+
+sub is_child {
+    my( $self ) = @_;
+    return $self->category->category_type eq 'C' ? 1 : 0;
+}
+
+=head3 has_valid_userid
+
+my $patron = Koha::Patrons->find(42);
+$patron->userid( $new_userid );
+my $has_a_valid_userid = $patron->has_valid_userid
+
+my $patron = Koha::Patron->new( $params );
+my $has_a_valid_userid = $patron->has_valid_userid
+
+Return true if the current userid of this patron is valid/unique, otherwise false.
+
+Note that this should be done in $self->store instead and raise an exception if needed.
+
+=cut
+
+sub has_valid_userid {
+    my ($self) = @_;
+
+    return 0 unless $self->userid;
+
+    return 0 if ( $self->userid eq C4::Context->config('user') );    # DB user
+
+    my $already_exists = Koha::Patrons->search(
+        {
+            userid => $self->userid,
+            (
+                $self->in_storage
+                ? ( borrowernumber => { '!=' => $self->borrowernumber } )
+                : ()
+            ),
+        }
+    )->count;
+    return $already_exists ? 0 : 1;
+}
+
+=head3 generate_userid
+
+my $patron = Koha::Patron->new( $params );
+$patron->generate_userid
+
+Generate a userid using the $surname and the $firstname (if there is a value in $firstname).
+
+Set a generated userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $userid is unique, or a higher numeric value if not unique).
+
+=cut
+
+sub generate_userid {
+    my ($self) = @_;
+    my $offset = 0;
+    my $firstname = $self->firstname // q{};
+    my $surname = $self->surname // q{};
+    #The script will "do" the following code and increment the $offset until the generated userid is unique
+    do {
+      $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
+      $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
+      my $userid = lc(($firstname)? "$firstname.$surname" : $surname);
+      $userid = unac_string('utf-8',$userid);
+      $userid .= $offset unless $offset == 0;
+      $self->userid( $userid );
+      $offset++;
+     } while (! $self->has_valid_userid );
+
+     return $self;
+
+}
+
+=head3 attributes
+
+my $attributes = $patron->attributes
+
+Return object of Koha::Patron::Attributes type with all attributes set for this patron
+
+=cut
+
+sub attributes {
+    my ( $self ) = @_;
+    return Koha::Patron::Attributes->search({
+        borrowernumber => $self->borrowernumber,
+        branchcode     => $self->branchcode,
+    });
+}
+
+=head2 Internal methods
+
+=head3 _type
 
 =cut
 
@@ -591,10 +1324,11 @@ sub _type {
     return 'Borrower';
 }
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Kyle M Hall <kyle@bywatersolutions.com>
 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
+Martin Renvoize <martin.renvoize@ptfs-europe.com>
 
 =cut