| Filename | /home/vagrant/kohaclone/C4/Members.pm |
| Statements | Executed 0 statements in 213µs |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package C4::Members; | ||||
| 2 | |||||
| 3 | # Copyright 2000-2003 Katipo Communications | ||||
| 4 | # Copyright 2010 BibLibre | ||||
| 5 | # Parts Copyright 2010 Catalyst IT | ||||
| 6 | # | ||||
| 7 | # This file is part of Koha. | ||||
| 8 | # | ||||
| 9 | # Koha is free software; you can redistribute it and/or modify it | ||||
| 10 | # under the terms of the GNU General Public License as published by | ||||
| 11 | # the Free Software Foundation; either version 3 of the License, or | ||||
| 12 | # (at your option) any later version. | ||||
| 13 | # | ||||
| 14 | # Koha is distributed in the hope that it will be useful, but | ||||
| 15 | # WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| 16 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
| 17 | # GNU General Public License for more details. | ||||
| 18 | # | ||||
| 19 | # You should have received a copy of the GNU General Public License | ||||
| 20 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | ||||
| 21 | |||||
| 22 | |||||
| 23 | use strict; | ||||
| 24 | #use warnings; FIXME - Bug 2505 | ||||
| 25 | use C4::Context; | ||||
| 26 | use String::Random qw( random_string ); | ||||
| 27 | use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/; | ||||
| 28 | use C4::Log; # logaction | ||||
| 29 | use C4::Overdues; | ||||
| 30 | use C4::Reserves; | ||||
| 31 | use C4::Accounts; | ||||
| 32 | use C4::Biblio; | ||||
| 33 | use C4::Letters; | ||||
| 34 | use C4::Members::Attributes qw(SearchIdMatchingAttribute UpdateBorrowerAttribute); | ||||
| 35 | use C4::NewsChannels; #get slip news | ||||
| 36 | use DateTime; | ||||
| 37 | use Koha::Database; | ||||
| 38 | use Koha::DateUtils; | ||||
| 39 | use Koha::Borrower::Debarments qw(IsDebarred); | ||||
| 40 | use Text::Unaccent qw( unac_string ); | ||||
| 41 | use Koha::AuthUtils qw(hash_password); | ||||
| 42 | use Koha::Database; | ||||
| 43 | |||||
| 44 | use Module::Load::Conditional qw( can_load ); | ||||
| 45 | if ( ! can_load( modules => { 'Koha::NorwegianPatronDB' => undef } ) ) { | ||||
| 46 | warn "Unable to load Koha::NorwegianPatronDB"; | ||||
| 47 | } | ||||
| 48 | |||||
| 49 | our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug); | ||||
| 50 | |||||
| 51 | BEGIN { | ||||
| 52 | $VERSION = 3.07.00.049; | ||||
| 53 | $debug = $ENV{DEBUG} || 0; | ||||
| 54 | require Exporter; | ||||
| 55 | @ISA = qw(Exporter); | ||||
| 56 | #Get data | ||||
| 57 | push @EXPORT, qw( | ||||
| 58 | &Search | ||||
| 59 | &GetMemberDetails | ||||
| 60 | &GetMemberRelatives | ||||
| 61 | &GetMember | ||||
| 62 | |||||
| 63 | &GetGuarantees | ||||
| 64 | |||||
| 65 | &GetMemberIssuesAndFines | ||||
| 66 | &GetPendingIssues | ||||
| 67 | &GetAllIssues | ||||
| 68 | |||||
| 69 | &getzipnamecity | ||||
| 70 | &getidcity | ||||
| 71 | |||||
| 72 | &GetFirstValidEmailAddress | ||||
| 73 | &GetNoticeEmailAddress | ||||
| 74 | |||||
| 75 | &GetAge | ||||
| 76 | &GetCities | ||||
| 77 | &GetSortDetails | ||||
| 78 | &GetTitles | ||||
| 79 | |||||
| 80 | &GetPatronImage | ||||
| 81 | &PutPatronImage | ||||
| 82 | &RmPatronImage | ||||
| 83 | |||||
| 84 | &GetHideLostItemsPreference | ||||
| 85 | |||||
| 86 | &IsMemberBlocked | ||||
| 87 | &GetMemberAccountRecords | ||||
| 88 | &GetBorNotifyAcctRecord | ||||
| 89 | |||||
| 90 | &GetborCatFromCatType | ||||
| 91 | &GetBorrowercategory | ||||
| 92 | GetBorrowerCategorycode | ||||
| 93 | &GetBorrowercategoryList | ||||
| 94 | |||||
| 95 | &GetBorrowersToExpunge | ||||
| 96 | &GetBorrowersWhoHaveNeverBorrowed | ||||
| 97 | &GetBorrowersWithIssuesHistoryOlderThan | ||||
| 98 | |||||
| 99 | &GetExpiryDate | ||||
| 100 | &GetUpcomingMembershipExpires | ||||
| 101 | |||||
| 102 | &AddMessage | ||||
| 103 | &DeleteMessage | ||||
| 104 | &GetMessages | ||||
| 105 | &GetMessagesCount | ||||
| 106 | |||||
| 107 | &IssueSlip | ||||
| 108 | GetBorrowersWithEmail | ||||
| 109 | |||||
| 110 | HasOverdues | ||||
| 111 | GetOverduesForPatron | ||||
| 112 | ); | ||||
| 113 | |||||
| 114 | #Modify data | ||||
| 115 | push @EXPORT, qw( | ||||
| 116 | &ModMember | ||||
| 117 | &changepassword | ||||
| 118 | ); | ||||
| 119 | |||||
| 120 | #Delete data | ||||
| 121 | push @EXPORT, qw( | ||||
| 122 | &DelMember | ||||
| 123 | ); | ||||
| 124 | |||||
| 125 | #Insert data | ||||
| 126 | push @EXPORT, qw( | ||||
| 127 | &AddMember | ||||
| 128 | &AddMember_Opac | ||||
| 129 | &MoveMemberToDeleted | ||||
| 130 | &ExtendMemberSubscriptionTo | ||||
| 131 | ); | ||||
| 132 | |||||
| 133 | #Check data | ||||
| 134 | push @EXPORT, qw( | ||||
| 135 | &checkuniquemember | ||||
| 136 | &checkuserpassword | ||||
| 137 | &Check_Userid | ||||
| 138 | &Generate_Userid | ||||
| 139 | &fixup_cardnumber | ||||
| 140 | &checkcardnumber | ||||
| 141 | ); | ||||
| 142 | } | ||||
| 143 | |||||
| 144 | =head1 NAME | ||||
| 145 | |||||
| 146 | C4::Members - Perl Module containing convenience functions for member handling | ||||
| 147 | |||||
| 148 | =head1 SYNOPSIS | ||||
| 149 | |||||
| 150 | use C4::Members; | ||||
| 151 | |||||
| 152 | =head1 DESCRIPTION | ||||
| 153 | |||||
| 154 | This module contains routines for adding, modifying and deleting members/patrons/borrowers | ||||
| 155 | |||||
| 156 | =head1 FUNCTIONS | ||||
| 157 | |||||
| 158 | =head2 GetMemberDetails | ||||
| 159 | |||||
| 160 | ($borrower) = &GetMemberDetails($borrowernumber, $cardnumber); | ||||
| 161 | |||||
| 162 | Looks up a patron and returns information about him or her. If | ||||
| 163 | C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks | ||||
| 164 | up the borrower by number; otherwise, it looks up the borrower by card | ||||
| 165 | number. | ||||
| 166 | |||||
| 167 | C<$borrower> is a reference-to-hash whose keys are the fields of the | ||||
| 168 | borrowers table in the Koha database. In addition, | ||||
| 169 | C<$borrower-E<gt>{flags}> is a hash giving more detailed information | ||||
| 170 | about the patron. Its keys act as flags : | ||||
| 171 | |||||
| 172 | if $borrower->{flags}->{LOST} { | ||||
| 173 | # Patron's card was reported lost | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | If the state of a flag means that the patron should not be | ||||
| 177 | allowed to borrow any more books, then it will have a C<noissues> key | ||||
| 178 | with a true value. | ||||
| 179 | |||||
| 180 | See patronflags for more details. | ||||
| 181 | |||||
| 182 | C<$borrower-E<gt>{authflags}> is a hash giving more detailed information | ||||
| 183 | about the top-level permissions flags set for the borrower. For example, | ||||
| 184 | if a user has the "editcatalogue" permission, | ||||
| 185 | C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have | ||||
| 186 | the value "1". | ||||
| 187 | |||||
| 188 | =cut | ||||
| 189 | |||||
| 190 | sub GetMemberDetails { | ||||
| 191 | my ( $borrowernumber, $cardnumber ) = @_; | ||||
| 192 | my $dbh = C4::Context->dbh; | ||||
| 193 | my $query; | ||||
| 194 | my $sth; | ||||
| 195 | if ($borrowernumber) { | ||||
| 196 | $sth = $dbh->prepare(" | ||||
| 197 | SELECT borrowers.*, | ||||
| 198 | category_type, | ||||
| 199 | categories.description, | ||||
| 200 | categories.BlockExpiredPatronOpacActions, | ||||
| 201 | reservefee, | ||||
| 202 | enrolmentperiod | ||||
| 203 | FROM borrowers | ||||
| 204 | LEFT JOIN categories ON borrowers.categorycode=categories.categorycode | ||||
| 205 | WHERE borrowernumber = ? | ||||
| 206 | "); | ||||
| 207 | $sth->execute($borrowernumber); | ||||
| 208 | } | ||||
| 209 | elsif ($cardnumber) { | ||||
| 210 | $sth = $dbh->prepare(" | ||||
| 211 | SELECT borrowers.*, | ||||
| 212 | category_type, | ||||
| 213 | categories.description, | ||||
| 214 | categories.BlockExpiredPatronOpacActions, | ||||
| 215 | reservefee, | ||||
| 216 | enrolmentperiod | ||||
| 217 | FROM borrowers | ||||
| 218 | LEFT JOIN categories ON borrowers.categorycode = categories.categorycode | ||||
| 219 | WHERE cardnumber = ? | ||||
| 220 | "); | ||||
| 221 | $sth->execute($cardnumber); | ||||
| 222 | } | ||||
| 223 | else { | ||||
| 224 | return; | ||||
| 225 | } | ||||
| 226 | my $borrower = $sth->fetchrow_hashref; | ||||
| 227 | return unless $borrower; | ||||
| 228 | my ($amount) = GetMemberAccountRecords($borrower->{borrowernumber}); | ||||
| 229 | $borrower->{'amountoutstanding'} = $amount; | ||||
| 230 | # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount | ||||
| 231 | my $flags = patronflags( $borrower); | ||||
| 232 | my $accessflagshash; | ||||
| 233 | |||||
| 234 | $sth = $dbh->prepare("select bit,flag from userflags"); | ||||
| 235 | $sth->execute; | ||||
| 236 | while ( my ( $bit, $flag ) = $sth->fetchrow ) { | ||||
| 237 | if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) { | ||||
| 238 | $accessflagshash->{$flag} = 1; | ||||
| 239 | } | ||||
| 240 | } | ||||
| 241 | $borrower->{'flags'} = $flags; | ||||
| 242 | $borrower->{'authflags'} = $accessflagshash; | ||||
| 243 | |||||
| 244 | # Handle setting the true behavior for BlockExpiredPatronOpacActions | ||||
| 245 | $borrower->{'BlockExpiredPatronOpacActions'} = | ||||
| 246 | C4::Context->preference('BlockExpiredPatronOpacActions') | ||||
| 247 | if ( $borrower->{'BlockExpiredPatronOpacActions'} == -1 ); | ||||
| 248 | |||||
| 249 | $borrower->{'is_expired'} = 0; | ||||
| 250 | $borrower->{'is_expired'} = 1 if | ||||
| 251 | defined($borrower->{dateexpiry}) && | ||||
| 252 | $borrower->{'dateexpiry'} ne '0000-00-00' && | ||||
| 253 | Date_to_Days( Today() ) > | ||||
| 254 | Date_to_Days( split /-/, $borrower->{'dateexpiry'} ); | ||||
| 255 | |||||
| 256 | return ($borrower); #, $flags, $accessflagshash); | ||||
| 257 | } | ||||
| 258 | |||||
| 259 | =head2 patronflags | ||||
| 260 | |||||
| 261 | $flags = &patronflags($patron); | ||||
| 262 | |||||
| 263 | This function is not exported. | ||||
| 264 | |||||
| 265 | The following will be set where applicable: | ||||
| 266 | $flags->{CHARGES}->{amount} Amount of debt | ||||
| 267 | $flags->{CHARGES}->{noissues} Set if debt amount >$5.00 (or syspref noissuescharge) | ||||
| 268 | $flags->{CHARGES}->{message} Message -- deprecated | ||||
| 269 | |||||
| 270 | $flags->{CREDITS}->{amount} Amount of credit | ||||
| 271 | $flags->{CREDITS}->{message} Message -- deprecated | ||||
| 272 | |||||
| 273 | $flags->{ GNA } Patron has no valid address | ||||
| 274 | $flags->{ GNA }->{noissues} Set for each GNA | ||||
| 275 | $flags->{ GNA }->{message} "Borrower has no valid address" -- deprecated | ||||
| 276 | |||||
| 277 | $flags->{ LOST } Patron's card reported lost | ||||
| 278 | $flags->{ LOST }->{noissues} Set for each LOST | ||||
| 279 | $flags->{ LOST }->{message} Message -- deprecated | ||||
| 280 | |||||
| 281 | $flags->{DBARRED} Set if patron debarred, no access | ||||
| 282 | $flags->{DBARRED}->{noissues} Set for each DBARRED | ||||
| 283 | $flags->{DBARRED}->{message} Message -- deprecated | ||||
| 284 | |||||
| 285 | $flags->{ NOTES } | ||||
| 286 | $flags->{ NOTES }->{message} The note itself. NOT deprecated | ||||
| 287 | |||||
| 288 | $flags->{ ODUES } Set if patron has overdue books. | ||||
| 289 | $flags->{ ODUES }->{message} "Yes" -- deprecated | ||||
| 290 | $flags->{ ODUES }->{itemlist} ref-to-array: list of overdue books | ||||
| 291 | $flags->{ ODUES }->{itemlisttext} Text list of overdue items -- deprecated | ||||
| 292 | |||||
| 293 | $flags->{WAITING} Set if any of patron's reserves are available | ||||
| 294 | $flags->{WAITING}->{message} Message -- deprecated | ||||
| 295 | $flags->{WAITING}->{itemlist} ref-to-array: list of available items | ||||
| 296 | |||||
| 297 | =over | ||||
| 298 | |||||
| 299 | =item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the | ||||
| 300 | overdue items. Its elements are references-to-hash, each describing an | ||||
| 301 | overdue item. The keys are selected fields from the issues, biblio, | ||||
| 302 | biblioitems, and items tables of the Koha database. | ||||
| 303 | |||||
| 304 | =item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of | ||||
| 305 | the overdue items, one per line. Deprecated. | ||||
| 306 | |||||
| 307 | =item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the | ||||
| 308 | available items. Each element is a reference-to-hash whose keys are | ||||
| 309 | fields from the reserves table of the Koha database. | ||||
| 310 | |||||
| 311 | =back | ||||
| 312 | |||||
| 313 | All the "message" fields that include language generated in this function are deprecated, | ||||
| 314 | because such strings belong properly in the display layer. | ||||
| 315 | |||||
| 316 | The "message" field that comes from the DB is OK. | ||||
| 317 | |||||
| 318 | =cut | ||||
| 319 | |||||
| 320 | # TODO: use {anonymous => hashes} instead of a dozen %flaginfo | ||||
| 321 | # FIXME rename this function. | ||||
| 322 | sub patronflags { | ||||
| 323 | my %flags; | ||||
| 324 | my ( $patroninformation) = @_; | ||||
| 325 | my $dbh=C4::Context->dbh; | ||||
| 326 | my ($balance, $owing) = GetMemberAccountBalance( $patroninformation->{'borrowernumber'}); | ||||
| 327 | if ( $owing > 0 ) { | ||||
| 328 | my %flaginfo; | ||||
| 329 | my $noissuescharge = C4::Context->preference("noissuescharge") || 5; | ||||
| 330 | $flaginfo{'message'} = sprintf 'Patron owes %.02f', $owing; | ||||
| 331 | $flaginfo{'amount'} = sprintf "%.02f", $owing; | ||||
| 332 | if ( $owing > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) { | ||||
| 333 | $flaginfo{'noissues'} = 1; | ||||
| 334 | } | ||||
| 335 | $flags{'CHARGES'} = \%flaginfo; | ||||
| 336 | } | ||||
| 337 | elsif ( $balance < 0 ) { | ||||
| 338 | my %flaginfo; | ||||
| 339 | $flaginfo{'message'} = sprintf 'Patron has credit of %.02f', -$balance; | ||||
| 340 | $flaginfo{'amount'} = sprintf "%.02f", $balance; | ||||
| 341 | $flags{'CREDITS'} = \%flaginfo; | ||||
| 342 | } | ||||
| 343 | if ( $patroninformation->{'gonenoaddress'} | ||||
| 344 | && $patroninformation->{'gonenoaddress'} == 1 ) | ||||
| 345 | { | ||||
| 346 | my %flaginfo; | ||||
| 347 | $flaginfo{'message'} = 'Borrower has no valid address.'; | ||||
| 348 | $flaginfo{'noissues'} = 1; | ||||
| 349 | $flags{'GNA'} = \%flaginfo; | ||||
| 350 | } | ||||
| 351 | if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) { | ||||
| 352 | my %flaginfo; | ||||
| 353 | $flaginfo{'message'} = 'Borrower\'s card reported lost.'; | ||||
| 354 | $flaginfo{'noissues'} = 1; | ||||
| 355 | $flags{'LOST'} = \%flaginfo; | ||||
| 356 | } | ||||
| 357 | if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) { | ||||
| 358 | if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) { | ||||
| 359 | my %flaginfo; | ||||
| 360 | $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'}; | ||||
| 361 | $flaginfo{'message'} = $patroninformation->{'debarredcomment'}; | ||||
| 362 | $flaginfo{'noissues'} = 1; | ||||
| 363 | $flaginfo{'dateend'} = $patroninformation->{'debarred'}; | ||||
| 364 | $flags{'DBARRED'} = \%flaginfo; | ||||
| 365 | } | ||||
| 366 | } | ||||
| 367 | if ( $patroninformation->{'borrowernotes'} | ||||
| 368 | && $patroninformation->{'borrowernotes'} ) | ||||
| 369 | { | ||||
| 370 | my %flaginfo; | ||||
| 371 | $flaginfo{'message'} = $patroninformation->{'borrowernotes'}; | ||||
| 372 | $flags{'NOTES'} = \%flaginfo; | ||||
| 373 | } | ||||
| 374 | my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'}); | ||||
| 375 | if ( $odues && $odues > 0 ) { | ||||
| 376 | my %flaginfo; | ||||
| 377 | $flaginfo{'message'} = "Yes"; | ||||
| 378 | $flaginfo{'itemlist'} = $itemsoverdue; | ||||
| 379 | foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} } | ||||
| 380 | @$itemsoverdue ) | ||||
| 381 | { | ||||
| 382 | $flaginfo{'itemlisttext'} .= | ||||
| 383 | "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer | ||||
| 384 | } | ||||
| 385 | $flags{'ODUES'} = \%flaginfo; | ||||
| 386 | } | ||||
| 387 | my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' ); | ||||
| 388 | my $nowaiting = scalar @itemswaiting; | ||||
| 389 | if ( $nowaiting > 0 ) { | ||||
| 390 | my %flaginfo; | ||||
| 391 | $flaginfo{'message'} = "Reserved items available"; | ||||
| 392 | $flaginfo{'itemlist'} = \@itemswaiting; | ||||
| 393 | $flags{'WAITING'} = \%flaginfo; | ||||
| 394 | } | ||||
| 395 | return ( \%flags ); | ||||
| 396 | } | ||||
| 397 | |||||
| 398 | |||||
| 399 | =head2 GetMember | ||||
| 400 | |||||
| 401 | $borrower = &GetMember(%information); | ||||
| 402 | |||||
| 403 | Retrieve the first patron record meeting on criteria listed in the | ||||
| 404 | C<%information> hash, which should contain one or more | ||||
| 405 | pairs of borrowers column names and values, e.g., | ||||
| 406 | |||||
| 407 | $borrower = GetMember(borrowernumber => id); | ||||
| 408 | |||||
| 409 | C<&GetBorrower> returns a reference-to-hash whose keys are the fields of | ||||
| 410 | the C<borrowers> table in the Koha database. | ||||
| 411 | |||||
| 412 | FIXME: GetMember() is used throughout the code as a lookup | ||||
| 413 | on a unique key such as the borrowernumber, but this meaning is not | ||||
| 414 | enforced in the routine itself. | ||||
| 415 | |||||
| 416 | =cut | ||||
| 417 | |||||
| 418 | #' | ||||
| 419 | sub GetMember { | ||||
| 420 | my ( %information ) = @_; | ||||
| 421 | if (exists $information{borrowernumber} && !defined $information{borrowernumber}) { | ||||
| 422 | #passing mysql's kohaadmin?? Makes no sense as a query | ||||
| 423 | return; | ||||
| 424 | } | ||||
| 425 | my $dbh = C4::Context->dbh; | ||||
| 426 | my $select = | ||||
| 427 | q{SELECT borrowers.*, categories.category_type, categories.description | ||||
| 428 | FROM borrowers | ||||
| 429 | LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE }; | ||||
| 430 | my $more_p = 0; | ||||
| 431 | my @values = (); | ||||
| 432 | for (keys %information ) { | ||||
| 433 | if ($more_p) { | ||||
| 434 | $select .= ' AND '; | ||||
| 435 | } | ||||
| 436 | else { | ||||
| 437 | $more_p++; | ||||
| 438 | } | ||||
| 439 | |||||
| 440 | if (defined $information{$_}) { | ||||
| 441 | $select .= "$_ = ?"; | ||||
| 442 | push @values, $information{$_}; | ||||
| 443 | } | ||||
| 444 | else { | ||||
| 445 | $select .= "$_ IS NULL"; | ||||
| 446 | } | ||||
| 447 | } | ||||
| 448 | $debug && warn $select, " ",values %information; | ||||
| 449 | 1 | 213µs | 4 | 243µs | my $sth = $dbh->prepare("$select"); # spent 243µs making 4 calls to DBD::mysql::db::prepare, avg 61µs/call |
| 450 | $sth->execute(map{$information{$_}} keys %information); | ||||
| 451 | 4 | 8.16ms | my $data = $sth->fetchall_arrayref({}); # spent 8.16ms making 4 calls to DBD::_::st::fetchall_arrayref, avg 2.04ms/call | ||
| 452 | #FIXME interface to this routine now allows generation of a result set | ||||
| 453 | #so whole array should be returned but bowhere in the current code expects this | ||||
| 454 | if (@{$data} ) { | ||||
| 455 | return $data->[0]; | ||||
| 456 | } | ||||
| 457 | |||||
| 458 | return; | ||||
| 459 | } | ||||
| 460 | |||||
| 461 | =head2 GetMemberRelatives | ||||
| 462 | |||||
| 463 | @borrowernumbers = GetMemberRelatives($borrowernumber); | ||||
| 464 | |||||
| 465 | C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter | ||||
| 466 | |||||
| 467 | =cut | ||||
| 468 | |||||
| 469 | sub GetMemberRelatives { | ||||
| 470 | my $borrowernumber = shift; | ||||
| 471 | my $dbh = C4::Context->dbh; | ||||
| 472 | my @glist; | ||||
| 473 | |||||
| 474 | # Getting guarantor | ||||
| 475 | my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?"; | ||||
| 476 | my $sth = $dbh->prepare($query); | ||||
| 477 | $sth->execute($borrowernumber); | ||||
| 478 | my $data = $sth->fetchrow_arrayref(); | ||||
| 479 | push @glist, $data->[0] if $data->[0]; | ||||
| 480 | my $guarantor = $data->[0] ? $data->[0] : undef; | ||||
| 481 | |||||
| 482 | # Getting guarantees | ||||
| 483 | $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?"; | ||||
| 484 | $sth = $dbh->prepare($query); | ||||
| 485 | $sth->execute($borrowernumber); | ||||
| 486 | while ($data = $sth->fetchrow_arrayref()) { | ||||
| 487 | push @glist, $data->[0]; | ||||
| 488 | } | ||||
| 489 | |||||
| 490 | # Getting sibling guarantees | ||||
| 491 | if ($guarantor) { | ||||
| 492 | $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?"; | ||||
| 493 | $sth = $dbh->prepare($query); | ||||
| 494 | $sth->execute($guarantor); | ||||
| 495 | while ($data = $sth->fetchrow_arrayref()) { | ||||
| 496 | push @glist, $data->[0] if ($data->[0] != $borrowernumber); | ||||
| 497 | } | ||||
| 498 | } | ||||
| 499 | |||||
| 500 | return @glist; | ||||
| 501 | } | ||||
| 502 | |||||
| 503 | =head2 IsMemberBlocked | ||||
| 504 | |||||
| 505 | my ($block_status, $count) = IsMemberBlocked( $borrowernumber ); | ||||
| 506 | |||||
| 507 | Returns whether a patron is restricted or has overdue items that may result | ||||
| 508 | in a block of circulation privileges. | ||||
| 509 | |||||
| 510 | C<$block_status> can have the following values: | ||||
| 511 | |||||
| 512 | 1 if the patron is currently restricted, in which case | ||||
| 513 | C<$count> is the expiration date (9999-12-31 for indefinite) | ||||
| 514 | |||||
| 515 | -1 if the patron has overdue items, in which case C<$count> is the number of them | ||||
| 516 | |||||
| 517 | 0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0 | ||||
| 518 | |||||
| 519 | Existing active restrictions are checked before current overdue items. | ||||
| 520 | |||||
| 521 | =cut | ||||
| 522 | |||||
| 523 | sub IsMemberBlocked { | ||||
| 524 | my $borrowernumber = shift; | ||||
| 525 | my $dbh = C4::Context->dbh; | ||||
| 526 | |||||
| 527 | my $blockeddate = Koha::Borrower::Debarments::IsDebarred($borrowernumber); | ||||
| 528 | |||||
| 529 | return ( 1, $blockeddate ) if $blockeddate; | ||||
| 530 | |||||
| 531 | # if he have late issues | ||||
| 532 | my $sth = $dbh->prepare( | ||||
| 533 | "SELECT COUNT(*) as latedocs | ||||
| 534 | FROM issues | ||||
| 535 | WHERE borrowernumber = ? | ||||
| 536 | AND date_due < now()" | ||||
| 537 | ); | ||||
| 538 | $sth->execute($borrowernumber); | ||||
| 539 | my $latedocs = $sth->fetchrow_hashref->{'latedocs'}; | ||||
| 540 | |||||
| 541 | return ( -1, $latedocs ) if $latedocs > 0; | ||||
| 542 | |||||
| 543 | return ( 0, 0 ); | ||||
| 544 | } | ||||
| 545 | |||||
| 546 | =head2 GetMemberIssuesAndFines | ||||
| 547 | |||||
| 548 | ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber); | ||||
| 549 | |||||
| 550 | Returns aggregate data about items borrowed by the patron with the | ||||
| 551 | given borrowernumber. | ||||
| 552 | |||||
| 553 | C<&GetMemberIssuesAndFines> returns a three-element array. C<$overdue_count> is the | ||||
| 554 | number of overdue items the patron currently has borrowed. C<$issue_count> is the | ||||
| 555 | number of books the patron currently has borrowed. C<$total_fines> is | ||||
| 556 | the total fine currently due by the borrower. | ||||
| 557 | |||||
| 558 | =cut | ||||
| 559 | |||||
| 560 | #' | ||||
| 561 | sub GetMemberIssuesAndFines { | ||||
| 562 | my ( $borrowernumber ) = @_; | ||||
| 563 | my $dbh = C4::Context->dbh; | ||||
| 564 | my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?"; | ||||
| 565 | |||||
| 566 | $debug and warn $query."\n"; | ||||
| 567 | my $sth = $dbh->prepare($query); | ||||
| 568 | $sth->execute($borrowernumber); | ||||
| 569 | my $issue_count = $sth->fetchrow_arrayref->[0]; | ||||
| 570 | |||||
| 571 | $sth = $dbh->prepare( | ||||
| 572 | "SELECT COUNT(*) FROM issues | ||||
| 573 | WHERE borrowernumber = ? | ||||
| 574 | AND date_due < now()" | ||||
| 575 | ); | ||||
| 576 | $sth->execute($borrowernumber); | ||||
| 577 | my $overdue_count = $sth->fetchrow_arrayref->[0]; | ||||
| 578 | |||||
| 579 | $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?"); | ||||
| 580 | $sth->execute($borrowernumber); | ||||
| 581 | my $total_fines = $sth->fetchrow_arrayref->[0]; | ||||
| 582 | |||||
| 583 | return ($overdue_count, $issue_count, $total_fines); | ||||
| 584 | } | ||||
| 585 | |||||
| 586 | |||||
| 587 | =head2 columns | ||||
| 588 | |||||
| 589 | my @columns = C4::Member::columns(); | ||||
| 590 | |||||
| 591 | Returns an array of borrowers' table columns on success, | ||||
| 592 | and an empty array on failure. | ||||
| 593 | |||||
| 594 | =cut | ||||
| 595 | |||||
| 596 | sub columns { | ||||
| 597 | |||||
| 598 | # Pure ANSI SQL goodness. | ||||
| 599 | my $sql = 'SELECT * FROM borrowers WHERE 1=0;'; | ||||
| 600 | |||||
| 601 | # Get the database handle. | ||||
| 602 | my $dbh = C4::Context->dbh; | ||||
| 603 | |||||
| 604 | # Run the SQL statement to load STH's readonly properties. | ||||
| 605 | my $sth = $dbh->prepare($sql); | ||||
| 606 | my $rv = $sth->execute(); | ||||
| 607 | |||||
| 608 | # This only fails if the table doesn't exist. | ||||
| 609 | # This will always be called AFTER an install or upgrade, | ||||
| 610 | # so borrowers will exist! | ||||
| 611 | my @data; | ||||
| 612 | if ($sth->{NUM_OF_FIELDS}>0) { | ||||
| 613 | @data = @{$sth->{NAME}}; | ||||
| 614 | } | ||||
| 615 | else { | ||||
| 616 | @data = (); | ||||
| 617 | } | ||||
| 618 | return @data; | ||||
| 619 | } | ||||
| 620 | |||||
| 621 | |||||
| 622 | =head2 ModMember | ||||
| 623 | |||||
| 624 | my $success = ModMember(borrowernumber => $borrowernumber, | ||||
| 625 | [ field => value ]... ); | ||||
| 626 | |||||
| 627 | Modify borrower's data. All date fields should ALREADY be in ISO format. | ||||
| 628 | |||||
| 629 | return : | ||||
| 630 | true on success, or false on failure | ||||
| 631 | |||||
| 632 | =cut | ||||
| 633 | |||||
| 634 | sub ModMember { | ||||
| 635 | my (%data) = @_; | ||||
| 636 | # test to know if you must update or not the borrower password | ||||
| 637 | if (exists $data{password}) { | ||||
| 638 | if ($data{password} eq '****' or $data{password} eq '') { | ||||
| 639 | delete $data{password}; | ||||
| 640 | } else { | ||||
| 641 | if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) { | ||||
| 642 | # Update the hashed PIN in borrower_sync.hashed_pin, before Koha hashes it | ||||
| 643 | Koha::NorwegianPatronDB::NLUpdateHashedPIN( $data{'borrowernumber'}, $data{password} ); | ||||
| 644 | } | ||||
| 645 | $data{password} = hash_password($data{password}); | ||||
| 646 | } | ||||
| 647 | } | ||||
| 648 | my $old_categorycode = GetBorrowerCategorycode( $data{borrowernumber} ); | ||||
| 649 | |||||
| 650 | # get only the columns of a borrower | ||||
| 651 | my $schema = Koha::Database->new()->schema; | ||||
| 652 | my @columns = $schema->source('Borrower')->columns; | ||||
| 653 | my $new_borrower = { map { join(' ', @columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) }; | ||||
| 654 | delete $new_borrower->{flags}; | ||||
| 655 | |||||
| 656 | $new_borrower->{dateofbirth} ||= undef if exists $new_borrower->{dateofbirth}; | ||||
| 657 | $new_borrower->{dateenrolled} ||= undef if exists $new_borrower->{dateenrolled}; | ||||
| 658 | $new_borrower->{dateexpiry} ||= undef if exists $new_borrower->{dateexpiry}; | ||||
| 659 | $new_borrower->{debarred} ||= undef if exists $new_borrower->{debarred}; | ||||
| 660 | my $rs = $schema->resultset('Borrower')->search({ | ||||
| 661 | borrowernumber => $new_borrower->{borrowernumber}, | ||||
| 662 | }); | ||||
| 663 | my $execute_success = $rs->update($new_borrower); | ||||
| 664 | if ($execute_success ne '0E0') { # only proceed if the update was a success | ||||
| 665 | # ok if its an adult (type) it may have borrowers that depend on it as a guarantor | ||||
| 666 | # so when we update information for an adult we should check for guarantees and update the relevant part | ||||
| 667 | # of their records, ie addresses and phone numbers | ||||
| 668 | my $borrowercategory= GetBorrowercategory( $data{'category_type'} ); | ||||
| 669 | if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) { | ||||
| 670 | # is adult check guarantees; | ||||
| 671 | UpdateGuarantees(%data); | ||||
| 672 | } | ||||
| 673 | |||||
| 674 | # If the patron changes to a category with enrollment fee, we add a fee | ||||
| 675 | if ( $data{categorycode} and $data{categorycode} ne $old_categorycode ) { | ||||
| 676 | if ( C4::Context->preference('FeeOnChangePatronCategory') ) { | ||||
| 677 | AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} ); | ||||
| 678 | } | ||||
| 679 | } | ||||
| 680 | |||||
| 681 | # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a | ||||
| 682 | # cronjob will use for syncing with NL | ||||
| 683 | if ( C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) { | ||||
| 684 | my $borrowersync = Koha::Database->new->schema->resultset('BorrowerSync')->find({ | ||||
| 685 | 'synctype' => 'norwegianpatrondb', | ||||
| 686 | 'borrowernumber' => $data{'borrowernumber'} | ||||
| 687 | }); | ||||
| 688 | # Do not set to "edited" if syncstatus is "new". We need to sync as new before | ||||
| 689 | # we can sync as changed. And the "new sync" will pick up all changes since | ||||
| 690 | # the patron was created anyway. | ||||
| 691 | if ( $borrowersync->syncstatus ne 'new' && $borrowersync->syncstatus ne 'delete' ) { | ||||
| 692 | $borrowersync->update( { 'syncstatus' => 'edited' } ); | ||||
| 693 | } | ||||
| 694 | # Set the value of 'sync' | ||||
| 695 | $borrowersync->update( { 'sync' => $data{'sync'} } ); | ||||
| 696 | # Try to do the live sync | ||||
| 697 | Koha::NorwegianPatronDB::NLSync({ 'borrowernumber' => $data{'borrowernumber'} }); | ||||
| 698 | } | ||||
| 699 | |||||
| 700 | logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog"); | ||||
| 701 | } | ||||
| 702 | return $execute_success; | ||||
| 703 | } | ||||
| 704 | |||||
| 705 | =head2 AddMember | ||||
| 706 | |||||
| 707 | $borrowernumber = &AddMember(%borrower); | ||||
| 708 | |||||
| 709 | insert new borrower into table | ||||
| 710 | |||||
| 711 | (%borrower keys are database columns. Database columns could be | ||||
| 712 | different in different versions. Please look into database for correct | ||||
| 713 | column names.) | ||||
| 714 | |||||
| 715 | Returns the borrowernumber upon success | ||||
| 716 | |||||
| 717 | Returns as undef upon any db error without further processing | ||||
| 718 | |||||
| 719 | =cut | ||||
| 720 | |||||
| 721 | #' | ||||
| 722 | sub AddMember { | ||||
| 723 | my (%data) = @_; | ||||
| 724 | my $dbh = C4::Context->dbh; | ||||
| 725 | my $schema = Koha::Database->new()->schema; | ||||
| 726 | |||||
| 727 | # generate a proper login if none provided | ||||
| 728 | $data{'userid'} = Generate_Userid( $data{'borrowernumber'}, $data{'firstname'}, $data{'surname'} ) | ||||
| 729 | if ( $data{'userid'} eq '' || !Check_Userid( $data{'userid'} ) ); | ||||
| 730 | |||||
| 731 | # add expiration date if it isn't already there | ||||
| 732 | unless ( $data{'dateexpiry'} ) { | ||||
| 733 | $data{'dateexpiry'} = GetExpiryDate( $data{'categorycode'}, output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ) ); | ||||
| 734 | } | ||||
| 735 | |||||
| 736 | # add enrollment date if it isn't already there | ||||
| 737 | unless ( $data{'dateenrolled'} ) { | ||||
| 738 | $data{'dateenrolled'} = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ); | ||||
| 739 | } | ||||
| 740 | |||||
| 741 | my $patron_category = $schema->resultset('Category')->find( $data{'categorycode'} ); | ||||
| 742 | $data{'privacy'} = | ||||
| 743 | $patron_category->default_privacy() eq 'default' ? 1 | ||||
| 744 | : $patron_category->default_privacy() eq 'never' ? 2 | ||||
| 745 | : $patron_category->default_privacy() eq 'forever' ? 0 | ||||
| 746 | : undef; | ||||
| 747 | # Make a copy of the plain text password for later use | ||||
| 748 | my $plain_text_password = $data{'password'}; | ||||
| 749 | |||||
| 750 | # create a disabled account if no password provided | ||||
| 751 | $data{'password'} = ($data{'password'})? hash_password($data{'password'}) : '!'; | ||||
| 752 | |||||
| 753 | # we don't want invalid dates in the db (mysql has a bad habit of inserting 0000-00-00 | ||||
| 754 | $data{'dateofbirth'} = undef if( not $data{'dateofbirth'} ); | ||||
| 755 | $data{'debarred'} = undef if ( not $data{'debarred'} ); | ||||
| 756 | |||||
| 757 | # get only the columns of Borrower | ||||
| 758 | my @columns = $schema->source('Borrower')->columns; | ||||
| 759 | my $new_member = { map { join(' ',@columns) =~ /$_/ ? ( $_ => $data{$_} ) : () } keys(%data) } ; | ||||
| 760 | delete $new_member->{borrowernumber}; | ||||
| 761 | |||||
| 762 | my $rs = $schema->resultset('Borrower'); | ||||
| 763 | $data{borrowernumber} = $rs->create($new_member)->id; | ||||
| 764 | |||||
| 765 | # If NorwegianPatronDBEnable is enabled, we set syncstatus to something that a | ||||
| 766 | # cronjob will use for syncing with NL | ||||
| 767 | if ( exists $data{'borrowernumber'} && C4::Context->preference('NorwegianPatronDBEnable') && C4::Context->preference('NorwegianPatronDBEnable') == 1 ) { | ||||
| 768 | Koha::Database->new->schema->resultset('BorrowerSync')->create({ | ||||
| 769 | 'borrowernumber' => $data{'borrowernumber'}, | ||||
| 770 | 'synctype' => 'norwegianpatrondb', | ||||
| 771 | 'sync' => 1, | ||||
| 772 | 'syncstatus' => 'new', | ||||
| 773 | 'hashed_pin' => Koha::NorwegianPatronDB::NLEncryptPIN( $plain_text_password ), | ||||
| 774 | }); | ||||
| 775 | } | ||||
| 776 | |||||
| 777 | # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best. | ||||
| 778 | logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog"); | ||||
| 779 | |||||
| 780 | AddEnrolmentFeeIfNeeded( $data{categorycode}, $data{borrowernumber} ); | ||||
| 781 | |||||
| 782 | return $data{borrowernumber}; | ||||
| 783 | } | ||||
| 784 | |||||
| 785 | =head2 Check_Userid | ||||
| 786 | |||||
| 787 | my $uniqueness = Check_Userid($userid,$borrowernumber); | ||||
| 788 | |||||
| 789 | $borrowernumber is optional (i.e. it can contain a blank value). If $userid is passed with a blank $borrowernumber variable, the database will be checked for all instances of that userid (i.e. userid=? AND borrowernumber != ''). | ||||
| 790 | |||||
| 791 | If $borrowernumber is provided, the database will be checked for every instance of that userid coupled with a different borrower(number) than the one provided. | ||||
| 792 | |||||
| 793 | return : | ||||
| 794 | 0 for not unique (i.e. this $userid already exists) | ||||
| 795 | 1 for unique (i.e. this $userid does not exist, or this $userid/$borrowernumber combination already exists) | ||||
| 796 | |||||
| 797 | =cut | ||||
| 798 | |||||
| 799 | sub Check_Userid { | ||||
| 800 | my ( $uid, $borrowernumber ) = @_; | ||||
| 801 | |||||
| 802 | return 0 unless ($uid); # userid is a unique column, we should assume NULL is not unique | ||||
| 803 | |||||
| 804 | return 0 if ( $uid eq C4::Context->config('user') ); | ||||
| 805 | |||||
| 806 | my $rs = Koha::Database->new()->schema()->resultset('Borrower'); | ||||
| 807 | |||||
| 808 | my $params; | ||||
| 809 | $params->{userid} = $uid; | ||||
| 810 | $params->{borrowernumber} = { '!=' => $borrowernumber } if ($borrowernumber); | ||||
| 811 | |||||
| 812 | my $count = $rs->count( $params ); | ||||
| 813 | |||||
| 814 | return $count ? 0 : 1; | ||||
| 815 | } | ||||
| 816 | |||||
| 817 | =head2 Generate_Userid | ||||
| 818 | |||||
| 819 | my $newuid = Generate_Userid($borrowernumber, $firstname, $surname); | ||||
| 820 | |||||
| 821 | Generate a userid using the $surname and the $firstname (if there is a value in $firstname). | ||||
| 822 | |||||
| 823 | $borrowernumber is optional (i.e. it can contain a blank value). A value is passed when generating a new userid for an existing borrower. When a new userid is created for a new borrower, a blank value is passed to this sub. | ||||
| 824 | |||||
| 825 | return : | ||||
| 826 | new userid ($firstname.$surname if there is a $firstname, or $surname if there is no value in $firstname) plus offset (0 if the $newuid is unique, or a higher numeric value if Check_Userid finds an existing match for the $newuid in the database). | ||||
| 827 | |||||
| 828 | =cut | ||||
| 829 | |||||
| 830 | sub Generate_Userid { | ||||
| 831 | my ($borrowernumber, $firstname, $surname) = @_; | ||||
| 832 | my $newuid; | ||||
| 833 | my $offset = 0; | ||||
| 834 | #The script will "do" the following code and increment the $offset until Check_Userid = 1 (i.e. until $newuid comes back as unique) | ||||
| 835 | do { | ||||
| 836 | $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g; | ||||
| 837 | $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g; | ||||
| 838 | $newuid = lc(($firstname)? "$firstname.$surname" : $surname); | ||||
| 839 | $newuid = unac_string('utf-8',$newuid); | ||||
| 840 | $newuid .= $offset unless $offset == 0; | ||||
| 841 | $offset++; | ||||
| 842 | |||||
| 843 | } while (!Check_Userid($newuid,$borrowernumber)); | ||||
| 844 | |||||
| 845 | return $newuid; | ||||
| 846 | } | ||||
| 847 | |||||
| 848 | sub changepassword { | ||||
| 849 | my ( $uid, $member, $digest ) = @_; | ||||
| 850 | my $dbh = C4::Context->dbh; | ||||
| 851 | |||||
| 852 | #Make sure the userid chosen is unique and not theirs if non-empty. If it is not, | ||||
| 853 | #Then we need to tell the user and have them create a new one. | ||||
| 854 | my $resultcode; | ||||
| 855 | my $sth = | ||||
| 856 | $dbh->prepare( | ||||
| 857 | "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?"); | ||||
| 858 | $sth->execute( $uid, $member ); | ||||
| 859 | if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) { | ||||
| 860 | $resultcode=0; | ||||
| 861 | } | ||||
| 862 | else { | ||||
| 863 | #Everything is good so we can update the information. | ||||
| 864 | $sth = | ||||
| 865 | $dbh->prepare( | ||||
| 866 | "update borrowers set userid=?, password=? where borrowernumber=?"); | ||||
| 867 | $sth->execute( $uid, $digest, $member ); | ||||
| 868 | $resultcode=1; | ||||
| 869 | } | ||||
| 870 | |||||
| 871 | logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog"); | ||||
| 872 | return $resultcode; | ||||
| 873 | } | ||||
| 874 | |||||
| - - | |||||
| 877 | =head2 fixup_cardnumber | ||||
| 878 | |||||
| 879 | Warning: The caller is responsible for locking the members table in write | ||||
| 880 | mode, to avoid database corruption. | ||||
| 881 | |||||
| 882 | =cut | ||||
| 883 | |||||
| 884 | use vars qw( @weightings ); | ||||
| 885 | my @weightings = ( 8, 4, 6, 3, 5, 2, 1 ); | ||||
| 886 | |||||
| 887 | sub fixup_cardnumber { | ||||
| 888 | my ($cardnumber) = @_; | ||||
| 889 | my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0; | ||||
| 890 | |||||
| 891 | # Find out whether member numbers should be generated | ||||
| 892 | # automatically. Should be either "1" or something else. | ||||
| 893 | # Defaults to "0", which is interpreted as "no". | ||||
| 894 | |||||
| 895 | # if ($cardnumber !~ /\S/ && $autonumber_members) { | ||||
| 896 | ($autonumber_members) or return $cardnumber; | ||||
| 897 | my $checkdigit = C4::Context->preference('checkdigit'); | ||||
| 898 | my $dbh = C4::Context->dbh; | ||||
| 899 | if ( $checkdigit and $checkdigit eq 'katipo' ) { | ||||
| 900 | |||||
| 901 | # if checkdigit is selected, calculate katipo-style cardnumber. | ||||
| 902 | # otherwise, just use the max() | ||||
| 903 | # purpose: generate checksum'd member numbers. | ||||
| 904 | # We'll assume we just got the max value of digits 2-8 of member #'s | ||||
| 905 | # from the database and our job is to increment that by one, | ||||
| 906 | # determine the 1st and 9th digits and return the full string. | ||||
| 907 | my $sth = $dbh->prepare( | ||||
| 908 | "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers" | ||||
| 909 | ); | ||||
| 910 | $sth->execute; | ||||
| 911 | my $data = $sth->fetchrow_hashref; | ||||
| 912 | $cardnumber = $data->{new_num}; | ||||
| 913 | if ( !$cardnumber ) { # If DB has no values, | ||||
| 914 | $cardnumber = 1000000; # start at 1000000 | ||||
| 915 | } else { | ||||
| 916 | $cardnumber += 1; | ||||
| 917 | } | ||||
| 918 | |||||
| 919 | my $sum = 0; | ||||
| 920 | for ( my $i = 0 ; $i < 8 ; $i += 1 ) { | ||||
| 921 | # read weightings, left to right, 1 char at a time | ||||
| 922 | my $temp1 = $weightings[$i]; | ||||
| 923 | |||||
| 924 | # sequence left to right, 1 char at a time | ||||
| 925 | my $temp2 = substr( $cardnumber, $i, 1 ); | ||||
| 926 | |||||
| 927 | # mult each char 1-7 by its corresponding weighting | ||||
| 928 | $sum += $temp1 * $temp2; | ||||
| 929 | } | ||||
| 930 | |||||
| 931 | my $rem = ( $sum % 11 ); | ||||
| 932 | $rem = 'X' if $rem == 10; | ||||
| 933 | |||||
| 934 | return "V$cardnumber$rem"; | ||||
| 935 | } else { | ||||
| 936 | |||||
| 937 | my $sth = $dbh->prepare( | ||||
| 938 | 'SELECT MAX( CAST( cardnumber AS SIGNED ) ) FROM borrowers WHERE cardnumber REGEXP "^-?[0-9]+$"' | ||||
| 939 | ); | ||||
| 940 | $sth->execute; | ||||
| 941 | my ($result) = $sth->fetchrow; | ||||
| 942 | return $result + 1; | ||||
| 943 | } | ||||
| 944 | return $cardnumber; # just here as a fallback/reminder | ||||
| 945 | } | ||||
| 946 | |||||
| 947 | =head2 GetGuarantees | ||||
| 948 | |||||
| 949 | ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno); | ||||
| 950 | $child0_cardno = $children_arrayref->[0]{"cardnumber"}; | ||||
| 951 | $child0_borrno = $children_arrayref->[0]{"borrowernumber"}; | ||||
| 952 | |||||
| 953 | C<&GetGuarantees> takes a borrower number (e.g., that of a patron | ||||
| 954 | with children) and looks up the borrowers who are guaranteed by that | ||||
| 955 | borrower (i.e., the patron's children). | ||||
| 956 | |||||
| 957 | C<&GetGuarantees> returns two values: an integer giving the number of | ||||
| 958 | borrowers guaranteed by C<$parent_borrno>, and a reference to an array | ||||
| 959 | of references to hash, which gives the actual results. | ||||
| 960 | |||||
| 961 | =cut | ||||
| 962 | |||||
| 963 | #' | ||||
| 964 | sub GetGuarantees { | ||||
| 965 | my ($borrowernumber) = @_; | ||||
| 966 | my $dbh = C4::Context->dbh; | ||||
| 967 | my $sth = | ||||
| 968 | $dbh->prepare( | ||||
| 969 | "select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?" | ||||
| 970 | ); | ||||
| 971 | $sth->execute($borrowernumber); | ||||
| 972 | |||||
| 973 | my @dat; | ||||
| 974 | my $data = $sth->fetchall_arrayref({}); | ||||
| 975 | return ( scalar(@$data), $data ); | ||||
| 976 | } | ||||
| 977 | |||||
| 978 | =head2 UpdateGuarantees | ||||
| 979 | |||||
| 980 | &UpdateGuarantees($parent_borrno); | ||||
| 981 | |||||
| 982 | |||||
| 983 | C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees | ||||
| 984 | with the modified information | ||||
| 985 | |||||
| 986 | =cut | ||||
| 987 | |||||
| 988 | #' | ||||
| 989 | sub UpdateGuarantees { | ||||
| 990 | my %data = shift; | ||||
| 991 | my $dbh = C4::Context->dbh; | ||||
| 992 | my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} ); | ||||
| 993 | foreach my $guarantee (@$guarantees){ | ||||
| 994 | my $guaquery = qq|UPDATE borrowers | ||||
| 995 | SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=? | ||||
| 996 | WHERE borrowernumber=? | ||||
| 997 | |; | ||||
| 998 | my $sth = $dbh->prepare($guaquery); | ||||
| 999 | $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'}); | ||||
| 1000 | } | ||||
| 1001 | } | ||||
| 1002 | =head2 GetPendingIssues | ||||
| 1003 | |||||
| 1004 | my $issues = &GetPendingIssues(@borrowernumber); | ||||
| 1005 | |||||
| 1006 | Looks up what the patron with the given borrowernumber has borrowed. | ||||
| 1007 | |||||
| 1008 | C<&GetPendingIssues> returns a | ||||
| 1009 | reference-to-array where each element is a reference-to-hash; the | ||||
| 1010 | keys are the fields from the C<issues>, C<biblio>, and C<items> tables. | ||||
| 1011 | The keys include C<biblioitems> fields except marc and marcxml. | ||||
| 1012 | |||||
| 1013 | =cut | ||||
| 1014 | |||||
| 1015 | #' | ||||
| 1016 | sub GetPendingIssues { | ||||
| 1017 | my @borrowernumbers = @_; | ||||
| 1018 | |||||
| 1019 | unless (@borrowernumbers ) { # return a ref_to_array | ||||
| 1020 | return \@borrowernumbers; # to not cause surprise to caller | ||||
| 1021 | } | ||||
| 1022 | |||||
| 1023 | # Borrowers part of the query | ||||
| 1024 | my $bquery = ''; | ||||
| 1025 | for (my $i = 0; $i < @borrowernumbers; $i++) { | ||||
| 1026 | $bquery .= ' issues.borrowernumber = ?'; | ||||
| 1027 | if ($i < $#borrowernumbers ) { | ||||
| 1028 | $bquery .= ' OR'; | ||||
| 1029 | } | ||||
| 1030 | } | ||||
| 1031 | |||||
| 1032 | # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance | ||||
| 1033 | # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ? | ||||
| 1034 | # FIXME: circ/ciculation.pl tries to sort by timestamp! | ||||
| 1035 | # FIXME: namespace collision: other collisions possible. | ||||
| 1036 | # FIXME: most of this data isn't really being used by callers. | ||||
| 1037 | my $query = | ||||
| 1038 | "SELECT issues.*, | ||||
| 1039 | items.*, | ||||
| 1040 | biblio.*, | ||||
| 1041 | biblioitems.volume, | ||||
| 1042 | biblioitems.number, | ||||
| 1043 | biblioitems.itemtype, | ||||
| 1044 | biblioitems.isbn, | ||||
| 1045 | biblioitems.issn, | ||||
| 1046 | biblioitems.publicationyear, | ||||
| 1047 | biblioitems.publishercode, | ||||
| 1048 | biblioitems.volumedate, | ||||
| 1049 | biblioitems.volumedesc, | ||||
| 1050 | biblioitems.lccn, | ||||
| 1051 | biblioitems.url, | ||||
| 1052 | borrowers.firstname, | ||||
| 1053 | borrowers.surname, | ||||
| 1054 | borrowers.cardnumber, | ||||
| 1055 | issues.timestamp AS timestamp, | ||||
| 1056 | issues.renewals AS renewals, | ||||
| 1057 | issues.borrowernumber AS borrowernumber, | ||||
| 1058 | items.renewals AS totalrenewals | ||||
| 1059 | FROM issues | ||||
| 1060 | LEFT JOIN items ON items.itemnumber = issues.itemnumber | ||||
| 1061 | LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber | ||||
| 1062 | LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber | ||||
| 1063 | LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber | ||||
| 1064 | WHERE | ||||
| 1065 | $bquery | ||||
| 1066 | ORDER BY issues.issuedate" | ||||
| 1067 | ; | ||||
| 1068 | |||||
| 1069 | my $sth = C4::Context->dbh->prepare($query); | ||||
| 1070 | $sth->execute(@borrowernumbers); | ||||
| 1071 | my $data = $sth->fetchall_arrayref({}); | ||||
| 1072 | my $today = dt_from_string; | ||||
| 1073 | foreach (@{$data}) { | ||||
| 1074 | if ($_->{issuedate}) { | ||||
| 1075 | $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql'); | ||||
| 1076 | } | ||||
| 1077 | $_->{date_due_sql} = $_->{date_due}; | ||||
| 1078 | # FIXME no need to have this value | ||||
| 1079 | $_->{date_due} or next; | ||||
| 1080 | $_->{date_due_sql} = $_->{date_due}; | ||||
| 1081 | # FIXME no need to have this value | ||||
| 1082 | $_->{date_due} = dt_from_string($_->{date_due}, 'sql'); | ||||
| 1083 | if ( DateTime->compare($_->{date_due}, $today) == -1 ) { | ||||
| 1084 | $_->{overdue} = 1; | ||||
| 1085 | } | ||||
| 1086 | } | ||||
| 1087 | return $data; | ||||
| 1088 | } | ||||
| 1089 | |||||
| 1090 | =head2 GetAllIssues | ||||
| 1091 | |||||
| 1092 | $issues = &GetAllIssues($borrowernumber, $sortkey, $limit); | ||||
| 1093 | |||||
| 1094 | Looks up what the patron with the given borrowernumber has borrowed, | ||||
| 1095 | and sorts the results. | ||||
| 1096 | |||||
| 1097 | C<$sortkey> is the name of a field on which to sort the results. This | ||||
| 1098 | should be the name of a field in the C<issues>, C<biblio>, | ||||
| 1099 | C<biblioitems>, or C<items> table in the Koha database. | ||||
| 1100 | |||||
| 1101 | C<$limit> is the maximum number of results to return. | ||||
| 1102 | |||||
| 1103 | C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which | ||||
| 1104 | are the fields from the C<issues>, C<biblio>, C<biblioitems>, and | ||||
| 1105 | C<items> tables of the Koha database. | ||||
| 1106 | |||||
| 1107 | =cut | ||||
| 1108 | |||||
| 1109 | #' | ||||
| 1110 | sub GetAllIssues { | ||||
| 1111 | my ( $borrowernumber, $order, $limit ) = @_; | ||||
| 1112 | |||||
| 1113 | return unless $borrowernumber; | ||||
| 1114 | $order = 'date_due desc' unless $order; | ||||
| 1115 | |||||
| 1116 | my $dbh = C4::Context->dbh; | ||||
| 1117 | my $query = | ||||
| 1118 | 'SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp | ||||
| 1119 | FROM issues | ||||
| 1120 | LEFT JOIN items on items.itemnumber=issues.itemnumber | ||||
| 1121 | LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber | ||||
| 1122 | LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber | ||||
| 1123 | WHERE borrowernumber=? | ||||
| 1124 | UNION ALL | ||||
| 1125 | SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp | ||||
| 1126 | FROM old_issues | ||||
| 1127 | LEFT JOIN items on items.itemnumber=old_issues.itemnumber | ||||
| 1128 | LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber | ||||
| 1129 | LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber | ||||
| 1130 | WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL | ||||
| 1131 | order by ' . $order; | ||||
| 1132 | if ($limit) { | ||||
| 1133 | $query .= " limit $limit"; | ||||
| 1134 | } | ||||
| 1135 | |||||
| 1136 | my $sth = $dbh->prepare($query); | ||||
| 1137 | $sth->execute( $borrowernumber, $borrowernumber ); | ||||
| 1138 | return $sth->fetchall_arrayref( {} ); | ||||
| 1139 | } | ||||
| 1140 | |||||
| 1141 | |||||
| 1142 | =head2 GetMemberAccountRecords | ||||
| 1143 | |||||
| 1144 | ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber); | ||||
| 1145 | |||||
| 1146 | Looks up accounting data for the patron with the given borrowernumber. | ||||
| 1147 | |||||
| 1148 | C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a | ||||
| 1149 | reference-to-array, where each element is a reference-to-hash; the | ||||
| 1150 | keys are the fields of the C<accountlines> table in the Koha database. | ||||
| 1151 | C<$count> is the number of elements in C<$acctlines>. C<$total> is the | ||||
| 1152 | total amount outstanding for all of the account lines. | ||||
| 1153 | |||||
| 1154 | =cut | ||||
| 1155 | |||||
| 1156 | sub GetMemberAccountRecords { | ||||
| 1157 | my ($borrowernumber) = @_; | ||||
| 1158 | my $dbh = C4::Context->dbh; | ||||
| 1159 | my @acctlines; | ||||
| 1160 | my $numlines = 0; | ||||
| 1161 | my $strsth = qq( | ||||
| 1162 | SELECT * | ||||
| 1163 | FROM accountlines | ||||
| 1164 | WHERE borrowernumber=?); | ||||
| 1165 | $strsth.=" ORDER BY accountlines_id desc"; | ||||
| 1166 | my $sth= $dbh->prepare( $strsth ); | ||||
| 1167 | $sth->execute( $borrowernumber ); | ||||
| 1168 | |||||
| 1169 | my $total = 0; | ||||
| 1170 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 1171 | if ( $data->{itemnumber} ) { | ||||
| 1172 | my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} ); | ||||
| 1173 | $data->{biblionumber} = $biblio->{biblionumber}; | ||||
| 1174 | $data->{title} = $biblio->{title}; | ||||
| 1175 | } | ||||
| 1176 | $acctlines[$numlines] = $data; | ||||
| 1177 | $numlines++; | ||||
| 1178 | $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors | ||||
| 1179 | } | ||||
| 1180 | $total /= 1000; | ||||
| 1181 | return ( $total, \@acctlines,$numlines); | ||||
| 1182 | } | ||||
| 1183 | |||||
| 1184 | =head2 GetMemberAccountBalance | ||||
| 1185 | |||||
| 1186 | ($total_balance, $non_issue_balance, $other_charges) = &GetMemberAccountBalance($borrowernumber); | ||||
| 1187 | |||||
| 1188 | Calculates amount immediately owing by the patron - non-issue charges. | ||||
| 1189 | Based on GetMemberAccountRecords. | ||||
| 1190 | Charges exempt from non-issue are: | ||||
| 1191 | * Res (reserves) | ||||
| 1192 | * Rent (rental) if RentalsInNoissuesCharge syspref is set to false | ||||
| 1193 | * Manual invoices if ManInvInNoissuesCharge syspref is set to false | ||||
| 1194 | |||||
| 1195 | =cut | ||||
| 1196 | |||||
| 1197 | sub GetMemberAccountBalance { | ||||
| 1198 | my ($borrowernumber) = @_; | ||||
| 1199 | |||||
| 1200 | my $ACCOUNT_TYPE_LENGTH = 5; # this is plain ridiculous... | ||||
| 1201 | |||||
| 1202 | my @not_fines; | ||||
| 1203 | push @not_fines, 'Res' unless C4::Context->preference('HoldsInNoissuesCharge'); | ||||
| 1204 | push @not_fines, 'Rent' unless C4::Context->preference('RentalsInNoissuesCharge'); | ||||
| 1205 | unless ( C4::Context->preference('ManInvInNoissuesCharge') ) { | ||||
| 1206 | my $dbh = C4::Context->dbh; | ||||
| 1207 | my $man_inv_types = $dbh->selectcol_arrayref(qq{SELECT authorised_value FROM authorised_values WHERE category = 'MANUAL_INV'}); | ||||
| 1208 | push @not_fines, map substr($_, 0, $ACCOUNT_TYPE_LENGTH), @$man_inv_types; | ||||
| 1209 | } | ||||
| 1210 | my %not_fine = map {$_ => 1} @not_fines; | ||||
| 1211 | |||||
| 1212 | my ($total, $acctlines) = GetMemberAccountRecords($borrowernumber); | ||||
| 1213 | my $other_charges = 0; | ||||
| 1214 | foreach (@$acctlines) { | ||||
| 1215 | $other_charges += $_->{amountoutstanding} if $not_fine{ substr($_->{accounttype}, 0, $ACCOUNT_TYPE_LENGTH) }; | ||||
| 1216 | } | ||||
| 1217 | |||||
| 1218 | return ( $total, $total - $other_charges, $other_charges); | ||||
| 1219 | } | ||||
| 1220 | |||||
| 1221 | =head2 GetBorNotifyAcctRecord | ||||
| 1222 | |||||
| 1223 | ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid); | ||||
| 1224 | |||||
| 1225 | Looks up accounting data for the patron with the given borrowernumber per file number. | ||||
| 1226 | |||||
| 1227 | C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a | ||||
| 1228 | reference-to-array, where each element is a reference-to-hash; the | ||||
| 1229 | keys are the fields of the C<accountlines> table in the Koha database. | ||||
| 1230 | C<$count> is the number of elements in C<$acctlines>. C<$total> is the | ||||
| 1231 | total amount outstanding for all of the account lines. | ||||
| 1232 | |||||
| 1233 | =cut | ||||
| 1234 | |||||
| 1235 | sub GetBorNotifyAcctRecord { | ||||
| 1236 | my ( $borrowernumber, $notifyid ) = @_; | ||||
| 1237 | my $dbh = C4::Context->dbh; | ||||
| 1238 | my @acctlines; | ||||
| 1239 | my $numlines = 0; | ||||
| 1240 | my $sth = $dbh->prepare( | ||||
| 1241 | "SELECT * | ||||
| 1242 | FROM accountlines | ||||
| 1243 | WHERE borrowernumber=? | ||||
| 1244 | AND notify_id=? | ||||
| 1245 | AND amountoutstanding != '0' | ||||
| 1246 | ORDER BY notify_id,accounttype | ||||
| 1247 | "); | ||||
| 1248 | |||||
| 1249 | $sth->execute( $borrowernumber, $notifyid ); | ||||
| 1250 | my $total = 0; | ||||
| 1251 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 1252 | if ( $data->{itemnumber} ) { | ||||
| 1253 | my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} ); | ||||
| 1254 | $data->{biblionumber} = $biblio->{biblionumber}; | ||||
| 1255 | $data->{title} = $biblio->{title}; | ||||
| 1256 | } | ||||
| 1257 | $acctlines[$numlines] = $data; | ||||
| 1258 | $numlines++; | ||||
| 1259 | $total += int(100 * $data->{'amountoutstanding'}); | ||||
| 1260 | } | ||||
| 1261 | $total /= 100; | ||||
| 1262 | return ( $total, \@acctlines, $numlines ); | ||||
| 1263 | } | ||||
| 1264 | |||||
| 1265 | =head2 checkuniquemember (OUEST-PROVENCE) | ||||
| 1266 | |||||
| 1267 | ($result,$categorycode) = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth); | ||||
| 1268 | |||||
| 1269 | Checks that a member exists or not in the database. | ||||
| 1270 | |||||
| 1271 | C<&result> is nonzero (=exist) or 0 (=does not exist) | ||||
| 1272 | C<&categorycode> is from categorycode table | ||||
| 1273 | C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member) | ||||
| 1274 | C<&surname> is the surname | ||||
| 1275 | C<&firstname> is the firstname (only if collectivity=0) | ||||
| 1276 | C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0) | ||||
| 1277 | |||||
| 1278 | =cut | ||||
| 1279 | |||||
| 1280 | # FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate. | ||||
| 1281 | # This is especially true since first name is not even a required field. | ||||
| 1282 | |||||
| 1283 | sub checkuniquemember { | ||||
| 1284 | my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_; | ||||
| 1285 | my $dbh = C4::Context->dbh; | ||||
| 1286 | my $request = ($collectivity) ? | ||||
| 1287 | "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " : | ||||
| 1288 | ($dateofbirth) ? | ||||
| 1289 | "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" : | ||||
| 1290 | "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?"; | ||||
| 1291 | my $sth = $dbh->prepare($request); | ||||
| 1292 | if ($collectivity) { | ||||
| 1293 | $sth->execute( uc($surname) ); | ||||
| 1294 | } elsif($dateofbirth){ | ||||
| 1295 | $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth ); | ||||
| 1296 | }else{ | ||||
| 1297 | $sth->execute( uc($surname), ucfirst($firstname)); | ||||
| 1298 | } | ||||
| 1299 | my @data = $sth->fetchrow; | ||||
| 1300 | ( $data[0] ) and return $data[0], $data[1]; | ||||
| 1301 | return 0; | ||||
| 1302 | } | ||||
| 1303 | |||||
| 1304 | sub checkcardnumber { | ||||
| 1305 | my ( $cardnumber, $borrowernumber ) = @_; | ||||
| 1306 | |||||
| 1307 | # If cardnumber is null, we assume they're allowed. | ||||
| 1308 | return 0 unless defined $cardnumber; | ||||
| 1309 | |||||
| 1310 | my $dbh = C4::Context->dbh; | ||||
| 1311 | my $query = "SELECT * FROM borrowers WHERE cardnumber=?"; | ||||
| 1312 | $query .= " AND borrowernumber <> ?" if ($borrowernumber); | ||||
| 1313 | my $sth = $dbh->prepare($query); | ||||
| 1314 | $sth->execute( | ||||
| 1315 | $cardnumber, | ||||
| 1316 | ( $borrowernumber ? $borrowernumber : () ) | ||||
| 1317 | ); | ||||
| 1318 | |||||
| 1319 | return 1 if $sth->fetchrow_hashref; | ||||
| 1320 | |||||
| 1321 | my ( $min_length, $max_length ) = get_cardnumber_length(); | ||||
| 1322 | return 2 | ||||
| 1323 | if length $cardnumber > $max_length | ||||
| 1324 | or length $cardnumber < $min_length; | ||||
| 1325 | |||||
| 1326 | return 0; | ||||
| 1327 | } | ||||
| 1328 | |||||
| 1329 | =head2 get_cardnumber_length | ||||
| 1330 | |||||
| 1331 | my ($min, $max) = C4::Members::get_cardnumber_length() | ||||
| 1332 | |||||
| 1333 | Returns the minimum and maximum length for patron cardnumbers as | ||||
| 1334 | determined by the CardnumberLength system preference, the | ||||
| 1335 | BorrowerMandatoryField system preference, and the width of the | ||||
| 1336 | database column. | ||||
| 1337 | |||||
| 1338 | =cut | ||||
| 1339 | |||||
| 1340 | sub get_cardnumber_length { | ||||
| 1341 | my ( $min, $max ) = ( 0, 16 ); # borrowers.cardnumber is a nullable varchar(16) | ||||
| 1342 | $min = 1 if C4::Context->preference('BorrowerMandatoryField') =~ /cardnumber/; | ||||
| 1343 | if ( my $cardnumber_length = C4::Context->preference('CardnumberLength') ) { | ||||
| 1344 | # Is integer and length match | ||||
| 1345 | if ( $cardnumber_length =~ m|^\d+$| ) { | ||||
| 1346 | $min = $max = $cardnumber_length | ||||
| 1347 | if $cardnumber_length >= $min | ||||
| 1348 | and $cardnumber_length <= $max; | ||||
| 1349 | } | ||||
| 1350 | # Else assuming it is a range | ||||
| 1351 | elsif ( $cardnumber_length =~ m|(\d*),(\d*)| ) { | ||||
| 1352 | $min = $1 if $1 and $min < $1; | ||||
| 1353 | $max = $2 if $2 and $max > $2; | ||||
| 1354 | } | ||||
| 1355 | |||||
| 1356 | } | ||||
| 1357 | return ( $min, $max ); | ||||
| 1358 | } | ||||
| 1359 | |||||
| 1360 | =head2 getzipnamecity (OUEST-PROVENCE) | ||||
| 1361 | |||||
| 1362 | take all info from table city for the fields city and zip | ||||
| 1363 | check for the name and the zip code of the city selected | ||||
| 1364 | |||||
| 1365 | =cut | ||||
| 1366 | |||||
| 1367 | sub getzipnamecity { | ||||
| 1368 | my ($cityid) = @_; | ||||
| 1369 | my $dbh = C4::Context->dbh; | ||||
| 1370 | my $sth = | ||||
| 1371 | $dbh->prepare( | ||||
| 1372 | "select city_name,city_state,city_zipcode,city_country from cities where cityid=? "); | ||||
| 1373 | $sth->execute($cityid); | ||||
| 1374 | my @data = $sth->fetchrow; | ||||
| 1375 | return $data[0], $data[1], $data[2], $data[3]; | ||||
| 1376 | } | ||||
| 1377 | |||||
| 1378 | |||||
| 1379 | =head2 getdcity (OUEST-PROVENCE) | ||||
| 1380 | |||||
| 1381 | recover cityid with city_name condition | ||||
| 1382 | |||||
| 1383 | =cut | ||||
| 1384 | |||||
| 1385 | sub getidcity { | ||||
| 1386 | my ($city_name) = @_; | ||||
| 1387 | my $dbh = C4::Context->dbh; | ||||
| 1388 | my $sth = $dbh->prepare("select cityid from cities where city_name=? "); | ||||
| 1389 | $sth->execute($city_name); | ||||
| 1390 | my $data = $sth->fetchrow; | ||||
| 1391 | return $data; | ||||
| 1392 | } | ||||
| 1393 | |||||
| 1394 | =head2 GetFirstValidEmailAddress | ||||
| 1395 | |||||
| 1396 | $email = GetFirstValidEmailAddress($borrowernumber); | ||||
| 1397 | |||||
| 1398 | Return the first valid email address for a borrower, given the borrowernumber. For now, the order | ||||
| 1399 | is defined as email, emailpro, B_email. Returns the empty string if the borrower has no email | ||||
| 1400 | addresses. | ||||
| 1401 | |||||
| 1402 | =cut | ||||
| 1403 | |||||
| 1404 | sub GetFirstValidEmailAddress { | ||||
| 1405 | my $borrowernumber = shift; | ||||
| 1406 | my $dbh = C4::Context->dbh; | ||||
| 1407 | my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? "); | ||||
| 1408 | $sth->execute( $borrowernumber ); | ||||
| 1409 | my $data = $sth->fetchrow_hashref; | ||||
| 1410 | |||||
| 1411 | if ($data->{'email'}) { | ||||
| 1412 | return $data->{'email'}; | ||||
| 1413 | } elsif ($data->{'emailpro'}) { | ||||
| 1414 | return $data->{'emailpro'}; | ||||
| 1415 | } elsif ($data->{'B_email'}) { | ||||
| 1416 | return $data->{'B_email'}; | ||||
| 1417 | } else { | ||||
| 1418 | return ''; | ||||
| 1419 | } | ||||
| 1420 | } | ||||
| 1421 | |||||
| 1422 | =head2 GetNoticeEmailAddress | ||||
| 1423 | |||||
| 1424 | $email = GetNoticeEmailAddress($borrowernumber); | ||||
| 1425 | |||||
| 1426 | Return the email address of borrower used for notices, given the borrowernumber. | ||||
| 1427 | Returns the empty string if no email address. | ||||
| 1428 | |||||
| 1429 | =cut | ||||
| 1430 | |||||
| 1431 | sub GetNoticeEmailAddress { | ||||
| 1432 | my $borrowernumber = shift; | ||||
| 1433 | |||||
| 1434 | my $which_address = C4::Context->preference("AutoEmailPrimaryAddress"); | ||||
| 1435 | # if syspref is set to 'first valid' (value == OFF), look up email address | ||||
| 1436 | if ( $which_address eq 'OFF' ) { | ||||
| 1437 | return GetFirstValidEmailAddress($borrowernumber); | ||||
| 1438 | } | ||||
| 1439 | # specified email address field | ||||
| 1440 | my $dbh = C4::Context->dbh; | ||||
| 1441 | my $sth = $dbh->prepare( qq{ | ||||
| 1442 | SELECT $which_address AS primaryemail | ||||
| 1443 | FROM borrowers | ||||
| 1444 | WHERE borrowernumber=? | ||||
| 1445 | } ); | ||||
| 1446 | $sth->execute($borrowernumber); | ||||
| 1447 | my $data = $sth->fetchrow_hashref; | ||||
| 1448 | return $data->{'primaryemail'} || ''; | ||||
| 1449 | } | ||||
| 1450 | |||||
| 1451 | =head2 GetExpiryDate | ||||
| 1452 | |||||
| 1453 | $expirydate = GetExpiryDate($categorycode, $dateenrolled); | ||||
| 1454 | |||||
| 1455 | Calculate expiry date given a categorycode and starting date. Date argument must be in ISO format. | ||||
| 1456 | Return date is also in ISO format. | ||||
| 1457 | |||||
| 1458 | =cut | ||||
| 1459 | |||||
| 1460 | sub GetExpiryDate { | ||||
| 1461 | my ( $categorycode, $dateenrolled ) = @_; | ||||
| 1462 | my $enrolments; | ||||
| 1463 | if ($categorycode) { | ||||
| 1464 | my $dbh = C4::Context->dbh; | ||||
| 1465 | my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?"); | ||||
| 1466 | $sth->execute($categorycode); | ||||
| 1467 | $enrolments = $sth->fetchrow_hashref; | ||||
| 1468 | } | ||||
| 1469 | # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n"; | ||||
| 1470 | my @date = split (/-/,$dateenrolled); | ||||
| 1471 | if($enrolments->{enrolmentperiod}){ | ||||
| 1472 | return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod})); | ||||
| 1473 | }else{ | ||||
| 1474 | return $enrolments->{enrolmentperioddate}; | ||||
| 1475 | } | ||||
| 1476 | } | ||||
| 1477 | |||||
| 1478 | =head2 GetUpcomingMembershipExpires | ||||
| 1479 | |||||
| 1480 | my $upcoming_mem_expires = GetUpcomingMembershipExpires(); | ||||
| 1481 | |||||
| 1482 | =cut | ||||
| 1483 | |||||
| 1484 | sub GetUpcomingMembershipExpires { | ||||
| 1485 | my $dbh = C4::Context->dbh; | ||||
| 1486 | my $days = C4::Context->preference("MembershipExpiryDaysNotice") || 0; | ||||
| 1487 | my $dateexpiry = output_pref({ dt => (dt_from_string()->add( days => $days)), dateformat => 'iso', dateonly => 1 }); | ||||
| 1488 | |||||
| 1489 | my $query = " | ||||
| 1490 | SELECT borrowers.*, categories.description, | ||||
| 1491 | branches.branchname, branches.branchemail FROM borrowers | ||||
| 1492 | LEFT JOIN branches on borrowers.branchcode = branches.branchcode | ||||
| 1493 | LEFT JOIN categories on borrowers.categorycode = categories.categorycode | ||||
| 1494 | WHERE dateexpiry = ?; | ||||
| 1495 | "; | ||||
| 1496 | my $sth = $dbh->prepare($query); | ||||
| 1497 | $sth->execute($dateexpiry); | ||||
| 1498 | my $results = $sth->fetchall_arrayref({}); | ||||
| 1499 | return $results; | ||||
| 1500 | } | ||||
| 1501 | |||||
| 1502 | =head2 GetborCatFromCatType | ||||
| 1503 | |||||
| 1504 | ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType(); | ||||
| 1505 | |||||
| 1506 | Looks up the different types of borrowers in the database. Returns two | ||||
| 1507 | elements: a reference-to-array, which lists the borrower category | ||||
| 1508 | codes, and a reference-to-hash, which maps the borrower category codes | ||||
| 1509 | to category descriptions. | ||||
| 1510 | |||||
| 1511 | =cut | ||||
| 1512 | |||||
| 1513 | #' | ||||
| 1514 | sub GetborCatFromCatType { | ||||
| 1515 | my ( $category_type, $action, $no_branch_limit ) = @_; | ||||
| 1516 | |||||
| 1517 | my $branch_limit = $no_branch_limit | ||||
| 1518 | ? 0 | ||||
| 1519 | : C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; | ||||
| 1520 | |||||
| 1521 | # FIXME - This API seems both limited and dangerous. | ||||
| 1522 | my $dbh = C4::Context->dbh; | ||||
| 1523 | |||||
| 1524 | my $request = qq{ | ||||
| 1525 | SELECT categories.categorycode, categories.description | ||||
| 1526 | FROM categories | ||||
| 1527 | }; | ||||
| 1528 | $request .= qq{ | ||||
| 1529 | LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode | ||||
| 1530 | } if $branch_limit; | ||||
| 1531 | if($action) { | ||||
| 1532 | $request .= " $action "; | ||||
| 1533 | $request .= " AND (branchcode = ? OR branchcode IS NULL) GROUP BY description" if $branch_limit; | ||||
| 1534 | } else { | ||||
| 1535 | $request .= " WHERE branchcode = ? OR branchcode IS NULL GROUP BY description" if $branch_limit; | ||||
| 1536 | } | ||||
| 1537 | $request .= " ORDER BY categorycode"; | ||||
| 1538 | |||||
| 1539 | my $sth = $dbh->prepare($request); | ||||
| 1540 | $sth->execute( | ||||
| 1541 | $action ? $category_type : (), | ||||
| 1542 | $branch_limit ? $branch_limit : () | ||||
| 1543 | ); | ||||
| 1544 | |||||
| 1545 | my %labels; | ||||
| 1546 | my @codes; | ||||
| 1547 | |||||
| 1548 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 1549 | push @codes, $data->{'categorycode'}; | ||||
| 1550 | $labels{ $data->{'categorycode'} } = $data->{'description'}; | ||||
| 1551 | } | ||||
| 1552 | $sth->finish; | ||||
| 1553 | return ( \@codes, \%labels ); | ||||
| 1554 | } | ||||
| 1555 | |||||
| 1556 | =head2 GetBorrowercategory | ||||
| 1557 | |||||
| 1558 | $hashref = &GetBorrowercategory($categorycode); | ||||
| 1559 | |||||
| 1560 | Given the borrower's category code, the function returns the corresponding | ||||
| 1561 | data hashref for a comprehensive information display. | ||||
| 1562 | |||||
| 1563 | =cut | ||||
| 1564 | |||||
| 1565 | sub GetBorrowercategory { | ||||
| 1566 | my ($catcode) = @_; | ||||
| 1567 | my $dbh = C4::Context->dbh; | ||||
| 1568 | if ($catcode){ | ||||
| 1569 | my $sth = | ||||
| 1570 | $dbh->prepare( | ||||
| 1571 | "SELECT description,dateofbirthrequired,upperagelimit,category_type | ||||
| 1572 | FROM categories | ||||
| 1573 | WHERE categorycode = ?" | ||||
| 1574 | ); | ||||
| 1575 | $sth->execute($catcode); | ||||
| 1576 | my $data = | ||||
| 1577 | $sth->fetchrow_hashref; | ||||
| 1578 | return $data; | ||||
| 1579 | } | ||||
| 1580 | return; | ||||
| 1581 | } # sub getborrowercategory | ||||
| 1582 | |||||
| 1583 | |||||
| 1584 | =head2 GetBorrowerCategorycode | ||||
| 1585 | |||||
| 1586 | $categorycode = &GetBorrowerCategoryCode( $borrowernumber ); | ||||
| 1587 | |||||
| 1588 | Given the borrowernumber, the function returns the corresponding categorycode | ||||
| 1589 | |||||
| 1590 | =cut | ||||
| 1591 | |||||
| 1592 | sub GetBorrowerCategorycode { | ||||
| 1593 | my ( $borrowernumber ) = @_; | ||||
| 1594 | my $dbh = C4::Context->dbh; | ||||
| 1595 | my $sth = $dbh->prepare( qq{ | ||||
| 1596 | SELECT categorycode | ||||
| 1597 | FROM borrowers | ||||
| 1598 | WHERE borrowernumber = ? | ||||
| 1599 | } ); | ||||
| 1600 | $sth->execute( $borrowernumber ); | ||||
| 1601 | return $sth->fetchrow; | ||||
| 1602 | } | ||||
| 1603 | |||||
| 1604 | =head2 GetBorrowercategoryList | ||||
| 1605 | |||||
| 1606 | $arrayref_hashref = &GetBorrowercategoryList; | ||||
| 1607 | If no category code provided, the function returns all the categories. | ||||
| 1608 | |||||
| 1609 | =cut | ||||
| 1610 | |||||
| 1611 | sub GetBorrowercategoryList { | ||||
| 1612 | my $no_branch_limit = @_ ? shift : 0; | ||||
| 1613 | my $branch_limit = $no_branch_limit | ||||
| 1614 | ? 0 | ||||
| 1615 | : C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; | ||||
| 1616 | my $dbh = C4::Context->dbh; | ||||
| 1617 | my $query = "SELECT categories.* FROM categories"; | ||||
| 1618 | $query .= qq{ | ||||
| 1619 | LEFT JOIN categories_branches ON categories.categorycode = categories_branches.categorycode | ||||
| 1620 | WHERE branchcode = ? OR branchcode IS NULL GROUP BY description | ||||
| 1621 | } if $branch_limit; | ||||
| 1622 | $query .= " ORDER BY description"; | ||||
| 1623 | my $sth = $dbh->prepare( $query ); | ||||
| 1624 | $sth->execute( $branch_limit ? $branch_limit : () ); | ||||
| 1625 | my $data = $sth->fetchall_arrayref( {} ); | ||||
| 1626 | $sth->finish; | ||||
| 1627 | return $data; | ||||
| 1628 | } # sub getborrowercategory | ||||
| 1629 | |||||
| 1630 | =head2 GetAge | ||||
| 1631 | |||||
| 1632 | $dateofbirth,$date = &GetAge($date); | ||||
| 1633 | |||||
| 1634 | this function return the borrowers age with the value of dateofbirth | ||||
| 1635 | |||||
| 1636 | =cut | ||||
| 1637 | |||||
| 1638 | #' | ||||
| 1639 | sub GetAge{ | ||||
| 1640 | my ( $date, $date_ref ) = @_; | ||||
| 1641 | |||||
| 1642 | if ( not defined $date_ref ) { | ||||
| 1643 | $date_ref = sprintf( '%04d-%02d-%02d', Today() ); | ||||
| 1644 | } | ||||
| 1645 | |||||
| 1646 | my ( $year1, $month1, $day1 ) = split /-/, $date; | ||||
| 1647 | my ( $year2, $month2, $day2 ) = split /-/, $date_ref; | ||||
| 1648 | |||||
| 1649 | my $age = $year2 - $year1; | ||||
| 1650 | if ( $month1 . $day1 > $month2 . $day2 ) { | ||||
| 1651 | $age--; | ||||
| 1652 | } | ||||
| 1653 | |||||
| 1654 | return $age; | ||||
| 1655 | } # sub get_age | ||||
| 1656 | |||||
| 1657 | =head2 SetAge | ||||
| 1658 | |||||
| 1659 | $borrower = C4::Members::SetAge($borrower, $datetimeduration); | ||||
| 1660 | $borrower = C4::Members::SetAge($borrower, '0015-12-10'); | ||||
| 1661 | $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference); | ||||
| 1662 | |||||
| 1663 | eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); }; | ||||
| 1664 | if ($@) {print $@;} #Catch a bad ISO Date or kill your script! | ||||
| 1665 | |||||
| 1666 | This function sets the borrower's dateofbirth to match the given age. | ||||
| 1667 | Optionally relative to the given $datetime_reference. | ||||
| 1668 | |||||
| 1669 | @PARAM1 koha.borrowers-object | ||||
| 1670 | @PARAM2 DateTime::Duration-object as the desired age | ||||
| 1671 | OR a ISO 8601 Date. (To make the API more pleasant) | ||||
| 1672 | @PARAM3 DateTime-object as the relative date, defaults to now(). | ||||
| 1673 | RETURNS The given borrower reference @PARAM1. | ||||
| 1674 | DIES If there was an error with the ISO Date handling. | ||||
| 1675 | |||||
| 1676 | =cut | ||||
| 1677 | |||||
| 1678 | #' | ||||
| 1679 | sub SetAge{ | ||||
| 1680 | my ( $borrower, $datetimeduration, $datetime_ref ) = @_; | ||||
| 1681 | $datetime_ref = DateTime->now() unless $datetime_ref; | ||||
| 1682 | |||||
| 1683 | if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') { | ||||
| 1684 | if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) { | ||||
| 1685 | $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3); | ||||
| 1686 | } | ||||
| 1687 | else { | ||||
| 1688 | die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n"; | ||||
| 1689 | } | ||||
| 1690 | } | ||||
| 1691 | |||||
| 1692 | my $new_datetime_ref = $datetime_ref->clone(); | ||||
| 1693 | $new_datetime_ref->subtract_duration( $datetimeduration ); | ||||
| 1694 | |||||
| 1695 | $borrower->{dateofbirth} = $new_datetime_ref->ymd(); | ||||
| 1696 | |||||
| 1697 | return $borrower; | ||||
| 1698 | } # sub SetAge | ||||
| 1699 | |||||
| 1700 | =head2 GetCities | ||||
| 1701 | |||||
| 1702 | $cityarrayref = GetCities(); | ||||
| 1703 | |||||
| 1704 | Returns an array_ref of the entries in the cities table | ||||
| 1705 | If there are entries in the table an empty row is returned | ||||
| 1706 | This is currently only used to populate a popup in memberentry | ||||
| 1707 | |||||
| 1708 | =cut | ||||
| 1709 | |||||
| 1710 | sub GetCities { | ||||
| 1711 | |||||
| 1712 | my $dbh = C4::Context->dbh; | ||||
| 1713 | my $city_arr = $dbh->selectall_arrayref( | ||||
| 1714 | q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|, | ||||
| 1715 | { Slice => {} }); | ||||
| 1716 | if ( @{$city_arr} ) { | ||||
| 1717 | unshift @{$city_arr}, { | ||||
| 1718 | city_zipcode => q{}, | ||||
| 1719 | city_name => q{}, | ||||
| 1720 | cityid => q{}, | ||||
| 1721 | city_state => q{}, | ||||
| 1722 | city_country => q{}, | ||||
| 1723 | }; | ||||
| 1724 | } | ||||
| 1725 | |||||
| 1726 | return $city_arr; | ||||
| 1727 | } | ||||
| 1728 | |||||
| 1729 | =head2 GetSortDetails (OUEST-PROVENCE) | ||||
| 1730 | |||||
| 1731 | ($lib) = &GetSortDetails($category,$sortvalue); | ||||
| 1732 | |||||
| 1733 | Returns the authorized value details | ||||
| 1734 | C<&$lib>return value of authorized value details | ||||
| 1735 | C<&$sortvalue>this is the value of authorized value | ||||
| 1736 | C<&$category>this is the value of authorized value category | ||||
| 1737 | |||||
| 1738 | =cut | ||||
| 1739 | |||||
| 1740 | sub GetSortDetails { | ||||
| 1741 | my ( $category, $sortvalue ) = @_; | ||||
| 1742 | my $dbh = C4::Context->dbh; | ||||
| 1743 | my $query = qq|SELECT lib | ||||
| 1744 | FROM authorised_values | ||||
| 1745 | WHERE category=? | ||||
| 1746 | AND authorised_value=? |; | ||||
| 1747 | my $sth = $dbh->prepare($query); | ||||
| 1748 | $sth->execute( $category, $sortvalue ); | ||||
| 1749 | my $lib = $sth->fetchrow; | ||||
| 1750 | return ($lib) if ($lib); | ||||
| 1751 | return ($sortvalue) unless ($lib); | ||||
| 1752 | } | ||||
| 1753 | |||||
| 1754 | =head2 MoveMemberToDeleted | ||||
| 1755 | |||||
| 1756 | $result = &MoveMemberToDeleted($borrowernumber); | ||||
| 1757 | |||||
| 1758 | Copy the record from borrowers to deletedborrowers table. | ||||
| 1759 | The routine returns 1 for success, undef for failure. | ||||
| 1760 | |||||
| 1761 | =cut | ||||
| 1762 | |||||
| 1763 | sub MoveMemberToDeleted { | ||||
| 1764 | my ($member) = shift or return; | ||||
| 1765 | |||||
| 1766 | my $schema = Koha::Database->new()->schema(); | ||||
| 1767 | my $borrowers_rs = $schema->resultset('Borrower'); | ||||
| 1768 | $borrowers_rs->result_class('DBIx::Class::ResultClass::HashRefInflator'); | ||||
| 1769 | my $borrower = $borrowers_rs->find($member); | ||||
| 1770 | return unless $borrower; | ||||
| 1771 | |||||
| 1772 | my $deleted = $schema->resultset('Deletedborrower')->create($borrower); | ||||
| 1773 | |||||
| 1774 | return $deleted ? 1 : undef; | ||||
| 1775 | } | ||||
| 1776 | |||||
| 1777 | =head2 DelMember | ||||
| 1778 | |||||
| 1779 | DelMember($borrowernumber); | ||||
| 1780 | |||||
| 1781 | This function remove directly a borrower whitout writing it on deleteborrower. | ||||
| 1782 | + Deletes reserves for the borrower | ||||
| 1783 | |||||
| 1784 | =cut | ||||
| 1785 | |||||
| 1786 | sub DelMember { | ||||
| 1787 | my $dbh = C4::Context->dbh; | ||||
| 1788 | my $borrowernumber = shift; | ||||
| 1789 | #warn "in delmember with $borrowernumber"; | ||||
| 1790 | return unless $borrowernumber; # borrowernumber is mandatory. | ||||
| 1791 | |||||
| 1792 | my $query = qq|DELETE | ||||
| 1793 | FROM reserves | ||||
| 1794 | WHERE borrowernumber=?|; | ||||
| 1795 | my $sth = $dbh->prepare($query); | ||||
| 1796 | $sth->execute($borrowernumber); | ||||
| 1797 | $query = " | ||||
| 1798 | DELETE | ||||
| 1799 | FROM borrowers | ||||
| 1800 | WHERE borrowernumber = ? | ||||
| 1801 | "; | ||||
| 1802 | $sth = $dbh->prepare($query); | ||||
| 1803 | $sth->execute($borrowernumber); | ||||
| 1804 | logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog"); | ||||
| 1805 | return $sth->rows; | ||||
| 1806 | } | ||||
| 1807 | |||||
| 1808 | =head2 HandleDelBorrower | ||||
| 1809 | |||||
| 1810 | HandleDelBorrower($borrower); | ||||
| 1811 | |||||
| 1812 | When a member is deleted (DelMember in Members.pm), you should call me first. | ||||
| 1813 | This routine deletes/moves lists and entries for the deleted member/borrower. | ||||
| 1814 | Lists owned by the borrower are deleted, but entries from the borrower to | ||||
| 1815 | other lists are kept. | ||||
| 1816 | |||||
| 1817 | =cut | ||||
| 1818 | |||||
| 1819 | sub HandleDelBorrower { | ||||
| 1820 | my ($borrower)= @_; | ||||
| 1821 | my $query; | ||||
| 1822 | my $dbh = C4::Context->dbh; | ||||
| 1823 | |||||
| 1824 | #Delete all lists and all shares of this borrower | ||||
| 1825 | #Consistent with the approach Koha uses on deleting individual lists | ||||
| 1826 | #Note that entries in virtualshelfcontents added by this borrower to | ||||
| 1827 | #lists of others will be handled by a table constraint: the borrower | ||||
| 1828 | #is set to NULL in those entries. | ||||
| 1829 | $query="DELETE FROM virtualshelves WHERE owner=?"; | ||||
| 1830 | $dbh->do($query,undef,($borrower)); | ||||
| 1831 | |||||
| 1832 | #NOTE: | ||||
| 1833 | #We could handle the above deletes via a constraint too. | ||||
| 1834 | #But a new BZ report 11889 has been opened to discuss another approach. | ||||
| 1835 | #Instead of deleting we could also disown lists (based on a pref). | ||||
| 1836 | #In that way we could save shared and public lists. | ||||
| 1837 | #The current table constraints support that idea now. | ||||
| 1838 | #This pref should then govern the results of other routines/methods such as | ||||
| 1839 | #Koha::Virtualshelf->new->delete too. | ||||
| 1840 | } | ||||
| 1841 | |||||
| 1842 | =head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE) | ||||
| 1843 | |||||
| 1844 | $date = ExtendMemberSubscriptionTo($borrowerid, $date); | ||||
| 1845 | |||||
| 1846 | Extending the subscription to a given date or to the expiry date calculated on ISO date. | ||||
| 1847 | Returns ISO date. | ||||
| 1848 | |||||
| 1849 | =cut | ||||
| 1850 | |||||
| 1851 | sub ExtendMemberSubscriptionTo { | ||||
| 1852 | my ( $borrowerid,$date) = @_; | ||||
| 1853 | my $dbh = C4::Context->dbh; | ||||
| 1854 | my $borrower = GetMember('borrowernumber'=>$borrowerid); | ||||
| 1855 | unless ($date){ | ||||
| 1856 | $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ? | ||||
| 1857 | eval { output_pref( { dt => dt_from_string( $borrower->{'dateexpiry'} ), dateonly => 1, dateformat => 'iso' } ); } | ||||
| 1858 | : | ||||
| 1859 | output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } ); | ||||
| 1860 | $date = GetExpiryDate( $borrower->{'categorycode'}, $date ); | ||||
| 1861 | } | ||||
| 1862 | my $sth = $dbh->do(<<EOF); | ||||
| 1863 | UPDATE borrowers | ||||
| 1864 | SET dateexpiry='$date' | ||||
| 1865 | WHERE borrowernumber='$borrowerid' | ||||
| 1866 | EOF | ||||
| 1867 | |||||
| 1868 | AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} ); | ||||
| 1869 | |||||
| 1870 | logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog"); | ||||
| 1871 | return $date if ($sth); | ||||
| 1872 | return 0; | ||||
| 1873 | } | ||||
| 1874 | |||||
| 1875 | =head2 GetTitles (OUEST-PROVENCE) | ||||
| 1876 | |||||
| 1877 | ($borrowertitle)= &GetTitles(); | ||||
| 1878 | |||||
| 1879 | Looks up the different title . Returns array with all borrowers title | ||||
| 1880 | |||||
| 1881 | =cut | ||||
| 1882 | |||||
| 1883 | sub GetTitles { | ||||
| 1884 | my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles')); | ||||
| 1885 | unshift( @borrowerTitle, "" ); | ||||
| 1886 | my $count=@borrowerTitle; | ||||
| 1887 | if ($count == 1){ | ||||
| 1888 | return (); | ||||
| 1889 | } | ||||
| 1890 | else { | ||||
| 1891 | return ( \@borrowerTitle); | ||||
| 1892 | } | ||||
| 1893 | } | ||||
| 1894 | |||||
| 1895 | =head2 GetPatronImage | ||||
| 1896 | |||||
| 1897 | my ($imagedata, $dberror) = GetPatronImage($borrowernumber); | ||||
| 1898 | |||||
| 1899 | Returns the mimetype and binary image data of the image for the patron with the supplied borrowernumber. | ||||
| 1900 | |||||
| 1901 | =cut | ||||
| 1902 | |||||
| 1903 | sub GetPatronImage { | ||||
| 1904 | my ($borrowernumber) = @_; | ||||
| 1905 | warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug; | ||||
| 1906 | my $dbh = C4::Context->dbh; | ||||
| 1907 | my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE borrowernumber = ?'; | ||||
| 1908 | my $sth = $dbh->prepare($query); | ||||
| 1909 | $sth->execute($borrowernumber); | ||||
| 1910 | my $imagedata = $sth->fetchrow_hashref; | ||||
| 1911 | warn "Database error!" if $sth->errstr; | ||||
| 1912 | return $imagedata, $sth->errstr; | ||||
| 1913 | } | ||||
| 1914 | |||||
| 1915 | =head2 PutPatronImage | ||||
| 1916 | |||||
| 1917 | PutPatronImage($cardnumber, $mimetype, $imgfile); | ||||
| 1918 | |||||
| 1919 | Stores patron binary image data and mimetype in database. | ||||
| 1920 | NOTE: This function is good for updating images as well as inserting new images in the database. | ||||
| 1921 | |||||
| 1922 | =cut | ||||
| 1923 | |||||
| 1924 | sub PutPatronImage { | ||||
| 1925 | my ($cardnumber, $mimetype, $imgfile) = @_; | ||||
| 1926 | warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug; | ||||
| 1927 | my $dbh = C4::Context->dbh; | ||||
| 1928 | my $query = "INSERT INTO patronimage (borrowernumber, mimetype, imagefile) VALUES ( ( SELECT borrowernumber from borrowers WHERE cardnumber = ? ),?,?) ON DUPLICATE KEY UPDATE imagefile = ?;"; | ||||
| 1929 | my $sth = $dbh->prepare($query); | ||||
| 1930 | $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile); | ||||
| 1931 | warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr; | ||||
| 1932 | return $sth->errstr; | ||||
| 1933 | } | ||||
| 1934 | |||||
| 1935 | =head2 RmPatronImage | ||||
| 1936 | |||||
| 1937 | my ($dberror) = RmPatronImage($borrowernumber); | ||||
| 1938 | |||||
| 1939 | Removes the image for the patron with the supplied borrowernumber. | ||||
| 1940 | |||||
| 1941 | =cut | ||||
| 1942 | |||||
| 1943 | sub RmPatronImage { | ||||
| 1944 | my ($borrowernumber) = @_; | ||||
| 1945 | warn "Borrowernumber passed to GetPatronImage is $borrowernumber" if $debug; | ||||
| 1946 | my $dbh = C4::Context->dbh; | ||||
| 1947 | my $query = "DELETE FROM patronimage WHERE borrowernumber = ?;"; | ||||
| 1948 | my $sth = $dbh->prepare($query); | ||||
| 1949 | $sth->execute($borrowernumber); | ||||
| 1950 | my $dberror = $sth->errstr; | ||||
| 1951 | warn "Database error!" if $sth->errstr; | ||||
| 1952 | return $dberror; | ||||
| 1953 | } | ||||
| 1954 | |||||
| 1955 | =head2 GetHideLostItemsPreference | ||||
| 1956 | |||||
| 1957 | $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber); | ||||
| 1958 | |||||
| 1959 | Returns the HideLostItems preference for the patron category of the supplied borrowernumber | ||||
| 1960 | C<&$hidelostitemspref>return value of function, 0 or 1 | ||||
| 1961 | |||||
| 1962 | =cut | ||||
| 1963 | |||||
| 1964 | sub GetHideLostItemsPreference { | ||||
| 1965 | my ($borrowernumber) = @_; | ||||
| 1966 | my $dbh = C4::Context->dbh; | ||||
| 1967 | my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?"; | ||||
| 1968 | my $sth = $dbh->prepare($query); | ||||
| 1969 | $sth->execute($borrowernumber); | ||||
| 1970 | my $hidelostitems = $sth->fetchrow; | ||||
| 1971 | return $hidelostitems; | ||||
| 1972 | } | ||||
| 1973 | |||||
| 1974 | =head2 GetBorrowersToExpunge | ||||
| 1975 | |||||
| 1976 | $borrowers = &GetBorrowersToExpunge( | ||||
| 1977 | not_borrowered_since => $not_borrowered_since, | ||||
| 1978 | expired_before => $expired_before, | ||||
| 1979 | category_code => $category_code, | ||||
| 1980 | branchcode => $branchcode | ||||
| 1981 | ); | ||||
| 1982 | |||||
| 1983 | This function get all borrowers based on the given criteria. | ||||
| 1984 | |||||
| 1985 | =cut | ||||
| 1986 | |||||
| 1987 | sub GetBorrowersToExpunge { | ||||
| 1988 | my $params = shift; | ||||
| 1989 | |||||
| 1990 | my $filterdate = $params->{'not_borrowered_since'}; | ||||
| 1991 | my $filterexpiry = $params->{'expired_before'}; | ||||
| 1992 | my $filtercategory = $params->{'category_code'}; | ||||
| 1993 | my $filterbranch = $params->{'branchcode'} || | ||||
| 1994 | ((C4::Context->preference('IndependentBranches') | ||||
| 1995 | && C4::Context->userenv | ||||
| 1996 | && !C4::Context->IsSuperLibrarian() | ||||
| 1997 | && C4::Context->userenv->{branch}) | ||||
| 1998 | ? C4::Context->userenv->{branch} | ||||
| 1999 | : ""); | ||||
| 2000 | |||||
| 2001 | my $dbh = C4::Context->dbh; | ||||
| 2002 | my $query = q| | ||||
| 2003 | SELECT borrowers.borrowernumber, | ||||
| 2004 | MAX(old_issues.timestamp) AS latestissue, | ||||
| 2005 | MAX(issues.timestamp) AS currentissue | ||||
| 2006 | FROM borrowers | ||||
| 2007 | JOIN categories USING (categorycode) | ||||
| 2008 | LEFT JOIN ( | ||||
| 2009 | SELECT guarantorid | ||||
| 2010 | FROM borrowers | ||||
| 2011 | WHERE guarantorid IS NOT NULL | ||||
| 2012 | AND guarantorid <> 0 | ||||
| 2013 | ) as tmp ON borrowers.borrowernumber=tmp.guarantorid | ||||
| 2014 | LEFT JOIN old_issues USING (borrowernumber) | ||||
| 2015 | LEFT JOIN issues USING (borrowernumber) | ||||
| 2016 | WHERE category_type <> 'S' | ||||
| 2017 | AND tmp.guarantorid IS NULL | ||||
| 2018 | |; | ||||
| 2019 | |||||
| 2020 | my @query_params; | ||||
| 2021 | if ( $filterbranch && $filterbranch ne "" ) { | ||||
| 2022 | $query.= " AND borrowers.branchcode = ? "; | ||||
| 2023 | push( @query_params, $filterbranch ); | ||||
| 2024 | } | ||||
| 2025 | if ( $filterexpiry ) { | ||||
| 2026 | $query .= " AND dateexpiry < ? "; | ||||
| 2027 | push( @query_params, $filterexpiry ); | ||||
| 2028 | } | ||||
| 2029 | if ( $filtercategory ) { | ||||
| 2030 | $query .= " AND categorycode = ? "; | ||||
| 2031 | push( @query_params, $filtercategory ); | ||||
| 2032 | } | ||||
| 2033 | $query.=" GROUP BY borrowers.borrowernumber HAVING currentissue IS NULL "; | ||||
| 2034 | if ( $filterdate ) { | ||||
| 2035 | $query.=" AND ( latestissue < ? OR latestissue IS NULL ) "; | ||||
| 2036 | push @query_params,$filterdate; | ||||
| 2037 | } | ||||
| 2038 | warn $query if $debug; | ||||
| 2039 | |||||
| 2040 | my $sth = $dbh->prepare($query); | ||||
| 2041 | if (scalar(@query_params)>0){ | ||||
| 2042 | $sth->execute(@query_params); | ||||
| 2043 | } | ||||
| 2044 | else { | ||||
| 2045 | $sth->execute; | ||||
| 2046 | } | ||||
| 2047 | |||||
| 2048 | my @results; | ||||
| 2049 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 2050 | push @results, $data; | ||||
| 2051 | } | ||||
| 2052 | return \@results; | ||||
| 2053 | } | ||||
| 2054 | |||||
| 2055 | =head2 GetBorrowersWhoHaveNeverBorrowed | ||||
| 2056 | |||||
| 2057 | $results = &GetBorrowersWhoHaveNeverBorrowed | ||||
| 2058 | |||||
| 2059 | This function get all borrowers who have never borrowed. | ||||
| 2060 | |||||
| 2061 | I<$result> is a ref to an array which all elements are a hasref. | ||||
| 2062 | |||||
| 2063 | =cut | ||||
| 2064 | |||||
| 2065 | sub GetBorrowersWhoHaveNeverBorrowed { | ||||
| 2066 | my $filterbranch = shift || | ||||
| 2067 | ((C4::Context->preference('IndependentBranches') | ||||
| 2068 | && C4::Context->userenv | ||||
| 2069 | && !C4::Context->IsSuperLibrarian() | ||||
| 2070 | && C4::Context->userenv->{branch}) | ||||
| 2071 | ? C4::Context->userenv->{branch} | ||||
| 2072 | : ""); | ||||
| 2073 | my $dbh = C4::Context->dbh; | ||||
| 2074 | my $query = " | ||||
| 2075 | SELECT borrowers.borrowernumber,max(timestamp) as latestissue | ||||
| 2076 | FROM borrowers | ||||
| 2077 | LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber | ||||
| 2078 | WHERE issues.borrowernumber IS NULL | ||||
| 2079 | "; | ||||
| 2080 | my @query_params; | ||||
| 2081 | if ($filterbranch && $filterbranch ne ""){ | ||||
| 2082 | $query.=" AND borrowers.branchcode= ?"; | ||||
| 2083 | push @query_params,$filterbranch; | ||||
| 2084 | } | ||||
| 2085 | warn $query if $debug; | ||||
| 2086 | |||||
| 2087 | my $sth = $dbh->prepare($query); | ||||
| 2088 | if (scalar(@query_params)>0){ | ||||
| 2089 | $sth->execute(@query_params); | ||||
| 2090 | } | ||||
| 2091 | else { | ||||
| 2092 | $sth->execute; | ||||
| 2093 | } | ||||
| 2094 | |||||
| 2095 | my @results; | ||||
| 2096 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 2097 | push @results, $data; | ||||
| 2098 | } | ||||
| 2099 | return \@results; | ||||
| 2100 | } | ||||
| 2101 | |||||
| 2102 | =head2 GetBorrowersWithIssuesHistoryOlderThan | ||||
| 2103 | |||||
| 2104 | $results = &GetBorrowersWithIssuesHistoryOlderThan($date) | ||||
| 2105 | |||||
| 2106 | this function get all borrowers who has an issue history older than I<$date> given on input arg. | ||||
| 2107 | |||||
| 2108 | I<$result> is a ref to an array which all elements are a hashref. | ||||
| 2109 | This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber. | ||||
| 2110 | |||||
| 2111 | =cut | ||||
| 2112 | |||||
| 2113 | sub GetBorrowersWithIssuesHistoryOlderThan { | ||||
| 2114 | my $dbh = C4::Context->dbh; | ||||
| 2115 | my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime()); | ||||
| 2116 | my $filterbranch = shift || | ||||
| 2117 | ((C4::Context->preference('IndependentBranches') | ||||
| 2118 | && C4::Context->userenv | ||||
| 2119 | && !C4::Context->IsSuperLibrarian() | ||||
| 2120 | && C4::Context->userenv->{branch}) | ||||
| 2121 | ? C4::Context->userenv->{branch} | ||||
| 2122 | : ""); | ||||
| 2123 | my $query = " | ||||
| 2124 | SELECT count(borrowernumber) as n,borrowernumber | ||||
| 2125 | FROM old_issues | ||||
| 2126 | WHERE returndate < ? | ||||
| 2127 | AND borrowernumber IS NOT NULL | ||||
| 2128 | "; | ||||
| 2129 | my @query_params; | ||||
| 2130 | push @query_params, $date; | ||||
| 2131 | if ($filterbranch){ | ||||
| 2132 | $query.=" AND branchcode = ?"; | ||||
| 2133 | push @query_params, $filterbranch; | ||||
| 2134 | } | ||||
| 2135 | $query.=" GROUP BY borrowernumber "; | ||||
| 2136 | warn $query if $debug; | ||||
| 2137 | my $sth = $dbh->prepare($query); | ||||
| 2138 | $sth->execute(@query_params); | ||||
| 2139 | my @results; | ||||
| 2140 | |||||
| 2141 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 2142 | push @results, $data; | ||||
| 2143 | } | ||||
| 2144 | return \@results; | ||||
| 2145 | } | ||||
| 2146 | |||||
| 2147 | =head2 GetBorrowersNamesAndLatestIssue | ||||
| 2148 | |||||
| 2149 | $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers) | ||||
| 2150 | |||||
| 2151 | this function get borrowers Names and surnames and Issue information. | ||||
| 2152 | |||||
| 2153 | I<@borrowernumbers> is an array which all elements are borrowernumbers. | ||||
| 2154 | This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber. | ||||
| 2155 | |||||
| 2156 | =cut | ||||
| 2157 | |||||
| 2158 | sub GetBorrowersNamesAndLatestIssue { | ||||
| 2159 | my $dbh = C4::Context->dbh; | ||||
| 2160 | my @borrowernumbers=@_; | ||||
| 2161 | my $query = " | ||||
| 2162 | SELECT surname,lastname, phone, email,max(timestamp) | ||||
| 2163 | FROM borrowers | ||||
| 2164 | LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber | ||||
| 2165 | GROUP BY borrowernumber | ||||
| 2166 | "; | ||||
| 2167 | my $sth = $dbh->prepare($query); | ||||
| 2168 | $sth->execute; | ||||
| 2169 | my $results = $sth->fetchall_arrayref({}); | ||||
| 2170 | return $results; | ||||
| 2171 | } | ||||
| 2172 | |||||
| 2173 | =head2 ModPrivacy | ||||
| 2174 | |||||
| 2175 | my $success = ModPrivacy( $borrowernumber, $privacy ); | ||||
| 2176 | |||||
| 2177 | Update the privacy of a patron. | ||||
| 2178 | |||||
| 2179 | return : | ||||
| 2180 | true on success, false on failure | ||||
| 2181 | |||||
| 2182 | =cut | ||||
| 2183 | |||||
| 2184 | sub ModPrivacy { | ||||
| 2185 | my $borrowernumber = shift; | ||||
| 2186 | my $privacy = shift; | ||||
| 2187 | return unless defined $borrowernumber; | ||||
| 2188 | return unless $borrowernumber =~ /^\d+$/; | ||||
| 2189 | |||||
| 2190 | return ModMember( borrowernumber => $borrowernumber, | ||||
| 2191 | privacy => $privacy ); | ||||
| 2192 | } | ||||
| 2193 | |||||
| 2194 | =head2 AddMessage | ||||
| 2195 | |||||
| 2196 | AddMessage( $borrowernumber, $message_type, $message, $branchcode ); | ||||
| 2197 | |||||
| 2198 | Adds a message to the messages table for the given borrower. | ||||
| 2199 | |||||
| 2200 | Returns: | ||||
| 2201 | True on success | ||||
| 2202 | False on failure | ||||
| 2203 | |||||
| 2204 | =cut | ||||
| 2205 | |||||
| 2206 | sub AddMessage { | ||||
| 2207 | my ( $borrowernumber, $message_type, $message, $branchcode ) = @_; | ||||
| 2208 | |||||
| 2209 | my $dbh = C4::Context->dbh; | ||||
| 2210 | |||||
| 2211 | if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) { | ||||
| 2212 | return; | ||||
| 2213 | } | ||||
| 2214 | |||||
| 2215 | my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )"; | ||||
| 2216 | my $sth = $dbh->prepare($query); | ||||
| 2217 | $sth->execute( $borrowernumber, $branchcode, $message_type, $message ); | ||||
| 2218 | logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog"); | ||||
| 2219 | return 1; | ||||
| 2220 | } | ||||
| 2221 | |||||
| 2222 | =head2 GetMessages | ||||
| 2223 | |||||
| 2224 | GetMessages( $borrowernumber, $type ); | ||||
| 2225 | |||||
| 2226 | $type is message type, B for borrower, or L for Librarian. | ||||
| 2227 | Empty type returns all messages of any type. | ||||
| 2228 | |||||
| 2229 | Returns all messages for the given borrowernumber | ||||
| 2230 | |||||
| 2231 | =cut | ||||
| 2232 | |||||
| 2233 | sub GetMessages { | ||||
| 2234 | my ( $borrowernumber, $type, $branchcode ) = @_; | ||||
| 2235 | |||||
| 2236 | if ( ! $type ) { | ||||
| 2237 | $type = '%'; | ||||
| 2238 | } | ||||
| 2239 | |||||
| 2240 | my $dbh = C4::Context->dbh; | ||||
| 2241 | |||||
| 2242 | my $query = "SELECT | ||||
| 2243 | branches.branchname, | ||||
| 2244 | messages.*, | ||||
| 2245 | message_date, | ||||
| 2246 | messages.branchcode LIKE '$branchcode' AS can_delete | ||||
| 2247 | FROM messages, branches | ||||
| 2248 | WHERE borrowernumber = ? | ||||
| 2249 | AND message_type LIKE ? | ||||
| 2250 | AND messages.branchcode = branches.branchcode | ||||
| 2251 | ORDER BY message_date DESC"; | ||||
| 2252 | my $sth = $dbh->prepare($query); | ||||
| 2253 | $sth->execute( $borrowernumber, $type ) ; | ||||
| 2254 | my @results; | ||||
| 2255 | |||||
| 2256 | while ( my $data = $sth->fetchrow_hashref ) { | ||||
| 2257 | $data->{message_date_formatted} = output_pref( { dt => dt_from_string( $data->{message_date} ), dateonly => 1, dateformat => 'iso' } ); | ||||
| 2258 | push @results, $data; | ||||
| 2259 | } | ||||
| 2260 | return \@results; | ||||
| 2261 | |||||
| 2262 | } | ||||
| 2263 | |||||
| 2264 | =head2 GetMessages | ||||
| 2265 | |||||
| 2266 | GetMessagesCount( $borrowernumber, $type ); | ||||
| 2267 | |||||
| 2268 | $type is message type, B for borrower, or L for Librarian. | ||||
| 2269 | Empty type returns all messages of any type. | ||||
| 2270 | |||||
| 2271 | Returns the number of messages for the given borrowernumber | ||||
| 2272 | |||||
| 2273 | =cut | ||||
| 2274 | |||||
| 2275 | sub GetMessagesCount { | ||||
| 2276 | my ( $borrowernumber, $type, $branchcode ) = @_; | ||||
| 2277 | |||||
| 2278 | if ( ! $type ) { | ||||
| 2279 | $type = '%'; | ||||
| 2280 | } | ||||
| 2281 | |||||
| 2282 | my $dbh = C4::Context->dbh; | ||||
| 2283 | |||||
| 2284 | my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?"; | ||||
| 2285 | my $sth = $dbh->prepare($query); | ||||
| 2286 | $sth->execute( $borrowernumber, $type ) ; | ||||
| 2287 | my @results; | ||||
| 2288 | |||||
| 2289 | my $data = $sth->fetchrow_hashref; | ||||
| 2290 | my $count = $data->{'MsgCount'}; | ||||
| 2291 | |||||
| 2292 | return $count; | ||||
| 2293 | } | ||||
| 2294 | |||||
| - - | |||||
| 2297 | =head2 DeleteMessage | ||||
| 2298 | |||||
| 2299 | DeleteMessage( $message_id ); | ||||
| 2300 | |||||
| 2301 | =cut | ||||
| 2302 | |||||
| 2303 | sub DeleteMessage { | ||||
| 2304 | my ( $message_id ) = @_; | ||||
| 2305 | |||||
| 2306 | my $dbh = C4::Context->dbh; | ||||
| 2307 | my $query = "SELECT * FROM messages WHERE message_id = ?"; | ||||
| 2308 | my $sth = $dbh->prepare($query); | ||||
| 2309 | $sth->execute( $message_id ); | ||||
| 2310 | my $message = $sth->fetchrow_hashref(); | ||||
| 2311 | |||||
| 2312 | $query = "DELETE FROM messages WHERE message_id = ?"; | ||||
| 2313 | $sth = $dbh->prepare($query); | ||||
| 2314 | $sth->execute( $message_id ); | ||||
| 2315 | logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog"); | ||||
| 2316 | } | ||||
| 2317 | |||||
| 2318 | =head2 IssueSlip | ||||
| 2319 | |||||
| 2320 | IssueSlip($branchcode, $borrowernumber, $quickslip) | ||||
| 2321 | |||||
| 2322 | Returns letter hash ( see C4::Letters::GetPreparedLetter ) | ||||
| 2323 | |||||
| 2324 | $quickslip is boolean, to indicate whether we want a quick slip | ||||
| 2325 | |||||
| 2326 | IssueSlip populates ISSUESLIP and ISSUEQSLIP, and will make the following expansions: | ||||
| 2327 | |||||
| 2328 | Both slips: | ||||
| 2329 | |||||
| 2330 | <<branches.*>> | ||||
| 2331 | <<borrowers.*>> | ||||
| 2332 | |||||
| 2333 | ISSUESLIP: | ||||
| 2334 | |||||
| 2335 | <checkedout> | ||||
| 2336 | <<biblio.*>> | ||||
| 2337 | <<items.*>> | ||||
| 2338 | <<biblioitems.*>> | ||||
| 2339 | <<issues.*>> | ||||
| 2340 | </checkedout> | ||||
| 2341 | |||||
| 2342 | <overdue> | ||||
| 2343 | <<biblio.*>> | ||||
| 2344 | <<items.*>> | ||||
| 2345 | <<biblioitems.*>> | ||||
| 2346 | <<issues.*>> | ||||
| 2347 | </overdue> | ||||
| 2348 | |||||
| 2349 | <news> | ||||
| 2350 | <<opac_news.*>> | ||||
| 2351 | </news> | ||||
| 2352 | |||||
| 2353 | ISSUEQSLIP: | ||||
| 2354 | |||||
| 2355 | <checkedout> | ||||
| 2356 | <<biblio.*>> | ||||
| 2357 | <<items.*>> | ||||
| 2358 | <<biblioitems.*>> | ||||
| 2359 | <<issues.*>> | ||||
| 2360 | </checkedout> | ||||
| 2361 | |||||
| 2362 | NOTE: Not all table fields are available, pleasee see GetPendingIssues for a list of available fields. | ||||
| 2363 | |||||
| 2364 | =cut | ||||
| 2365 | |||||
| 2366 | sub IssueSlip { | ||||
| 2367 | my ($branch, $borrowernumber, $quickslip) = @_; | ||||
| 2368 | |||||
| 2369 | # FIXME Check callers before removing this statement | ||||
| 2370 | #return unless $borrowernumber; | ||||
| 2371 | |||||
| 2372 | my @issues = @{ GetPendingIssues($borrowernumber) }; | ||||
| 2373 | |||||
| 2374 | for my $issue (@issues) { | ||||
| 2375 | $issue->{date_due} = $issue->{date_due_sql}; | ||||
| 2376 | if ($quickslip) { | ||||
| 2377 | my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 }); | ||||
| 2378 | if ( substr( $issue->{issuedate}, 0, 10 ) eq $today | ||||
| 2379 | or substr( $issue->{lastreneweddate}, 0, 10 ) eq $today ) { | ||||
| 2380 | $issue->{now} = 1; | ||||
| 2381 | }; | ||||
| 2382 | } | ||||
| 2383 | } | ||||
| 2384 | |||||
| 2385 | # Sort on timestamp then on issuedate (useful for tests and could be if modified in a batch | ||||
| 2386 | @issues = sort { | ||||
| 2387 | my $s = $b->{timestamp} <=> $a->{timestamp}; | ||||
| 2388 | $s == 0 ? | ||||
| 2389 | $b->{issuedate} <=> $a->{issuedate} : $s; | ||||
| 2390 | } @issues; | ||||
| 2391 | |||||
| 2392 | my ($letter_code, %repeat); | ||||
| 2393 | if ( $quickslip ) { | ||||
| 2394 | $letter_code = 'ISSUEQSLIP'; | ||||
| 2395 | %repeat = ( | ||||
| 2396 | 'checkedout' => [ map { | ||||
| 2397 | 'biblio' => $_, | ||||
| 2398 | 'items' => $_, | ||||
| 2399 | 'biblioitems' => $_, | ||||
| 2400 | 'issues' => $_, | ||||
| 2401 | }, grep { $_->{'now'} } @issues ], | ||||
| 2402 | ); | ||||
| 2403 | } | ||||
| 2404 | else { | ||||
| 2405 | $letter_code = 'ISSUESLIP'; | ||||
| 2406 | %repeat = ( | ||||
| 2407 | 'checkedout' => [ map { | ||||
| 2408 | 'biblio' => $_, | ||||
| 2409 | 'items' => $_, | ||||
| 2410 | 'biblioitems' => $_, | ||||
| 2411 | 'issues' => $_, | ||||
| 2412 | }, grep { !$_->{'overdue'} } @issues ], | ||||
| 2413 | |||||
| 2414 | 'overdue' => [ map { | ||||
| 2415 | 'biblio' => $_, | ||||
| 2416 | 'items' => $_, | ||||
| 2417 | 'biblioitems' => $_, | ||||
| 2418 | 'issues' => $_, | ||||
| 2419 | }, grep { $_->{'overdue'} } @issues ], | ||||
| 2420 | |||||
| 2421 | 'news' => [ map { | ||||
| 2422 | $_->{'timestamp'} = $_->{'newdate'}; | ||||
| 2423 | { opac_news => $_ } | ||||
| 2424 | } @{ GetNewsToDisplay("slip",$branch) } ], | ||||
| 2425 | ); | ||||
| 2426 | } | ||||
| 2427 | |||||
| 2428 | return C4::Letters::GetPreparedLetter ( | ||||
| 2429 | module => 'circulation', | ||||
| 2430 | letter_code => $letter_code, | ||||
| 2431 | branchcode => $branch, | ||||
| 2432 | tables => { | ||||
| 2433 | 'branches' => $branch, | ||||
| 2434 | 'borrowers' => $borrowernumber, | ||||
| 2435 | }, | ||||
| 2436 | repeat => \%repeat, | ||||
| 2437 | ); | ||||
| 2438 | } | ||||
| 2439 | |||||
| 2440 | =head2 GetBorrowersWithEmail | ||||
| 2441 | |||||
| 2442 | ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com'); | ||||
| 2443 | |||||
| 2444 | This gets a list of users and their basic details from their email address. | ||||
| 2445 | As it's possible for multiple user to have the same email address, it provides | ||||
| 2446 | you with all of them. If there is no userid for the user, there will be an | ||||
| 2447 | C<undef> there. An empty list will be returned if there are no matches. | ||||
| 2448 | |||||
| 2449 | =cut | ||||
| 2450 | |||||
| 2451 | sub GetBorrowersWithEmail { | ||||
| 2452 | my $email = shift; | ||||
| 2453 | |||||
| 2454 | my $dbh = C4::Context->dbh; | ||||
| 2455 | |||||
| 2456 | my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?"; | ||||
| 2457 | my $sth=$dbh->prepare($query); | ||||
| 2458 | $sth->execute($email); | ||||
| 2459 | my @result = (); | ||||
| 2460 | while (my $ref = $sth->fetch) { | ||||
| 2461 | push @result, $ref; | ||||
| 2462 | } | ||||
| 2463 | die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err; | ||||
| 2464 | return @result; | ||||
| 2465 | } | ||||
| 2466 | |||||
| 2467 | =head2 AddMember_Opac | ||||
| 2468 | |||||
| 2469 | =cut | ||||
| 2470 | |||||
| 2471 | sub AddMember_Opac { | ||||
| 2472 | my ( %borrower ) = @_; | ||||
| 2473 | |||||
| 2474 | $borrower{'categorycode'} = C4::Context->preference('PatronSelfRegistrationDefaultCategory'); | ||||
| 2475 | |||||
| 2476 | my $sr = new String::Random; | ||||
| 2477 | $sr->{'A'} = [ 'A'..'Z', 'a'..'z' ]; | ||||
| 2478 | my $password = $sr->randpattern("AAAAAAAAAA"); | ||||
| 2479 | $borrower{'password'} = $password; | ||||
| 2480 | |||||
| 2481 | $borrower{'cardnumber'} = fixup_cardnumber(); | ||||
| 2482 | |||||
| 2483 | my $borrowernumber = AddMember(%borrower); | ||||
| 2484 | |||||
| 2485 | return ( $borrowernumber, $password ); | ||||
| 2486 | } | ||||
| 2487 | |||||
| 2488 | =head2 AddEnrolmentFeeIfNeeded | ||||
| 2489 | |||||
| 2490 | AddEnrolmentFeeIfNeeded( $borrower->{categorycode}, $borrower->{borrowernumber} ); | ||||
| 2491 | |||||
| 2492 | Add enrolment fee for a patron if needed. | ||||
| 2493 | |||||
| 2494 | =cut | ||||
| 2495 | |||||
| 2496 | sub AddEnrolmentFeeIfNeeded { | ||||
| 2497 | my ( $categorycode, $borrowernumber ) = @_; | ||||
| 2498 | # check for enrollment fee & add it if needed | ||||
| 2499 | my $dbh = C4::Context->dbh; | ||||
| 2500 | my $sth = $dbh->prepare(q{ | ||||
| 2501 | SELECT enrolmentfee | ||||
| 2502 | FROM categories | ||||
| 2503 | WHERE categorycode=? | ||||
| 2504 | }); | ||||
| 2505 | $sth->execute( $categorycode ); | ||||
| 2506 | if ( $sth->err ) { | ||||
| 2507 | warn sprintf('Database returned the following error: %s', $sth->errstr); | ||||
| 2508 | return; | ||||
| 2509 | } | ||||
| 2510 | my ($enrolmentfee) = $sth->fetchrow; | ||||
| 2511 | if ($enrolmentfee && $enrolmentfee > 0) { | ||||
| 2512 | # insert fee in patron debts | ||||
| 2513 | C4::Accounts::manualinvoice( $borrowernumber, '', '', 'A', $enrolmentfee ); | ||||
| 2514 | } | ||||
| 2515 | } | ||||
| 2516 | |||||
| 2517 | =head2 HasOverdues | ||||
| 2518 | |||||
| 2519 | =cut | ||||
| 2520 | |||||
| 2521 | sub HasOverdues { | ||||
| 2522 | my ( $borrowernumber ) = @_; | ||||
| 2523 | |||||
| 2524 | my $sql = "SELECT COUNT(*) FROM issues WHERE date_due < NOW() AND borrowernumber = ?"; | ||||
| 2525 | my $sth = C4::Context->dbh->prepare( $sql ); | ||||
| 2526 | $sth->execute( $borrowernumber ); | ||||
| 2527 | my ( $count ) = $sth->fetchrow_array(); | ||||
| 2528 | |||||
| 2529 | return $count; | ||||
| 2530 | } | ||||
| 2531 | |||||
| 2532 | =head2 DeleteExpiredOpacRegistrations | ||||
| 2533 | |||||
| 2534 | Delete accounts that haven't been upgraded from the 'temporary' category | ||||
| 2535 | Returns the number of removed patrons | ||||
| 2536 | |||||
| 2537 | =cut | ||||
| 2538 | |||||
| 2539 | sub DeleteExpiredOpacRegistrations { | ||||
| 2540 | |||||
| 2541 | my $delay = C4::Context->preference('PatronSelfRegistrationExpireTemporaryAccountsDelay'); | ||||
| 2542 | my $category_code = C4::Context->preference('PatronSelfRegistrationDefaultCategory'); | ||||
| 2543 | |||||
| 2544 | return 0 if not $category_code or not defined $delay or $delay eq q||; | ||||
| 2545 | |||||
| 2546 | my $query = qq| | ||||
| 2547 | SELECT borrowernumber | ||||
| 2548 | FROM borrowers | ||||
| 2549 | WHERE categorycode = ? AND DATEDIFF( NOW(), dateenrolled ) > ? |; | ||||
| 2550 | |||||
| 2551 | my $dbh = C4::Context->dbh; | ||||
| 2552 | my $sth = $dbh->prepare($query); | ||||
| 2553 | $sth->execute( $category_code, $delay ); | ||||
| 2554 | my $cnt=0; | ||||
| 2555 | while ( my ($borrowernumber) = $sth->fetchrow_array() ) { | ||||
| 2556 | DelMember($borrowernumber); | ||||
| 2557 | $cnt++; | ||||
| 2558 | } | ||||
| 2559 | return $cnt; | ||||
| 2560 | } | ||||
| 2561 | |||||
| 2562 | =head2 DeleteUnverifiedOpacRegistrations | ||||
| 2563 | |||||
| 2564 | Delete all unverified self registrations in borrower_modifications, | ||||
| 2565 | older than the specified number of days. | ||||
| 2566 | |||||
| 2567 | =cut | ||||
| 2568 | |||||
| 2569 | sub DeleteUnverifiedOpacRegistrations { | ||||
| 2570 | my ( $days ) = @_; | ||||
| 2571 | my $dbh = C4::Context->dbh; | ||||
| 2572 | my $sql=qq| | ||||
| 2573 | DELETE FROM borrower_modifications | ||||
| 2574 | WHERE borrowernumber = 0 AND DATEDIFF( NOW(), timestamp ) > ?|; | ||||
| 2575 | my $cnt=$dbh->do($sql, undef, ($days) ); | ||||
| 2576 | return $cnt eq '0E0'? 0: $cnt; | ||||
| 2577 | } | ||||
| 2578 | |||||
| 2579 | sub GetOverduesForPatron { | ||||
| 2580 | my ( $borrowernumber ) = @_; | ||||
| 2581 | |||||
| 2582 | my $sql = " | ||||
| 2583 | SELECT * | ||||
| 2584 | FROM issues, items, biblio, biblioitems | ||||
| 2585 | WHERE items.itemnumber=issues.itemnumber | ||||
| 2586 | AND biblio.biblionumber = items.biblionumber | ||||
| 2587 | AND biblio.biblionumber = biblioitems.biblionumber | ||||
| 2588 | AND issues.borrowernumber = ? | ||||
| 2589 | AND date_due < NOW() | ||||
| 2590 | "; | ||||
| 2591 | |||||
| 2592 | my $sth = C4::Context->dbh->prepare( $sql ); | ||||
| 2593 | $sth->execute( $borrowernumber ); | ||||
| 2594 | |||||
| 2595 | return $sth->fetchall_arrayref({}); | ||||
| 2596 | } | ||||
| 2597 | |||||
| 2598 | END { } # module clean-up code here (global destructor) | ||||
| 2599 | |||||
| 2600 | 1; | ||||
| 2601 | |||||
| 2602 | __END__ | ||||
| 2603 | |||||
| 2604 | =head1 AUTHOR | ||||
| 2605 | |||||
| 2606 | Koha Team | ||||
| 2607 | |||||
| 2608 | =cut |