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