Koha/Patron.pm

   1 package Koha::Patron;
   2
   3 # Copyright ByWater Solutions 2014
   4 # Copyright PTFS Europe 2016
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 3 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use Modern::Perl;
  22
  23 use Carp;
  24
  25 use C4::Context;
  26 use C4::Log;
  27 use Koha::Database;
  28 use Koha::DateUtils;
  29 use Koha::Holds;
  30 use Koha::Issues;
  31 use Koha::OldIssues;
  32 use Koha::Patron::Categories;
  33 use Koha::Patron::Images;
  34 use Koha::Patrons;
  35 use Koha::Virtualshelves;
  36
  37 use base qw(Koha::Object);
  38
  39 =head1 NAME
  40
  41 Koha::Patron - Koha Patron Object class
  42
  43 =head1 API
  44
  45 =head2 Class Methods
  46
  47 =cut
  48
  49 =head3 delete
  50
  51 $patron->delete
  52
  53 Delete patron's holds, lists and finally the patron.
  54
  55 Lists owned by the borrower are deleted, but entries from the borrower to
  56 other lists are kept.
  57
  58 =cut
  59
  60 sub delete {
  61     my ($self) = @_;
  62
  63     my $deleted;
  64     $self->_result->result_source->schema->txn_do(
  65         sub {
  66             # Delete Patron's holds
  67             # FIXME Should be $patron->get_holds
  68             $_->delete for Koha::Holds->search( { borrowernumber => $self->borrowernumber } );
  69
  70             # Delete all lists and all shares of this borrower
  71             # Consistent with the approach Koha uses on deleting individual lists
  72             # Note that entries in virtualshelfcontents added by this borrower to
  73             # lists of others will be handled by a table constraint: the borrower
  74             # is set to NULL in those entries.
  75             # NOTE:
  76             # We could handle the above deletes via a constraint too.
  77             # But a new BZ report 11889 has been opened to discuss another approach.
  78             # Instead of deleting we could also disown lists (based on a pref).
  79             # In that way we could save shared and public lists.
  80             # The current table constraints support that idea now.
  81             # This pref should then govern the results of other routines/methods such as
  82             # Koha::Virtualshelf->new->delete too.
  83             # FIXME Could be $patron->get_lists
  84             $_->delete for Koha::Virtualshelves->search( { owner => $self->borrowernumber } );
  85
  86             $deleted = $self->SUPER::delete;
  87
  88             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
  89         }
  90     );
  91     return $deleted;
  92 }
  93
  94 =head3 guarantor
  95
  96 Returns a Koha::Patron object for this patron's guarantor
  97
  98 =cut
  99
 100 sub guarantor {
 101     my ( $self ) = @_;
 102
 103     return unless $self->guarantorid();
 104
 105     return Koha::Patrons->find( $self->guarantorid() );
 106 }
 107
 108 sub image {
 109     my ( $self ) = @_;
 110
 111     return Koha::Patron::Images->find( $self->borrowernumber )
 112 }
 113
 114 =head3 guarantees
 115
 116 Returns the guarantees (list of Koha::Patron) of this patron
 117
 118 =cut
 119
 120 sub guarantees {
 121     my ( $self ) = @_;
 122
 123     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
 124 }
 125
 126 =head3 siblings
 127
 128 Returns the siblings of this patron.
 129
 130 =cut
 131
 132 sub siblings {
 133     my ( $self ) = @_;
 134
 135     my $guarantor = $self->guarantor;
 136
 137     return unless $guarantor;
 138
 139     return Koha::Patrons->search(
 140         {
 141             guarantorid => {
 142                 '!=' => undef,
 143                 '=' => $guarantor->id,
 144             },
 145             borrowernumber => {
 146                 '!=' => $self->borrowernumber,
 147             }
 148         }
 149     );
 150 }
 151
 152 =head3 wants_check_for_previous_checkout
 153
 154     $wants_check = $patron->wants_check_for_previous_checkout;
 155
 156 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 157
 158 =cut
 159
 160 sub wants_check_for_previous_checkout {
 161     my ( $self ) = @_;
 162     my $syspref = C4::Context->preference("checkPrevCheckout");
 163
 164     # Simple cases
 165     ## Hard syspref trumps all
 166     return 1 if ($syspref eq 'hardyes');
 167     return 0 if ($syspref eq 'hardno');
 168     ## Now, patron pref trumps all
 169     return 1 if ($self->checkprevcheckout eq 'yes');
 170     return 0 if ($self->checkprevcheckout eq 'no');
 171
 172     # More complex: patron inherits -> determine category preference
 173     my $checkPrevCheckoutByCat = Koha::Patron::Categories
 174         ->find($self->categorycode)->checkprevcheckout;
 175     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 176     return 0 if ($checkPrevCheckoutByCat eq 'no');
 177
 178     # Finally: category preference is inherit, default to 0
 179     if ($syspref eq 'softyes') {
 180         return 1;
 181     } else {
 182         return 0;
 183     }
 184 }
 185
 186 =head3 do_check_for_previous_checkout
 187
 188     $do_check = $patron->do_check_for_previous_checkout($item);
 189
 190 Return 1 if the bib associated with $ITEM has previously been checked out to
 191 $PATRON, 0 otherwise.
 192
 193 =cut
 194
 195 sub do_check_for_previous_checkout {
 196     my ( $self, $item ) = @_;
 197
 198     # Find all items for bib and extract item numbers.
 199     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 200     my @item_nos;
 201     foreach my $item (@items) {
 202         push @item_nos, $item->itemnumber;
 203     }
 204
 205     # Create (old)issues search criteria
 206     my $criteria = {
 207         borrowernumber => $self->borrowernumber,
 208         itemnumber => \@item_nos,
 209     };
 210
 211     # Check current issues table
 212     my $issues = Koha::Issues->search($criteria);
 213     return 1 if $issues->count; # 0 || N
 214
 215     # Check old issues table
 216     my $old_issues = Koha::OldIssues->search($criteria);
 217     return $old_issues->count;  # 0 || N
 218 }
 219
 220 =head2 is_debarred
 221
 222 my $debarment_expiration = $patron->is_debarred;
 223
 224 Returns the date a patron debarment will expire, or undef if the patron is not
 225 debarred
 226
 227 =cut
 228
 229 sub is_debarred {
 230     my ($self) = @_;
 231
 232     return unless $self->debarred;
 233     return $self->debarred
 234       if $self->debarred =~ '^9999'
 235       or dt_from_string( $self->debarred ) > dt_from_string;
 236     return;
 237 }
 238
 239 =head2 update_password
 240
 241 my $updated = $patron->update_password( $userid, $password );
 242
 243 Update the userid and the password of a patron.
 244 If the userid already exists, returns and let DBIx::Class warns
 245 This will add an entry to action_logs if BorrowersLog is set.
 246
 247 =cut
 248
 249 sub update_password {
 250     my ( $self, $userid, $password ) = @_;
 251     eval { $self->userid($userid)->store; };
 252     return if $@; # Make sure the userid is not already in used by another patron
 253     $self->password($password)->store;
 254     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 255     return 1;
 256 }
 257
 258 =head3 renew_account
 259
 260 my $new_expiry_date = $patron->renew_account
 261
 262 Extending the subscription to the expiry date.
 263
 264 =cut
 265
 266 sub renew_account {
 267     my ($self) = @_;
 268
 269     my $date =
 270       C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 271       ? dt_from_string( $self->dateexpiry )
 272       : dt_from_string;
 273     my $patron_category = Koha::Patron::Categories->find( $self->categorycode );    # FIXME Should be $self->category
 274     my $expiry_date     = $patron_category->get_expiry_date($date);
 275
 276     $self->dateexpiry($expiry_date)->store;
 277
 278     C4::Members::AddEnrolmentFeeIfNeeded( $self->categorycode, $self->borrowernumber );
 279
 280     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 281     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 282 }
 283
 284 =head2 has_overdues
 285
 286 my $has_overdues = $patron->has_overdues;
 287
 288 Returns the number of patron's overdues
 289
 290 =cut
 291
 292 sub has_overdues {
 293     my ($self) = @_;
 294     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 295     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 296 }
 297
 298 =head2 track_login
 299
 300     $patron->track_login;
 301     $patron->track_login({ force => 1 });
 302
 303     Tracks a (successful) login attempt.
 304     The preference TrackLastPatronActivity must be enabled. Or you
 305     should pass the force parameter.
 306
 307 =cut
 308
 309 sub track_login {
 310     my ( $self, $params ) = @_;
 311     return if
 312         !$params->{force} &&
 313         !C4::Context->preference('TrackLastPatronActivity');
 314     $self->lastseen( dt_from_string() )->store;
 315 }
 316
 317 =head2 move_to_deleted
 318
 319 my $is_moved = $patron->move_to_deleted;
 320
 321 Move a patron to the deletedborrowers table.
 322 This can be done before deleting a patron, to make sure the data are not completely deleted.
 323
 324 =cut
 325
 326 sub move_to_deleted {
 327     my ($self) = @_;
 328     my $patron_infos = $self->unblessed;
 329     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 330 }
 331
 332 =head3 type
 333
 334 =cut
 335
 336 sub _type {
 337     return 'Borrower';
 338 }
 339
 340 =head1 AUTHOR
 341
 342 Kyle M Hall <kyle@bywatersolutions.com>
 343 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 344
 345 =cut
 346
 347 1;