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