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