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