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 under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use strict;
  22
  23 #use warnings; FIXME - Bug 2505
  24 use CGI;
  25
  26 use C4::Context;
  27 use C4::Output;
  28 use C4::Dates qw(format_date format_date_in_iso);
  29 use C4::SQLHelper qw(:all);
  30 use C4::Debug;
  31 use C4::Letters;
  32 use List::MoreUtils qw(any);
  33 use C4::Dates qw(format_date_in_iso);
  34 use base qw(Exporter);
  35
  36 our $VERSION = 3.07.00.049;
  37 our @EXPORT  = qw(
  38   ConnectSuggestionAndBiblio
  39   CountSuggestion
  40   DelSuggestion
  41   GetSuggestion
  42   GetSuggestionByStatus
  43   GetSuggestionFromBiblionumber
  44   GetSuggestionInfoFromBiblionumber
  45   GetSuggestionInfo
  46   ModStatus
  47   ModSuggestion
  48   NewSuggestion
  49   SearchSuggestion
  50   DelSuggestionsOlderThan
  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, he 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.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             if ( defined $suggestion->{$field} and $suggestion->{$field} ne '' )
 162             {
 163                 push @sql_params, $suggestion->{$field};
 164                 push @query,      qq{ AND suggestions.$field=? };
 165             }
 166             else {
 167                 push @query, qq{
 168                     AND (suggestions.$field='' OR suggestions.$field IS NULL)
 169                 };
 170             }
 171         }
 172     }
 173
 174     # filter on date fields
 175     my $today = C4::Dates->today('iso');
 176     foreach my $field (qw( suggesteddate manageddate accepteddate )) {
 177         my $from = $field . "_from";
 178         my $to   = $field . "_to";
 179         if ( $suggestion->{$from} || $suggestion->{$to} ) {
 180             push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
 181             push @sql_params,
 182               format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
 183             push @sql_params,
 184               format_date_in_iso( $suggestion->{$to} ) || $today;
 185         }
 186     }
 187
 188     $debug && warn "@query";
 189     my $sth = $dbh->prepare("@query");
 190     $sth->execute(@sql_params);
 191     my @results;
 192
 193     # add status as field
 194     while ( my $data = $sth->fetchrow_hashref ) {
 195         $data->{ $data->{STATUS} } = 1;
 196         push( @results, $data );
 197     }
 198
 199     return ( \@results );
 200 }
 201
 202 =head2 GetSuggestion
 203
 204 \%sth = &GetSuggestion($ordernumber)
 205
 206 this function get the detail of the suggestion $ordernumber (input arg)
 207
 208 return :
 209     the result of the SQL query as a hash : $sth->fetchrow_hashref.
 210
 211 =cut
 212
 213 sub GetSuggestion {
 214     my ($ordernumber) = @_;
 215     my $dbh           = C4::Context->dbh;
 216     my $query         = q{
 217         SELECT *
 218         FROM   suggestions
 219         WHERE  suggestionid=?
 220     };
 221     my $sth = $dbh->prepare($query);
 222     $sth->execute($ordernumber);
 223     return ( $sth->fetchrow_hashref );
 224 }
 225
 226 =head2 GetSuggestionFromBiblionumber
 227
 228 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 229
 230 Get a suggestion from it's biblionumber.
 231
 232 return :
 233 the id of the suggestion which is related to the biblionumber given on input args.
 234
 235 =cut
 236
 237 sub GetSuggestionFromBiblionumber {
 238     my ($biblionumber) = @_;
 239     my $query = q{
 240         SELECT suggestionid
 241         FROM   suggestions
 242         WHERE  biblionumber=? LIMIT 1
 243     };
 244     my $dbh = C4::Context->dbh;
 245     my $sth = $dbh->prepare($query);
 246     $sth->execute($biblionumber);
 247     my ($suggestionid) = $sth->fetchrow;
 248     return $suggestionid;
 249 }
 250
 251 =head2 GetSuggestionInfoFromBiblionumber
 252
 253 Get a suggestion and borrower's informations from it's biblionumber.
 254
 255 return :
 256 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
 257
 258 =cut
 259
 260 sub GetSuggestionInfoFromBiblionumber {
 261     my ($biblionumber) = @_;
 262     my $query = q{
 263         SELECT suggestions.*,
 264             U1.surname          AS surnamesuggestedby,
 265             U1.firstname        AS firstnamesuggestedby,
 266             U1.borrowernumber   AS borrnumsuggestedby
 267         FROM suggestions
 268             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 269         WHERE biblionumber=?
 270         LIMIT 1
 271     };
 272     my $dbh = C4::Context->dbh;
 273     my $sth = $dbh->prepare($query);
 274     $sth->execute($biblionumber);
 275     return $sth->fetchrow_hashref;
 276 }
 277
 278 =head2 GetSuggestionInfo
 279
 280 Get a suggestion and borrower's informations from it's suggestionid
 281
 282 return :
 283 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
 284
 285 =cut
 286
 287 sub GetSuggestionInfo {
 288     my ($suggestionid) = @_;
 289     my $query = q{
 290         SELECT suggestions.*,
 291             U1.surname          AS surnamesuggestedby,
 292             U1.firstname        AS firstnamesuggestedby,
 293             U1.borrowernumber   AS borrnumsuggestedby
 294         FROM suggestions
 295             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 296         WHERE suggestionid=?
 297         LIMIT 1
 298     };
 299     my $dbh = C4::Context->dbh;
 300     my $sth = $dbh->prepare($query);
 301     $sth->execute($suggestionid);
 302     return $sth->fetchrow_hashref;
 303 }
 304
 305 =head2 GetSuggestionByStatus
 306
 307 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 308
 309 Get a suggestion from it's status
 310
 311 return :
 312 all the suggestion with C<$status>
 313
 314 =cut
 315
 316 sub GetSuggestionByStatus {
 317     my $status     = shift;
 318     my $branchcode = shift;
 319     my $dbh        = C4::Context->dbh;
 320     my @sql_params = ($status);
 321     my $query      = q{
 322         SELECT suggestions.*,
 323             U1.surname          AS surnamesuggestedby,
 324             U1.firstname        AS firstnamesuggestedby,
 325             U1.branchcode       AS branchcodesuggestedby,
 326             B1.branchname       AS branchnamesuggestedby,
 327             U1.borrowernumber   AS borrnumsuggestedby,
 328             U1.categorycode     AS categorycodesuggestedby,
 329             C1.description      AS categorydescriptionsuggestedby,
 330             U2.surname          AS surnamemanagedby,
 331             U2.firstname        AS firstnamemanagedby,
 332             U2.borrowernumber   AS borrnummanagedby
 333         FROM suggestions
 334             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 335             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 336             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 337             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
 338         WHERE status = ?
 339     };
 340
 341     # filter on branch
 342     if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
 343         my $userenv = C4::Context->userenv;
 344         if ($userenv) {
 345             unless ( C4::Context->IsSuperLibrarian() ) {
 346                 push @sql_params, $userenv->{branch};
 347                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 348             }
 349         }
 350         if ($branchcode) {
 351             push @sql_params, $branchcode;
 352             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 353         }
 354     }
 355
 356     my $sth = $dbh->prepare($query);
 357     $sth->execute(@sql_params);
 358     my $results;
 359     $results = $sth->fetchall_arrayref( {} );
 360     return $results;
 361 }
 362
 363 =head2 CountSuggestion
 364
 365 &CountSuggestion($status)
 366
 367 Count the number of aqorders with the status given on input argument.
 368 the arg status can be :
 369
 370 =over 2
 371
 372 =item * ASKED : asked by the user, not dealed by the librarian
 373
 374 =item * ACCEPTED : accepted by the librarian, but not yet ordered
 375
 376 =item * REJECTED : rejected by the librarian (definitive status)
 377
 378 =item * ORDERED : ordered by the librarian (acquisition module)
 379
 380 =back
 381
 382 return :
 383 the number of suggestion with this status.
 384
 385 =cut
 386
 387 sub CountSuggestion {
 388     my ($status) = @_;
 389     my $dbh = C4::Context->dbh;
 390     my $sth;
 391     my $userenv = C4::Context->userenv;
 392     if ( C4::Context->preference("IndependentBranches")
 393         && !C4::Context->IsSuperLibrarian() )
 394     {
 395         my $query = q{
 396             SELECT count(*)
 397             FROM suggestions
 398                 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
 399             WHERE STATUS=?
 400                 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
 401         };
 402         $sth = $dbh->prepare($query);
 403         $sth->execute( $status, $userenv->{branch} );
 404     }
 405     else {
 406         my $query = q{
 407             SELECT count(*)
 408             FROM suggestions
 409             WHERE STATUS=?
 410         };
 411         $sth = $dbh->prepare($query);
 412         $sth->execute($status);
 413     }
 414     my ($result) = $sth->fetchrow;
 415     return $result;
 416 }
 417
 418 =head2 NewSuggestion
 419
 420
 421 &NewSuggestion($suggestion);
 422
 423 Insert a new suggestion on database with value given on input arg.
 424
 425 =cut
 426
 427 sub NewSuggestion {
 428     my ($suggestion) = @_;
 429     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 430     return InsertInTable( "suggestions", $suggestion );
 431 }
 432
 433 =head2 ModSuggestion
 434
 435 &ModSuggestion($suggestion)
 436
 437 Modify the suggestion according to the hash passed by ref.
 438 The hash HAS to contain suggestionid
 439 Data not defined is not updated unless it is a note or sort1
 440 Send a mail to notify the user that did the suggestion.
 441
 442 Note that there is no function to modify a suggestion.
 443
 444 =cut
 445
 446 sub ModSuggestion {
 447     my ($suggestion) = @_;
 448     my $status_update_table = UpdateInTable( "suggestions", $suggestion );
 449
 450     if ( $suggestion->{STATUS} ) {
 451
 452         # fetch the entire updated suggestion so that we can populate the letter
 453         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 454         if (
 455             my $letter = C4::Letters::GetPreparedLetter(
 456                 module      => 'suggestions',
 457                 letter_code => $full_suggestion->{STATUS},
 458                 branchcode  => $full_suggestion->{branchcode},
 459                 tables      => {
 460                     'branches'    => $full_suggestion->{branchcode},
 461                     'borrowers'   => $full_suggestion->{suggestedby},
 462                     'suggestions' => $full_suggestion,
 463                     'biblio'      => $full_suggestion->{biblionumber},
 464                 },
 465             )
 466           )
 467         {
 468             C4::Letters::EnqueueLetter(
 469                 {
 470                     letter         => $letter,
 471                     borrowernumber => $full_suggestion->{suggestedby},
 472                     suggestionid   => $full_suggestion->{suggestionid},
 473                     LibraryName    => C4::Context->preference("LibraryName"),
 474                     message_transport_type => 'email',
 475                 }
 476             ) or warn "can't enqueue letter $letter";
 477         }
 478     }
 479     return $status_update_table;
 480 }
 481
 482 =head2 ConnectSuggestionAndBiblio
 483
 484 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 485
 486 connect a suggestion to an existing biblio
 487
 488 =cut
 489
 490 sub ConnectSuggestionAndBiblio {
 491     my ( $suggestionid, $biblionumber ) = @_;
 492     my $dbh   = C4::Context->dbh;
 493     my $query = q{
 494         UPDATE suggestions
 495         SET    biblionumber=?
 496         WHERE  suggestionid=?
 497     };
 498     my $sth = $dbh->prepare($query);
 499     $sth->execute( $biblionumber, $suggestionid );
 500 }
 501
 502 =head2 DelSuggestion
 503
 504 &DelSuggestion($borrowernumber,$ordernumber)
 505
 506 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
 507
 508 =cut
 509
 510 sub DelSuggestion {
 511     my ( $borrowernumber, $suggestionid, $type ) = @_;
 512     my $dbh = C4::Context->dbh;
 513
 514     # check that the suggestion comes from the suggestor
 515     my $query = q{
 516         SELECT suggestedby
 517         FROM   suggestions
 518         WHERE  suggestionid=?
 519     };
 520     my $sth = $dbh->prepare($query);
 521     $sth->execute($suggestionid);
 522     my ($suggestedby) = $sth->fetchrow;
 523     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 524         my $queryDelete = q{
 525             DELETE FROM suggestions
 526             WHERE suggestionid=?
 527         };
 528         $sth = $dbh->prepare($queryDelete);
 529         my $suggestiondeleted = $sth->execute($suggestionid);
 530         return $suggestiondeleted;
 531     }
 532 }
 533
 534 =head2 DelSuggestionsOlderThan
 535     &DelSuggestionsOlderThan($days)
 536
 537     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 538
 539 =cut
 540
 541 sub DelSuggestionsOlderThan {
 542     my ($days) = @_;
 543     return unless $days;
 544     my $dbh = C4::Context->dbh;
 545     my $sth = $dbh->prepare(
 546         q{
 547         DELETE FROM suggestions
 548         WHERE STATUS<>'ASKED'
 549             AND date < ADDDATE(NOW(), ?)
 550     }
 551     );
 552     $sth->execute("-$days");
 553 }
 554
 555 1;
 556 __END__
 557
 558
 559 =head1 AUTHOR
 560
 561 Koha Development Team <http://koha-community.org/>
 562
 563 =cut
 564