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     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 430
 431     my $rs = Koha::Database->new->schema->resultset('Suggestion');
 432     return $rs->create($suggestion)->id;
 433 }
 434
 435 =head2 ModSuggestion
 436
 437 &ModSuggestion($suggestion)
 438
 439 Modify the suggestion according to the hash passed by ref.
 440 The hash HAS to contain suggestionid
 441 Data not defined is not updated unless it is a note or sort1
 442 Send a mail to notify the user that did the suggestion.
 443
 444 Note that there is no function to modify a suggestion.
 445
 446 =cut
 447
 448 sub ModSuggestion {
 449     my ($suggestion) = @_;
 450     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 451
 452     my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
 453     my $status_update_table = 1;
 454     eval {
 455         $rs->update($suggestion);
 456     };
 457     $status_update_table = 0 if( $@ );
 458
 459     if ( $suggestion->{STATUS} ) {
 460
 461         # fetch the entire updated suggestion so that we can populate the letter
 462         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 463         if (
 464             my $letter = C4::Letters::GetPreparedLetter(
 465                 module      => 'suggestions',
 466                 letter_code => $full_suggestion->{STATUS},
 467                 branchcode  => $full_suggestion->{branchcode},
 468                 tables      => {
 469                     'branches'    => $full_suggestion->{branchcode},
 470                     'borrowers'   => $full_suggestion->{suggestedby},
 471                     'suggestions' => $full_suggestion,
 472                     'biblio'      => $full_suggestion->{biblionumber},
 473                 },
 474             )
 475           )
 476         {
 477             C4::Letters::EnqueueLetter(
 478                 {
 479                     letter         => $letter,
 480                     borrowernumber => $full_suggestion->{suggestedby},
 481                     suggestionid   => $full_suggestion->{suggestionid},
 482                     LibraryName    => C4::Context->preference("LibraryName"),
 483                     message_transport_type => 'email',
 484                 }
 485             ) or warn "can't enqueue letter $letter";
 486         }
 487     }
 488     return $status_update_table;
 489 }
 490
 491 =head2 ConnectSuggestionAndBiblio
 492
 493 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 494
 495 connect a suggestion to an existing biblio
 496
 497 =cut
 498
 499 sub ConnectSuggestionAndBiblio {
 500     my ( $suggestionid, $biblionumber ) = @_;
 501     my $dbh   = C4::Context->dbh;
 502     my $query = q{
 503         UPDATE suggestions
 504         SET    biblionumber=?
 505         WHERE  suggestionid=?
 506     };
 507     my $sth = $dbh->prepare($query);
 508     $sth->execute( $biblionumber, $suggestionid );
 509 }
 510
 511 =head2 DelSuggestion
 512
 513 &DelSuggestion($borrowernumber,$ordernumber)
 514
 515 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
 516
 517 =cut
 518
 519 sub DelSuggestion {
 520     my ( $borrowernumber, $suggestionid, $type ) = @_;
 521     my $dbh = C4::Context->dbh;
 522
 523     # check that the suggestion comes from the suggestor
 524     my $query = q{
 525         SELECT suggestedby
 526         FROM   suggestions
 527         WHERE  suggestionid=?
 528     };
 529     my $sth = $dbh->prepare($query);
 530     $sth->execute($suggestionid);
 531     my ($suggestedby) = $sth->fetchrow;
 532     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 533         my $queryDelete = q{
 534             DELETE FROM suggestions
 535             WHERE suggestionid=?
 536         };
 537         $sth = $dbh->prepare($queryDelete);
 538         my $suggestiondeleted = $sth->execute($suggestionid);
 539         return $suggestiondeleted;
 540     }
 541 }
 542
 543 =head2 DelSuggestionsOlderThan
 544     &DelSuggestionsOlderThan($days)
 545
 546     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 547
 548 =cut
 549
 550 sub DelSuggestionsOlderThan {
 551     my ($days) = @_;
 552     return unless $days;
 553     my $dbh = C4::Context->dbh;
 554     my $sth = $dbh->prepare(
 555         q{
 556         DELETE FROM suggestions
 557         WHERE STATUS<>'ASKED'
 558             AND date < ADDDATE(NOW(), ?)
 559     }
 560     );
 561     $sth->execute("-$days");
 562 }
 563
 564 1;
 565 __END__
 566
 567
 568 =head1 AUTHOR
 569
 570 Koha Development Team <http://koha-community.org/>
 571
 572 =cut
 573