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