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