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