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