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         FROM suggestions
 115             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 116             LEFT JOIN branches      AS B1 ON B1.branchcode=U1.branchcode
 117             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 118             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 119             LEFT JOIN branches      AS B2 ON B2.branchcode=U2.branchcode
 120             LEFT JOIN categories    AS C2 ON C2.categorycode=U2.categorycode
 121         WHERE 1=1
 122     }
 123     );
 124
 125     # filter on biblio informations
 126     foreach my $field (
 127         qw( title author isbn publishercode copyrightdate collectiontitle ))
 128     {
 129         if ( $suggestion->{$field} ) {
 130             push @sql_params, '%' . $suggestion->{$field} . '%';
 131             push @query,      qq{ AND suggestions.$field LIKE ? };
 132         }
 133     }
 134
 135     # filter on user branch
 136     if ( C4::Context->preference('IndependentBranches') ) {
 137         my $userenv = C4::Context->userenv;
 138         if ($userenv) {
 139             if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
 140             {
 141                 push @sql_params, $$userenv{branch};
 142                 push @query,      q{
 143                     AND (suggestions.branchcode=? OR suggestions.branchcode='')
 144                 };
 145             }
 146         }
 147     } else {
 148         if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
 149             unless ( $suggestion->{branchcode} eq '__ANY__' ) {
 150                 push @sql_params, $suggestion->{branchcode};
 151                 push @query,      qq{ AND suggestions.branchcode=? };
 152             }
 153         }
 154     }
 155
 156     # filter on nillable fields
 157     foreach my $field (
 158         qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
 159       )
 160     {
 161         if ( exists $suggestion->{$field}
 162                 and defined $suggestion->{$field}
 163                 and $suggestion->{$field} ne '__ANY__'
 164                 and (
 165                     $suggestion->{$field} ne q||
 166                         or $field eq 'STATUS'
 167                 )
 168         ) {
 169             if ( $suggestion->{$field} eq '__NONE__' ) {
 170                 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
 171             }
 172             else {
 173                 push @sql_params, $suggestion->{$field};
 174                 push @query, qq{ AND suggestions.$field = ? };
 175             }
 176         }
 177     }
 178
 179     # filter on date fields
 180     foreach my $field (qw( suggesteddate manageddate accepteddate )) {
 181         my $from = $field . "_from";
 182         my $to   = $field . "_to";
 183         my $from_dt;
 184         $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
 185         my $from_sql = '0000-00-00';
 186         $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
 187             if ($from_dt);
 188         $debug && warn "SQL for start date ($field): $from_sql";
 189         if ( $suggestion->{$from} || $suggestion->{$to} ) {
 190             push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
 191             push @sql_params, $from_sql;
 192             push @sql_params,
 193               output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
 194         }
 195     }
 196
 197     $debug && warn "@query";
 198     my $sth = $dbh->prepare("@query");
 199     $sth->execute(@sql_params);
 200     my @results;
 201
 202     # add status as field
 203     while ( my $data = $sth->fetchrow_hashref ) {
 204         $data->{ $data->{STATUS} } = 1;
 205         push( @results, $data );
 206     }
 207
 208     return ( \@results );
 209 }
 210
 211 =head2 GetSuggestion
 212
 213 \%sth = &GetSuggestion($suggestionid)
 214
 215 this function get the detail of the suggestion $suggestionid (input arg)
 216
 217 return :
 218     the result of the SQL query as a hash : $sth->fetchrow_hashref.
 219
 220 =cut
 221
 222 sub GetSuggestion {
 223     my ($suggestionid) = @_;
 224     my $dbh           = C4::Context->dbh;
 225     my $query         = q{
 226         SELECT *
 227         FROM   suggestions
 228         WHERE  suggestionid=?
 229     };
 230     my $sth = $dbh->prepare($query);
 231     $sth->execute($suggestionid);
 232     return ( $sth->fetchrow_hashref );
 233 }
 234
 235 =head2 GetSuggestionFromBiblionumber
 236
 237 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 238
 239 Get a suggestion from it's biblionumber.
 240
 241 return :
 242 the id of the suggestion which is related to the biblionumber given on input args.
 243
 244 =cut
 245
 246 sub GetSuggestionFromBiblionumber {
 247     my ($biblionumber) = @_;
 248     my $query = q{
 249         SELECT suggestionid
 250         FROM   suggestions
 251         WHERE  biblionumber=? LIMIT 1
 252     };
 253     my $dbh = C4::Context->dbh;
 254     my $sth = $dbh->prepare($query);
 255     $sth->execute($biblionumber);
 256     my ($suggestionid) = $sth->fetchrow;
 257     return $suggestionid;
 258 }
 259
 260 =head2 GetSuggestionInfoFromBiblionumber
 261
 262 Get a suggestion and borrower's informations from it's biblionumber.
 263
 264 return :
 265 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
 266
 267 =cut
 268
 269 sub GetSuggestionInfoFromBiblionumber {
 270     my ($biblionumber) = @_;
 271     my $query = q{
 272         SELECT suggestions.*,
 273             U1.surname          AS surnamesuggestedby,
 274             U1.firstname        AS firstnamesuggestedby,
 275             U1.borrowernumber   AS borrnumsuggestedby
 276         FROM suggestions
 277             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 278         WHERE biblionumber=?
 279         LIMIT 1
 280     };
 281     my $dbh = C4::Context->dbh;
 282     my $sth = $dbh->prepare($query);
 283     $sth->execute($biblionumber);
 284     return $sth->fetchrow_hashref;
 285 }
 286
 287 =head2 GetSuggestionInfo
 288
 289 Get a suggestion and borrower's informations from it's suggestionid
 290
 291 return :
 292 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
 293
 294 =cut
 295
 296 sub GetSuggestionInfo {
 297     my ($suggestionid) = @_;
 298     my $query = q{
 299         SELECT suggestions.*,
 300             U1.surname          AS surnamesuggestedby,
 301             U1.firstname        AS firstnamesuggestedby,
 302             U1.borrowernumber   AS borrnumsuggestedby
 303         FROM suggestions
 304             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 305         WHERE suggestionid=?
 306         LIMIT 1
 307     };
 308     my $dbh = C4::Context->dbh;
 309     my $sth = $dbh->prepare($query);
 310     $sth->execute($suggestionid);
 311     return $sth->fetchrow_hashref;
 312 }
 313
 314 =head2 GetSuggestionByStatus
 315
 316 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 317
 318 Get a suggestion from it's status
 319
 320 return :
 321 all the suggestion with C<$status>
 322
 323 =cut
 324
 325 sub GetSuggestionByStatus {
 326     my $status     = shift;
 327     my $branchcode = shift;
 328     my $dbh        = C4::Context->dbh;
 329     my @sql_params = ($status);
 330     my $query      = q{
 331         SELECT suggestions.*,
 332             U1.surname          AS surnamesuggestedby,
 333             U1.firstname        AS firstnamesuggestedby,
 334             U1.branchcode       AS branchcodesuggestedby,
 335             B1.branchname       AS branchnamesuggestedby,
 336             U1.borrowernumber   AS borrnumsuggestedby,
 337             U1.categorycode     AS categorycodesuggestedby,
 338             C1.description      AS categorydescriptionsuggestedby,
 339             U2.surname          AS surnamemanagedby,
 340             U2.firstname        AS firstnamemanagedby,
 341             U2.borrowernumber   AS borrnummanagedby
 342         FROM suggestions
 343             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 344             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 345             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 346             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
 347         WHERE status = ?
 348     };
 349
 350     # filter on branch
 351     if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
 352         my $userenv = C4::Context->userenv;
 353         if ($userenv) {
 354             unless ( C4::Context->IsSuperLibrarian() ) {
 355                 push @sql_params, $userenv->{branch};
 356                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 357             }
 358         }
 359         if ($branchcode) {
 360             push @sql_params, $branchcode;
 361             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 362         }
 363     }
 364
 365     my $sth = $dbh->prepare($query);
 366     $sth->execute(@sql_params);
 367     my $results;
 368     $results = $sth->fetchall_arrayref( {} );
 369     return $results;
 370 }
 371
 372 =head2 CountSuggestion
 373
 374 &CountSuggestion($status)
 375
 376 Count the number of aqorders with the status given on input argument.
 377 the arg status can be :
 378
 379 =over 2
 380
 381 =item * ASKED : asked by the user, not dealed by the librarian
 382
 383 =item * ACCEPTED : accepted by the librarian, but not yet ordered
 384
 385 =item * REJECTED : rejected by the librarian (definitive status)
 386
 387 =item * ORDERED : ordered by the librarian (acquisition module)
 388
 389 =back
 390
 391 return :
 392 the number of suggestion with this status.
 393
 394 =cut
 395
 396 sub CountSuggestion {
 397     my ($status) = @_;
 398     my $dbh = C4::Context->dbh;
 399     my $sth;
 400     my $userenv = C4::Context->userenv;
 401     if ( C4::Context->preference("IndependentBranches")
 402         && !C4::Context->IsSuperLibrarian() )
 403     {
 404         my $query = q{
 405             SELECT count(*)
 406             FROM suggestions
 407                 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
 408             WHERE STATUS=?
 409                 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
 410         };
 411         $sth = $dbh->prepare($query);
 412         $sth->execute( $status, $userenv->{branch} );
 413     }
 414     else {
 415         my $query = q{
 416             SELECT count(*)
 417             FROM suggestions
 418             WHERE STATUS=?
 419         };
 420         $sth = $dbh->prepare($query);
 421         $sth->execute($status);
 422     }
 423     my ($result) = $sth->fetchrow;
 424     return $result;
 425 }
 426
 427 =head2 NewSuggestion
 428
 429
 430 &NewSuggestion($suggestion);
 431
 432 Insert a new suggestion on database with value given on input arg.
 433
 434 =cut
 435
 436 sub NewSuggestion {
 437     my ($suggestion) = @_;
 438
 439     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 440
 441     $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
 442
 443     my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
 444     return $suggestion_object->suggestionid;
 445 }
 446
 447 =head2 ModSuggestion
 448
 449 &ModSuggestion($suggestion)
 450
 451 Modify the suggestion according to the hash passed by ref.
 452 The hash HAS to contain suggestionid
 453 Data not defined is not updated unless it is a note or sort1
 454 Send a mail to notify the user that did the suggestion.
 455
 456 Note that there is no function to modify a suggestion.
 457
 458 =cut
 459
 460 sub ModSuggestion {
 461     my ($suggestion) = @_;
 462     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 463
 464     my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
 465     eval { # FIXME Must raise an exception instead
 466         $suggestion_object->set($suggestion)->store;
 467     };
 468     return 0 if $@;
 469
 470     if ( $suggestion->{STATUS} ) {
 471
 472         # fetch the entire updated suggestion so that we can populate the letter
 473         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 474         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 475         if (
 476             my $letter = C4::Letters::GetPreparedLetter(
 477                 module      => 'suggestions',
 478                 letter_code => $full_suggestion->{STATUS},
 479                 branchcode  => $full_suggestion->{branchcode},
 480                 lang        => $patron->lang,
 481                 tables      => {
 482                     'branches'    => $full_suggestion->{branchcode},
 483                     'borrowers'   => $full_suggestion->{suggestedby},
 484                     'suggestions' => $full_suggestion,
 485                     'biblio'      => $full_suggestion->{biblionumber},
 486                 },
 487             )
 488           )
 489         {
 490             C4::Letters::EnqueueLetter(
 491                 {
 492                     letter         => $letter,
 493                     borrowernumber => $full_suggestion->{suggestedby},
 494                     suggestionid   => $full_suggestion->{suggestionid},
 495                     LibraryName    => C4::Context->preference("LibraryName"),
 496                     message_transport_type => 'email',
 497                 }
 498             ) or warn "can't enqueue letter $letter";
 499         }
 500     }
 501     return 1; # No useful if the exception is raised earlier
 502 }
 503
 504 =head2 ConnectSuggestionAndBiblio
 505
 506 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 507
 508 connect a suggestion to an existing biblio
 509
 510 =cut
 511
 512 sub ConnectSuggestionAndBiblio {
 513     my ( $suggestionid, $biblionumber ) = @_;
 514     my $dbh   = C4::Context->dbh;
 515     my $query = q{
 516         UPDATE suggestions
 517         SET    biblionumber=?
 518         WHERE  suggestionid=?
 519     };
 520     my $sth = $dbh->prepare($query);
 521     $sth->execute( $biblionumber, $suggestionid );
 522 }
 523
 524 =head2 DelSuggestion
 525
 526 &DelSuggestion($borrowernumber,$ordernumber)
 527
 528 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 529
 530 =cut
 531
 532 sub DelSuggestion {
 533     my ( $borrowernumber, $suggestionid, $type ) = @_;
 534     my $dbh = C4::Context->dbh;
 535
 536     # check that the suggestion comes from the suggestor
 537     my $query = q{
 538         SELECT suggestedby
 539         FROM   suggestions
 540         WHERE  suggestionid=?
 541     };
 542     my $sth = $dbh->prepare($query);
 543     $sth->execute($suggestionid);
 544     my ($suggestedby) = $sth->fetchrow;
 545     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 546         my $queryDelete = q{
 547             DELETE FROM suggestions
 548             WHERE suggestionid=?
 549         };
 550         $sth = $dbh->prepare($queryDelete);
 551         my $suggestiondeleted = $sth->execute($suggestionid);
 552         return $suggestiondeleted;
 553     }
 554 }
 555
 556 =head2 DelSuggestionsOlderThan
 557     &DelSuggestionsOlderThan($days)
 558
 559     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 560     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 561
 562 =cut
 563
 564 sub DelSuggestionsOlderThan {
 565     my ($days) = @_;
 566     return unless $days && $days > 0;
 567     my $dbh = C4::Context->dbh;
 568     my $sth = $dbh->prepare(
 569         q{
 570         DELETE FROM suggestions
 571         WHERE STATUS<>'ASKED'
 572             AND date < ADDDATE(NOW(), ?)
 573     }
 574     );
 575     $sth->execute("-$days");
 576 }
 577
 578 sub GetUnprocessedSuggestions {
 579     my ( $number_of_days_since_the_last_modification ) = @_;
 580
 581     $number_of_days_since_the_last_modification ||= 0;
 582
 583     my $dbh = C4::Context->dbh;
 584
 585     my $s = $dbh->selectall_arrayref(q|
 586         SELECT *
 587         FROM suggestions
 588         WHERE STATUS = 'ASKED'
 589             AND budgetid IS NOT NULL
 590             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 591     |, { Slice => {} }, $number_of_days_since_the_last_modification );
 592     return $s;
 593 }
 594
 595 1;
 596 __END__
 597
 598
 599 =head1 AUTHOR
 600
 601 Koha Development Team <http://koha-community.org/>
 602
 603 =cut
 604