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