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