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