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                 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     ) ) {
 441         # Set the fields to NULL if not given.
 442         $suggestion->{$field} ||= undef;
 443     }
 444
 445     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 446
 447     $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
 448
 449     my $rs = Koha::Database->new->schema->resultset('Suggestion');
 450     return $rs->create($suggestion)->id;
 451 }
 452
 453 =head2 ModSuggestion
 454
 455 &ModSuggestion($suggestion)
 456
 457 Modify the suggestion according to the hash passed by ref.
 458 The hash HAS to contain suggestionid
 459 Data not defined is not updated unless it is a note or sort1
 460 Send a mail to notify the user that did the suggestion.
 461
 462 Note that there is no function to modify a suggestion.
 463
 464 =cut
 465
 466 sub ModSuggestion {
 467     my ($suggestion) = @_;
 468     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 469
 470     for my $field ( qw(
 471         suggestedby
 472         managedby
 473         manageddate
 474         acceptedby
 475         accepteddate
 476         rejectedby
 477         rejecteddate
 478     ) ) {
 479         # Set the fields to NULL if not given.
 480         $suggestion->{$field} = undef
 481           if exists $suggestion->{$field}
 482           and ($suggestion->{$field} eq '0'
 483             or $suggestion->{$field} eq '' );
 484     }
 485
 486     my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
 487     my $status_update_table = 1;
 488     eval {
 489         $rs->update($suggestion);
 490     };
 491     $status_update_table = 0 if( $@ );
 492
 493     if ( $suggestion->{STATUS} ) {
 494
 495         # fetch the entire updated suggestion so that we can populate the letter
 496         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 497         if (
 498             my $letter = C4::Letters::GetPreparedLetter(
 499                 module      => 'suggestions',
 500                 letter_code => $full_suggestion->{STATUS},
 501                 branchcode  => $full_suggestion->{branchcode},
 502                 tables      => {
 503                     'branches'    => $full_suggestion->{branchcode},
 504                     'borrowers'   => $full_suggestion->{suggestedby},
 505                     'suggestions' => $full_suggestion,
 506                     'biblio'      => $full_suggestion->{biblionumber},
 507                 },
 508             )
 509           )
 510         {
 511             C4::Letters::EnqueueLetter(
 512                 {
 513                     letter         => $letter,
 514                     borrowernumber => $full_suggestion->{suggestedby},
 515                     suggestionid   => $full_suggestion->{suggestionid},
 516                     LibraryName    => C4::Context->preference("LibraryName"),
 517                     message_transport_type => 'email',
 518                 }
 519             ) or warn "can't enqueue letter $letter";
 520         }
 521     }
 522     return $status_update_table;
 523 }
 524
 525 =head2 ConnectSuggestionAndBiblio
 526
 527 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 528
 529 connect a suggestion to an existing biblio
 530
 531 =cut
 532
 533 sub ConnectSuggestionAndBiblio {
 534     my ( $suggestionid, $biblionumber ) = @_;
 535     my $dbh   = C4::Context->dbh;
 536     my $query = q{
 537         UPDATE suggestions
 538         SET    biblionumber=?
 539         WHERE  suggestionid=?
 540     };
 541     my $sth = $dbh->prepare($query);
 542     $sth->execute( $biblionumber, $suggestionid );
 543 }
 544
 545 =head2 DelSuggestion
 546
 547 &DelSuggestion($borrowernumber,$ordernumber)
 548
 549 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
 550
 551 =cut
 552
 553 sub DelSuggestion {
 554     my ( $borrowernumber, $suggestionid, $type ) = @_;
 555     my $dbh = C4::Context->dbh;
 556
 557     # check that the suggestion comes from the suggestor
 558     my $query = q{
 559         SELECT suggestedby
 560         FROM   suggestions
 561         WHERE  suggestionid=?
 562     };
 563     my $sth = $dbh->prepare($query);
 564     $sth->execute($suggestionid);
 565     my ($suggestedby) = $sth->fetchrow;
 566     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 567         my $queryDelete = q{
 568             DELETE FROM suggestions
 569             WHERE suggestionid=?
 570         };
 571         $sth = $dbh->prepare($queryDelete);
 572         my $suggestiondeleted = $sth->execute($suggestionid);
 573         return $suggestiondeleted;
 574     }
 575 }
 576
 577 =head2 DelSuggestionsOlderThan
 578     &DelSuggestionsOlderThan($days)
 579
 580     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 581
 582 =cut
 583
 584 sub DelSuggestionsOlderThan {
 585     my ($days) = @_;
 586     return unless $days;
 587     my $dbh = C4::Context->dbh;
 588     my $sth = $dbh->prepare(
 589         q{
 590         DELETE FROM suggestions
 591         WHERE STATUS<>'ASKED'
 592             AND date < ADDDATE(NOW(), ?)
 593     }
 594     );
 595     $sth->execute("-$days");
 596 }
 597
 598 1;
 599 __END__
 600
 601
 602 =head1 AUTHOR
 603
 604 Koha Development Team <http://koha-community.org/>
 605
 606 =cut
 607