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