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