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             logaction( "MEMBERS", "DELETE", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
  87             $deleted = $self->SUPER::delete;
  88         }
  89     );
  90     return $deleted;
  91 }
  92
  93 =head3 guarantor
  94
  95 Returns a Koha::Patron object for this patron's guarantor
  96
  97 =cut
  98
  99 sub guarantor {
 100     my ( $self ) = @_;
 101
 102     return unless $self->guarantorid();
 103
 104     return Koha::Patrons->find( $self->guarantorid() );
 105 }
 106
 107 sub image {
 108     my ( $self ) = @_;
 109
 110     return Koha::Patron::Images->find( $self->borrowernumber )
 111 }
 112
 113 =head3 guarantees
 114
 115 Returns the guarantees (list of Koha::Patron) of this patron
 116
 117 =cut
 118
 119 sub guarantees {
 120     my ( $self ) = @_;
 121
 122     return Koha::Patrons->search( { guarantorid => $self->borrowernumber } );
 123 }
 124
 125 =head3 siblings
 126
 127 Returns the siblings of this patron.
 128
 129 =cut
 130
 131 sub siblings {
 132     my ( $self ) = @_;
 133
 134     my $guarantor = $self->guarantor;
 135
 136     return unless $guarantor;
 137
 138     return Koha::Patrons->search(
 139         {
 140             guarantorid => {
 141                 '!=' => undef,
 142                 '=' => $guarantor->id,
 143             },
 144             borrowernumber => {
 145                 '!=' => $self->borrowernumber,
 146             }
 147         }
 148     );
 149 }
 150
 151 =head3 wants_check_for_previous_checkout
 152
 153     $wants_check = $patron->wants_check_for_previous_checkout;
 154
 155 Return 1 if Koha needs to perform PrevIssue checking, else 0.
 156
 157 =cut
 158
 159 sub wants_check_for_previous_checkout {
 160     my ( $self ) = @_;
 161     my $syspref = C4::Context->preference("checkPrevCheckout");
 162
 163     # Simple cases
 164     ## Hard syspref trumps all
 165     return 1 if ($syspref eq 'hardyes');
 166     return 0 if ($syspref eq 'hardno');
 167     ## Now, patron pref trumps all
 168     return 1 if ($self->checkprevcheckout eq 'yes');
 169     return 0 if ($self->checkprevcheckout eq 'no');
 170
 171     # More complex: patron inherits -> determine category preference
 172     my $checkPrevCheckoutByCat = Koha::Patron::Categories
 173         ->find($self->categorycode)->checkprevcheckout;
 174     return 1 if ($checkPrevCheckoutByCat eq 'yes');
 175     return 0 if ($checkPrevCheckoutByCat eq 'no');
 176
 177     # Finally: category preference is inherit, default to 0
 178     if ($syspref eq 'softyes') {
 179         return 1;
 180     } else {
 181         return 0;
 182     }
 183 }
 184
 185 =head3 do_check_for_previous_checkout
 186
 187     $do_check = $patron->do_check_for_previous_checkout($item);
 188
 189 Return 1 if the bib associated with $ITEM has previously been checked out to
 190 $PATRON, 0 otherwise.
 191
 192 =cut
 193
 194 sub do_check_for_previous_checkout {
 195     my ( $self, $item ) = @_;
 196
 197     # Find all items for bib and extract item numbers.
 198     my @items = Koha::Items->search({biblionumber => $item->{biblionumber}});
 199     my @item_nos;
 200     foreach my $item (@items) {
 201         push @item_nos, $item->itemnumber;
 202     }
 203
 204     # Create (old)issues search criteria
 205     my $criteria = {
 206         borrowernumber => $self->borrowernumber,
 207         itemnumber => \@item_nos,
 208     };
 209
 210     # Check current issues table
 211     my $issues = Koha::Issues->search($criteria);
 212     return 1 if $issues->count; # 0 || N
 213
 214     # Check old issues table
 215     my $old_issues = Koha::OldIssues->search($criteria);
 216     return $old_issues->count;  # 0 || N
 217 }
 218
 219 =head2 is_debarred
 220
 221 my $debarment_expiration = $patron->is_debarred;
 222
 223 Returns the date a patron debarment will expire, or undef if the patron is not
 224 debarred
 225
 226 =cut
 227
 228 sub is_debarred {
 229     my ($self) = @_;
 230
 231     return unless $self->debarred;
 232     return $self->debarred
 233       if $self->debarred =~ '^9999'
 234       or dt_from_string( $self->debarred ) > dt_from_string;
 235     return;
 236 }
 237
 238 =head2 update_password
 239
 240 my $updated = $patron->update_password( $userid, $password );
 241
 242 Update the userid and the password of a patron.
 243 If the userid already exists, returns and let DBIx::Class warns
 244 This will add an entry to action_logs if BorrowersLog is set.
 245
 246 =cut
 247
 248 sub update_password {
 249     my ( $self, $userid, $password ) = @_;
 250     eval { $self->userid($userid)->store; };
 251     return if $@; # Make sure the userid is not already in used by another patron
 252     $self->password($password)->store;
 253     logaction( "MEMBERS", "CHANGE PASS", $self->borrowernumber, "" ) if C4::Context->preference("BorrowersLog");
 254     return 1;
 255 }
 256
 257 =head3 renew_account
 258
 259 my $new_expiry_date = $patron->renew_account
 260
 261 Extending the subscription to the expiry date.
 262
 263 =cut
 264
 265 sub renew_account {
 266     my ($self) = @_;
 267
 268     my $date =
 269       C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry'
 270       ? dt_from_string( $self->dateexpiry )
 271       : dt_from_string;
 272     my $patron_category = Koha::Patron::Categories->find( $self->categorycode );    # FIXME Should be $self->category
 273     my $expiry_date     = $patron_category->get_expiry_date($date);
 274
 275     $self->dateexpiry($expiry_date)->store;
 276
 277     C4::Members::AddEnrolmentFeeIfNeeded( $self->categorycode, $self->borrowernumber );
 278
 279     logaction( "MEMBERS", "RENEW", $self->borrowernumber, "Membership renewed" ) if C4::Context->preference("BorrowersLog");
 280     return dt_from_string( $expiry_date )->truncate( to => 'day' );
 281 }
 282
 283 =head2 has_overdues
 284
 285 my $has_overdues = $patron->has_overdues;
 286
 287 Returns the number of patron's overdues
 288
 289 =cut
 290
 291 sub has_overdues {
 292     my ($self) = @_;
 293     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
 294     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime( dt_from_string() ) } })->count;
 295 }
 296
 297 =head2 track_login
 298
 299     $patron->track_login;
 300     $patron->track_login({ force => 1 });
 301
 302     Tracks a (successful) login attempt.
 303     The preference TrackLastPatronActivity must be enabled. Or you
 304     should pass the force parameter.
 305
 306 =cut
 307
 308 sub track_login {
 309     my ( $self, $params ) = @_;
 310     return if
 311         !$params->{force} &&
 312         !C4::Context->preference('TrackLastPatronActivity');
 313     $self->lastseen( dt_from_string() )->store;
 314 }
 315
 316 =head2 move_to_deleted
 317
 318 my $is_moved = $patron->move_to_deleted;
 319
 320 Move a patron to the deletedborrowers table.
 321 This can be done before deleting a patron, to make sure the data are not completely deleted.
 322
 323 =cut
 324
 325 sub move_to_deleted {
 326     my ($self) = @_;
 327     my $patron_infos = $self->unblessed;
 328     return Koha::Database->new->schema->resultset('Deletedborrower')->create($patron_infos);
 329 }
 330
 331 =head3 type
 332
 333 =cut
 334
 335 sub _type {
 336     return 'Borrower';
 337 }
 338
 339 =head1 AUTHOR
 340
 341 Kyle M Hall <kyle@bywatersolutions.com>
 342 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
 343
 344 =cut
 345
 346 1;