C4/Suggestions.pm

   1 package C4::Suggestions;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Parts Copyright Biblibre 2011
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use strict;
  22
  23 #use warnings; FIXME - Bug 2505
  24 use CGI qw ( -utf8 );
  25
  26 use C4::Context;
  27 use C4::Output;
  28 use C4::Debug;
  29 use C4::Letters;
  30 use Koha::DateUtils;
  31 use Koha::Suggestions;
  32
  33 use List::MoreUtils qw(any);
  34 use base qw(Exporter);
  35
  36 our @EXPORT  = qw(
  37   ConnectSuggestionAndBiblio
  38   CountSuggestion
  39   DelSuggestion
  40   GetSuggestion
  41   GetSuggestionByStatus
  42   GetSuggestionFromBiblionumber
  43   GetSuggestionInfoFromBiblionumber
  44   GetSuggestionInfo
  45   ModStatus
  46   ModSuggestion
  47   NewSuggestion
  48   SearchSuggestion
  49   DelSuggestionsOlderThan
  50   GetUnprocessedSuggestions
  51 );
  52
  53 =head1 NAME
  54
  55 C4::Suggestions - Some useful functions for dealings with aqorders.
  56
  57 =head1 SYNOPSIS
  58
  59 use C4::Suggestions;
  60
  61 =head1 DESCRIPTION
  62
  63 The functions in this module deal with the aqorders in OPAC and in librarian interface
  64
  65 A suggestion is done in the OPAC. It has the status "ASKED"
  66
  67 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
  68
  69 When the book is ordered, the suggestion status becomes "ORDERED"
  70
  71 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
  72
  73 All aqorders of a borrower can be seen by the borrower itself.
  74 Suggestions done by other borrowers can be seen when not "AVAILABLE"
  75
  76 =head1 FUNCTIONS
  77
  78 =head2 SearchSuggestion
  79
  80 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
  81
  82 searches for a suggestion
  83
  84 return :
  85 C<\@array> : the aqorders found. Array of hash.
  86 Note the status is stored twice :
  87 * in the status field
  88 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
  89
  90 =cut
  91
  92 sub SearchSuggestion {
  93     my ($suggestion) = @_;
  94     my $dbh = C4::Context->dbh;
  95     my @sql_params;
  96     my @query = (
  97         q{
  98         SELECT suggestions.*,
  99             U1.branchcode       AS branchcodesuggestedby,
 100             B1.branchname       AS branchnamesuggestedby,
 101             U1.surname          AS surnamesuggestedby,
 102             U1.firstname        AS firstnamesuggestedby,
 103             U1.cardnumber       AS cardnumbersuggestedby,
 104             U1.email            AS emailsuggestedby,
 105             U1.borrowernumber   AS borrnumsuggestedby,
 106             U1.categorycode     AS categorycodesuggestedby,
 107             C1.description      AS categorydescriptionsuggestedby,
 108             U2.surname          AS surnamemanagedby,
 109             U2.firstname        AS firstnamemanagedby,
 110             B2.branchname       AS branchnamesuggestedby,
 111             U2.email            AS emailmanagedby,
 112             U2.branchcode       AS branchcodemanagedby,
 113             U2.borrowernumber   AS borrnummanagedby,
 114             BU.budget_name      AS budget_name
 115         FROM suggestions
 116             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 117             LEFT JOIN branches      AS B1 ON B1.branchcode=U1.branchcode
 118             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 119             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 120             LEFT JOIN branches      AS B2 ON B2.branchcode=U2.branchcode
 121             LEFT JOIN categories    AS C2 ON C2.categorycode=U2.categorycode
 122             LEFT JOIN aqbudgets     AS BU ON budgetid=BU.budget_id
 123         WHERE 1=1
 124     }
 125     );
 126
 127     # filter on biblio informations
 128     foreach my $field (
 129         qw( title author isbn publishercode copyrightdate collectiontitle ))
 130     {
 131         if ( $suggestion->{$field} ) {
 132             push @sql_params, '%' . $suggestion->{$field} . '%';
 133             push @query,      qq{ AND suggestions.$field LIKE ? };
 134         }
 135     }
 136
 137     # filter on user branch
 138     if ( C4::Context->preference('IndependentBranches') ) {
 139         my $userenv = C4::Context->userenv;
 140         if ($userenv) {
 141             if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
 142             {
 143                 push @sql_params, $$userenv{branch};
 144                 push @query,      q{
 145                     AND (suggestions.branchcode=? OR suggestions.branchcode='')
 146                 };
 147             }
 148         }
 149     } else {
 150         if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
 151             unless ( $suggestion->{branchcode} eq '__ANY__' ) {
 152                 push @sql_params, $suggestion->{branchcode};
 153                 push @query,      qq{ AND suggestions.branchcode=? };
 154             }
 155         }
 156     }
 157
 158     # filter on nillable fields
 159     foreach my $field (
 160         qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
 161       )
 162     {
 163         if ( exists $suggestion->{$field}
 164                 and defined $suggestion->{$field}
 165                 and $suggestion->{$field} ne '__ANY__'
 166                 and (
 167                     $suggestion->{$field} ne q||
 168                         or $field eq 'STATUS'
 169                 )
 170         ) {
 171             if ( $suggestion->{$field} eq '__NONE__' ) {
 172                 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
 173             }
 174             else {
 175                 push @sql_params, $suggestion->{$field};
 176                 push @query, qq{ AND suggestions.$field = ? };
 177             }
 178         }
 179     }
 180
 181     # filter on date fields
 182     foreach my $field (qw( suggesteddate manageddate accepteddate )) {
 183         my $from = $field . "_from";
 184         my $to   = $field . "_to";
 185         my $from_dt;
 186         $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
 187         my $from_sql = '0000-00-00';
 188         $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
 189             if ($from_dt);
 190         $debug && warn "SQL for start date ($field): $from_sql";
 191         if ( $suggestion->{$from} || $suggestion->{$to} ) {
 192             push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
 193             push @sql_params, $from_sql;
 194             push @sql_params,
 195               output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
 196         }
 197     }
 198
 199     $debug && warn "@query";
 200     my $sth = $dbh->prepare("@query");
 201     $sth->execute(@sql_params);
 202     my @results;
 203
 204     # add status as field
 205     while ( my $data = $sth->fetchrow_hashref ) {
 206         $data->{ $data->{STATUS} } = 1;
 207         push( @results, $data );
 208     }
 209
 210     return ( \@results );
 211 }
 212
 213 =head2 GetSuggestion
 214
 215 \%sth = &GetSuggestion($suggestionid)
 216
 217 this function get the detail of the suggestion $suggestionid (input arg)
 218
 219 return :
 220     the result of the SQL query as a hash : $sth->fetchrow_hashref.
 221
 222 =cut
 223
 224 sub GetSuggestion {
 225     my ($suggestionid) = @_;
 226     my $dbh           = C4::Context->dbh;
 227     my $query         = q{
 228         SELECT *
 229         FROM   suggestions
 230         WHERE  suggestionid=?
 231     };
 232     my $sth = $dbh->prepare($query);
 233     $sth->execute($suggestionid);
 234     return ( $sth->fetchrow_hashref );
 235 }
 236
 237 =head2 GetSuggestionFromBiblionumber
 238
 239 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 240
 241 Get a suggestion from it's biblionumber.
 242
 243 return :
 244 the id of the suggestion which is related to the biblionumber given on input args.
 245
 246 =cut
 247
 248 sub GetSuggestionFromBiblionumber {
 249     my ($biblionumber) = @_;
 250     my $query = q{
 251         SELECT suggestionid
 252         FROM   suggestions
 253         WHERE  biblionumber=? LIMIT 1
 254     };
 255     my $dbh = C4::Context->dbh;
 256     my $sth = $dbh->prepare($query);
 257     $sth->execute($biblionumber);
 258     my ($suggestionid) = $sth->fetchrow;
 259     return $suggestionid;
 260 }
 261
 262 =head2 GetSuggestionInfoFromBiblionumber
 263
 264 Get a suggestion and borrower's informations from it's biblionumber.
 265
 266 return :
 267 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
 268
 269 =cut
 270
 271 sub GetSuggestionInfoFromBiblionumber {
 272     my ($biblionumber) = @_;
 273     my $query = q{
 274         SELECT suggestions.*,
 275             U1.surname          AS surnamesuggestedby,
 276             U1.firstname        AS firstnamesuggestedby,
 277             U1.borrowernumber   AS borrnumsuggestedby
 278         FROM suggestions
 279             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 280         WHERE biblionumber=?
 281         LIMIT 1
 282     };
 283     my $dbh = C4::Context->dbh;
 284     my $sth = $dbh->prepare($query);
 285     $sth->execute($biblionumber);
 286     return $sth->fetchrow_hashref;
 287 }
 288
 289 =head2 GetSuggestionInfo
 290
 291 Get a suggestion and borrower's informations from it's suggestionid
 292
 293 return :
 294 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
 295
 296 =cut
 297
 298 sub GetSuggestionInfo {
 299     my ($suggestionid) = @_;
 300     my $query = q{
 301         SELECT suggestions.*,
 302             U1.surname          AS surnamesuggestedby,
 303             U1.firstname        AS firstnamesuggestedby,
 304             U1.borrowernumber   AS borrnumsuggestedby
 305         FROM suggestions
 306             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 307         WHERE suggestionid=?
 308         LIMIT 1
 309     };
 310     my $dbh = C4::Context->dbh;
 311     my $sth = $dbh->prepare($query);
 312     $sth->execute($suggestionid);
 313     return $sth->fetchrow_hashref;
 314 }
 315
 316 =head2 GetSuggestionByStatus
 317
 318 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 319
 320 Get a suggestion from it's status
 321
 322 return :
 323 all the suggestion with C<$status>
 324
 325 =cut
 326
 327 sub GetSuggestionByStatus {
 328     my $status     = shift;
 329     my $branchcode = shift;
 330     my $dbh        = C4::Context->dbh;
 331     my @sql_params = ($status);
 332     my $query      = q{
 333         SELECT suggestions.*,
 334             U1.surname          AS surnamesuggestedby,
 335             U1.firstname        AS firstnamesuggestedby,
 336             U1.branchcode       AS branchcodesuggestedby,
 337             B1.branchname       AS branchnamesuggestedby,
 338             U1.borrowernumber   AS borrnumsuggestedby,
 339             U1.categorycode     AS categorycodesuggestedby,
 340             C1.description      AS categorydescriptionsuggestedby,
 341             U2.surname          AS surnamemanagedby,
 342             U2.firstname        AS firstnamemanagedby,
 343             U2.borrowernumber   AS borrnummanagedby
 344         FROM suggestions
 345             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 346             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 347             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 348             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
 349         WHERE status = ?
 350     };
 351
 352     # filter on branch
 353     if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
 354         my $userenv = C4::Context->userenv;
 355         if ($userenv) {
 356             unless ( C4::Context->IsSuperLibrarian() ) {
 357                 push @sql_params, $userenv->{branch};
 358                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 359             }
 360         }
 361         if ($branchcode) {
 362             push @sql_params, $branchcode;
 363             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 364         }
 365     }
 366
 367     my $sth = $dbh->prepare($query);
 368     $sth->execute(@sql_params);
 369     my $results;
 370     $results = $sth->fetchall_arrayref( {} );
 371     return $results;
 372 }
 373
 374 =head2 CountSuggestion
 375
 376 &CountSuggestion($status)
 377
 378 Count the number of aqorders with the status given on input argument.
 379 the arg status can be :
 380
 381 =over 2
 382
 383 =item * ASKED : asked by the user, not dealed by the librarian
 384
 385 =item * ACCEPTED : accepted by the librarian, but not yet ordered
 386
 387 =item * REJECTED : rejected by the librarian (definitive status)
 388
 389 =item * ORDERED : ordered by the librarian (acquisition module)
 390
 391 =back
 392
 393 return :
 394 the number of suggestion with this status.
 395
 396 =cut
 397
 398 sub CountSuggestion {
 399     my ($status) = @_;
 400     my $dbh = C4::Context->dbh;
 401     my $sth;
 402     my $userenv = C4::Context->userenv;
 403     if ( C4::Context->preference("IndependentBranches")
 404         && !C4::Context->IsSuperLibrarian() )
 405     {
 406         my $query = q{
 407             SELECT count(*)
 408             FROM suggestions
 409                 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
 410             WHERE STATUS=?
 411                 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
 412         };
 413         $sth = $dbh->prepare($query);
 414         $sth->execute( $status, $userenv->{branch} );
 415     }
 416     else {
 417         my $query = q{
 418             SELECT count(*)
 419             FROM suggestions
 420             WHERE STATUS=?
 421         };
 422         $sth = $dbh->prepare($query);
 423         $sth->execute($status);
 424     }
 425     my ($result) = $sth->fetchrow;
 426     return $result;
 427 }
 428
 429 =head2 NewSuggestion
 430
 431
 432 &NewSuggestion($suggestion);
 433
 434 Insert a new suggestion on database with value given on input arg.
 435
 436 =cut
 437
 438 sub NewSuggestion {
 439     my ($suggestion) = @_;
 440
 441     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 442
 443     $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
 444
 445     my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
 446     my $suggestion_id = $suggestion_object->suggestionid;
 447
 448     my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
 449     if ($emailpurchasesuggestions) {
 450         my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
 451         if (
 452             my $letter = C4::Letters::GetPreparedLetter(
 453                 module      => 'suggestions',
 454                 letter_code => 'NEW_SUGGESTION',
 455                 tables      => {
 456                     'branches'    => $full_suggestion->{branchcode},
 457                     'borrowers'   => $full_suggestion->{suggestedby},
 458                     'suggestions' => $full_suggestion,
 459                 },
 460             )
 461         ){
 462
 463             my $toaddress;
 464             if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
 465                 my $library =
 466                   Koha::Libraries->find( $full_suggestion->{branchcode} );
 467                 $toaddress =
 468                      $library->branchreplyto
 469                   || $library->branchemail
 470                   || C4::Context->preference('ReplytoDefault')
 471                   || C4::Context->preference('KohaAdminEmailAddress');
 472             }
 473             elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
 474                 $toaddress = C4::Context->preference('ReplytoDefault')
 475                   || C4::Context->preference('KohaAdminEmailAddress');
 476             }
 477             else {
 478                 $toaddress =
 479                      C4::Context->preference($emailpurchasesuggestions)
 480                   || C4::Context->preference('ReplytoDefault')
 481                   || C4::Context->preference('KohaAdminEmailAddress');
 482             }
 483
 484             C4::Letters::EnqueueLetter(
 485                 {
 486                     letter         => $letter,
 487                     borrowernumber => $full_suggestion->{suggestedby},
 488                     suggestionid   => $full_suggestion->{suggestionid},
 489                     to_address     => $toaddress,
 490                     message_transport_type => 'email',
 491                 }
 492             ) or warn "can't enqueue letter $letter";
 493         }
 494     }
 495
 496     return $suggestion_id;
 497 }
 498
 499 =head2 ModSuggestion
 500
 501 &ModSuggestion($suggestion)
 502
 503 Modify the suggestion according to the hash passed by ref.
 504 The hash HAS to contain suggestionid
 505 Data not defined is not updated unless it is a note or sort1
 506 Send a mail to notify the user that did the suggestion.
 507
 508 Note that there is no function to modify a suggestion.
 509
 510 =cut
 511
 512 sub ModSuggestion {
 513     my ($suggestion) = @_;
 514     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 515
 516     my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
 517     eval { # FIXME Must raise an exception instead
 518         $suggestion_object->set($suggestion)->store;
 519     };
 520     return 0 if $@;
 521
 522     if ( $suggestion->{STATUS} ) {
 523
 524         # fetch the entire updated suggestion so that we can populate the letter
 525         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 526         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 527
 528         my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
 529
 530         if (
 531             my $letter = C4::Letters::GetPreparedLetter(
 532                 module      => 'suggestions',
 533                 letter_code => $full_suggestion->{STATUS},
 534                 branchcode  => $full_suggestion->{branchcode},
 535                 lang        => $patron->lang,
 536                 tables      => {
 537                     'branches'    => $full_suggestion->{branchcode},
 538                     'borrowers'   => $full_suggestion->{suggestedby},
 539                     'suggestions' => $full_suggestion,
 540                     'biblio'      => $full_suggestion->{biblionumber},
 541                 },
 542             )
 543           )
 544         {
 545             C4::Letters::EnqueueLetter(
 546                 {
 547                     letter         => $letter,
 548                     borrowernumber => $full_suggestion->{suggestedby},
 549                     suggestionid   => $full_suggestion->{suggestionid},
 550                     LibraryName    => C4::Context->preference("LibraryName"),
 551                     message_transport_type => $transport,
 552                 }
 553             ) or warn "can't enqueue letter $letter";
 554         }
 555     }
 556     return 1; # No useful if the exception is raised earlier
 557 }
 558
 559 =head2 ConnectSuggestionAndBiblio
 560
 561 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 562
 563 connect a suggestion to an existing biblio
 564
 565 =cut
 566
 567 sub ConnectSuggestionAndBiblio {
 568     my ( $suggestionid, $biblionumber ) = @_;
 569     my $dbh   = C4::Context->dbh;
 570     my $query = q{
 571         UPDATE suggestions
 572         SET    biblionumber=?
 573         WHERE  suggestionid=?
 574     };
 575     my $sth = $dbh->prepare($query);
 576     $sth->execute( $biblionumber, $suggestionid );
 577 }
 578
 579 =head2 DelSuggestion
 580
 581 &DelSuggestion($borrowernumber,$ordernumber)
 582
 583 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 584
 585 =cut
 586
 587 sub DelSuggestion {
 588     my ( $borrowernumber, $suggestionid, $type ) = @_;
 589     my $dbh = C4::Context->dbh;
 590
 591     # check that the suggestion comes from the suggestor
 592     my $query = q{
 593         SELECT suggestedby
 594         FROM   suggestions
 595         WHERE  suggestionid=?
 596     };
 597     my $sth = $dbh->prepare($query);
 598     $sth->execute($suggestionid);
 599     my ($suggestedby) = $sth->fetchrow;
 600     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 601         my $queryDelete = q{
 602             DELETE FROM suggestions
 603             WHERE suggestionid=?
 604         };
 605         $sth = $dbh->prepare($queryDelete);
 606         my $suggestiondeleted = $sth->execute($suggestionid);
 607         return $suggestiondeleted;
 608     }
 609 }
 610
 611 =head2 DelSuggestionsOlderThan
 612     &DelSuggestionsOlderThan($days)
 613
 614     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 615     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 616
 617 =cut
 618
 619 sub DelSuggestionsOlderThan {
 620     my ($days) = @_;
 621     return unless $days && $days > 0;
 622     my $dbh = C4::Context->dbh;
 623     my $sth = $dbh->prepare(
 624         q{
 625         DELETE FROM suggestions
 626         WHERE STATUS<>'ASKED'
 627             AND date < ADDDATE(NOW(), ?)
 628     }
 629     );
 630     $sth->execute("-$days");
 631 }
 632
 633 sub GetUnprocessedSuggestions {
 634     my ( $number_of_days_since_the_last_modification ) = @_;
 635
 636     $number_of_days_since_the_last_modification ||= 0;
 637
 638     my $dbh = C4::Context->dbh;
 639
 640     my $s = $dbh->selectall_arrayref(q|
 641         SELECT *
 642         FROM suggestions
 643         WHERE STATUS = 'ASKED'
 644             AND budgetid IS NOT NULL
 645             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 646     |, { Slice => {} }, $number_of_days_since_the_last_modification );
 647     return $s;
 648 }
 649
 650 1;
 651 __END__
 652
 653
 654 =head1 AUTHOR
 655
 656 Koha Development Team <http://koha-community.org/>
 657
 658 =cut
 659