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