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
  22 use strict;
  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);
  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 our $VERSION = 3.01;
  36 our @EXPORT  = qw<
  37     ConnectSuggestionAndBiblio
  38     CountSuggestion
  39     DelSuggestion
  40     GetSuggestion
  41     GetSuggestionByStatus
  42     GetSuggestionFromBiblionumber
  43     ModStatus
  44     ModSuggestion
  45     NewSuggestion
  46     SearchSuggestion
  47     DelSuggestionsOlderThan
  48 >;
  49
  50 =head1 NAME
  51
  52 C4::Suggestions - Some useful functions for dealings with aqorders.
  53
  54 =head1 SYNOPSIS
  55
  56 use C4::Suggestions;
  57
  58 =head1 DESCRIPTION
  59
  60 The functions in this module deal with the aqorders in OPAC and in librarian interface
  61
  62 A suggestion is done in the OPAC. It has the status "ASKED"
  63
  64 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
  65
  66 When the book is ordered, the suggestion status becomes "ORDERED"
  67
  68 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
  69
  70 All aqorders of a borrower can be seen by the borrower itself.
  71 Suggestions done by other borrowers can be seen when not "AVAILABLE"
  72
  73 =head1 FUNCTIONS
  74
  75 =head2 SearchSuggestion
  76
  77 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
  78
  79 searches for a suggestion
  80
  81 return :
  82 C<\@array> : the aqorders found. Array of hash.
  83 Note the status is stored twice :
  84 * in the status field
  85 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
  86
  87 =cut
  88
  89 sub SearchSuggestion  {
  90     my ($suggestion)=@_;
  91     my $dbh = C4::Context->dbh;
  92     my @sql_params;
  93     my @query = (
  94     q{ SELECT suggestions.*,
  95         U1.branchcode   AS branchcodesuggestedby,
  96         B1.branchname   AS branchnamesuggestedby,
  97         U1.surname   AS surnamesuggestedby,
  98         U1.firstname AS firstnamesuggestedby,
  99         U1.email AS emailsuggestedby,
 100         U1.borrowernumber AS borrnumsuggestedby,
 101         U1.categorycode AS categorycodesuggestedby,
 102         C1.description AS categorydescriptionsuggestedby,
 103         U2.surname   AS surnamemanagedby,
 104         U2.firstname AS firstnamemanagedby,
 105         B2.branchname   AS branchnamesuggestedby,
 106         U2.email AS emailmanagedby,
 107         U2.branchcode AS branchcodemanagedby,
 108         U2.borrowernumber AS borrnummanagedby
 109     FROM suggestions
 110     LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 111     LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
 112     LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode
 113     LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
 114     LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
 115     LEFT JOIN categories AS C2 ON C2.categorycode = U2.categorycode
 116     WHERE STATUS NOT IN ('CLAIMED')
 117     } , map {
 118         if ( my $s = $suggestion->{$_} ) {
 119         push @sql_params,'%'.$s.'%';
 120         " and suggestions.$_ like ? ";
 121         } else { () }
 122     } qw( title author isbn publishercode collectiontitle )
 123     );
 124
 125     my $userenv = C4::Context->userenv;
 126     if (C4::Context->preference('IndependantBranches')) {
 127             if ($userenv) {
 128                 if (($userenv->{flags} % 2) != 1 && !$suggestion->{branchcode}){
 129                 push @sql_params,$$userenv{branch};
 130                 push @query,q{ and (branchcode = ? or branchcode ='')};
 131                 }
 132             }
 133     }
 134
 135     foreach my $field (grep { my $fieldname=$_;
 136         any {$fieldname eq $_ } qw<
 137     STATUS branchcode itemtype suggestedby managedby acceptedby
 138     bookfundid biblionumber
 139     >} keys %$suggestion
 140     ) {
 141         if ($$suggestion{$field}){
 142             push @sql_params,$suggestion->{$field};
 143             push @query, " and suggestions.$field=?";
 144         }
 145         else {
 146             push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)";
 147         }
 148     }
 149
 150     $debug && warn "@query";
 151     my $sth=$dbh->prepare("@query");
 152     $sth->execute(@sql_params);
 153     my @results;
 154     while ( my $data=$sth->fetchrow_hashref ){
 155         $$data{$$data{STATUS}} = 1;
 156         push(@results,$data);
 157     }
 158     return (\@results);
 159 }
 160
 161 =head2 GetSuggestion
 162
 163 \%sth = &GetSuggestion($ordernumber)
 164
 165 this function get the detail of the suggestion $ordernumber (input arg)
 166
 167 return :
 168     the result of the SQL query as a hash : $sth->fetchrow_hashref.
 169
 170 =cut
 171
 172 sub GetSuggestion {
 173     my ($ordernumber) = @_;
 174     my $dbh = C4::Context->dbh;
 175     my $query = "
 176         SELECT *
 177         FROM   suggestions
 178         WHERE  suggestionid=?
 179     ";
 180     my $sth = $dbh->prepare($query);
 181     $sth->execute($ordernumber);
 182     return($sth->fetchrow_hashref);
 183 }
 184
 185 =head2 GetSuggestionFromBiblionumber
 186
 187 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 188
 189 Get a suggestion from it's biblionumber.
 190
 191 return :
 192 the id of the suggestion which is related to the biblionumber given on input args.
 193
 194 =cut
 195
 196 sub GetSuggestionFromBiblionumber {
 197     my ($biblionumber) = @_;
 198     my $query = q{
 199         SELECT suggestionid
 200         FROM   suggestions
 201         WHERE  biblionumber=?
 202     };
 203     my $dbh=C4::Context->dbh;
 204     my $sth = $dbh->prepare($query);
 205     $sth->execute($biblionumber);
 206     my ($ordernumber) = $sth->fetchrow;
 207     return $ordernumber;
 208 }
 209
 210 =head2 GetSuggestionByStatus
 211
 212 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 213
 214 Get a suggestion from it's status
 215
 216 return :
 217 all the suggestion with C<$status>
 218
 219 =cut
 220
 221 sub GetSuggestionByStatus {
 222     my $status = shift;
 223     my $branchcode = shift;
 224     my $dbh = C4::Context->dbh;
 225     my @sql_params=($status);
 226     my $query = qq(SELECT suggestions.*,
 227                         U1.surname   AS surnamesuggestedby,
 228                         U1.firstname AS firstnamesuggestedby,
 229                         U1.branchcode AS branchcodesuggestedby,
 230                         B1.branchname AS branchnamesuggestedby,
 231                         U1.borrowernumber AS borrnumsuggestedby,
 232                         U1.categorycode AS categorycodesuggestedby,
 233                         C1.description AS categorydescriptionsuggestedby,
 234                         U2.surname   AS surnamemanagedby,
 235                         U2.firstname AS firstnamemanagedby,
 236                         U2.borrowernumber AS borrnummanagedby
 237                         FROM suggestions
 238                         LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 239                         LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
 240                         LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
 241                         LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode
 242                         WHERE status = ?);
 243     if (C4::Context->preference("IndependantBranches") || $branchcode) {
 244         my $userenv = C4::Context->userenv;
 245         if ($userenv) {
 246             unless ($userenv->{flags} % 2 == 1){
 247                 push @sql_params,$userenv->{branch};
 248                 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
 249             }
 250         }
 251         if ($branchcode) {
 252             push @sql_params,$branchcode;
 253             $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
 254         }
 255     }
 256
 257     my $sth = $dbh->prepare($query);
 258     $sth->execute(@sql_params);
 259
 260     my $results;
 261     $results=  $sth->fetchall_arrayref({});
 262     return $results;
 263 }
 264
 265 =head2 CountSuggestion
 266
 267 &CountSuggestion($status)
 268
 269 Count the number of aqorders with the status given on input argument.
 270 the arg status can be :
 271
 272 =over 2
 273
 274 =item * ASKED : asked by the user, not dealed by the librarian
 275
 276 =item * ACCEPTED : accepted by the librarian, but not yet ordered
 277
 278 =item * REJECTED : rejected by the librarian (definitive status)
 279
 280 =item * ORDERED : ordered by the librarian (acquisition module)
 281
 282 =back
 283
 284 return :
 285 the number of suggestion with this status.
 286
 287 =cut
 288
 289 sub CountSuggestion {
 290     my ($status) = @_;
 291     my $dbh = C4::Context->dbh;
 292     my $sth;
 293     if (C4::Context->preference("IndependantBranches")){
 294         my $userenv = C4::Context->userenv;
 295         if ($userenv->{flags} % 2 == 1){
 296             my $query = qq |
 297                 SELECT count(*)
 298                 FROM   suggestions
 299                 WHERE  STATUS=?
 300             |;
 301             $sth = $dbh->prepare($query);
 302             $sth->execute($status);
 303         }
 304         else {
 305             my $query = qq |
 306                 SELECT count(*)
 307                 FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
 308                 WHERE STATUS=?
 309                 AND (borrowers.branchcode='' OR borrowers.branchcode =?)
 310             |;
 311             $sth = $dbh->prepare($query);
 312             $sth->execute($status,$userenv->{branch});
 313         }
 314     }
 315     else {
 316         my $query = qq |
 317             SELECT count(*)
 318             FROM suggestions
 319             WHERE STATUS=?
 320         |;
 321         $sth = $dbh->prepare($query);
 322         $sth->execute($status);
 323     }
 324     my ($result) = $sth->fetchrow;
 325     return $result;
 326 }
 327
 328 =head2 NewSuggestion
 329
 330
 331 &NewSuggestion($suggestion);
 332
 333 Insert a new suggestion on database with value given on input arg.
 334
 335 =cut
 336
 337 sub NewSuggestion {
 338     my ($suggestion) = @_;
 339     $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS};
 340     return InsertInTable("suggestions",$suggestion);
 341 }
 342
 343 =head2 ModSuggestion
 344
 345 &ModSuggestion($suggestion)
 346
 347 Modify the suggestion according to the hash passed by ref.
 348 The hash HAS to contain suggestionid
 349 Data not defined is not updated unless it is a note or sort1
 350 Send a mail to notify the user that did the suggestion.
 351
 352 Note that there is no function to modify a suggestion.
 353
 354 =cut
 355
 356 sub ModSuggestion {
 357     my ($suggestion)=@_;
 358     my $status_update_table=UpdateInTable("suggestions", $suggestion);
 359
 360     if ($suggestion->{STATUS}) {
 361         # fetch the entire updated suggestion so that we can populate the letter
 362         my $full_suggestion = GetSuggestion($suggestion->{suggestionid});
 363         my $letter = C4::Letters::getletter('suggestions', $full_suggestion->{STATUS});
 364         if ($letter) {
 365             C4::Letters::parseletter($letter, 'branches',    $full_suggestion->{branchcode});
 366             C4::Letters::parseletter($letter, 'borrowers',   $full_suggestion->{suggestedby});
 367             C4::Letters::parseletter($letter, 'suggestions', $full_suggestion->{suggestionid});
 368             C4::Letters::parseletter($letter, 'biblio',      $full_suggestion->{biblionumber});
 369             my $enqueued = C4::Letters::EnqueueLetter({
 370                 letter                  => $letter,
 371                 borrowernumber          => $full_suggestion->{suggestedby},
 372                 suggestionid            => $full_suggestion->{suggestionid},
 373                 LibraryName             => C4::Context->preference("LibraryName"),
 374                 message_transport_type  => 'email',
 375             });
 376             if (!$enqueued){warn "can't enqueue letter $letter";}
 377         }
 378     }
 379     return $status_update_table;
 380 }
 381
 382 =head2 ConnectSuggestionAndBiblio
 383
 384 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 385
 386 connect a suggestion to an existing biblio
 387
 388 =cut
 389
 390 sub ConnectSuggestionAndBiblio {
 391     my ($suggestionid,$biblionumber) = @_;
 392     my $dbh=C4::Context->dbh;
 393     my $query = "
 394         UPDATE suggestions
 395         SET    biblionumber=?
 396         WHERE  suggestionid=?
 397     ";
 398     my $sth = $dbh->prepare($query);
 399     $sth->execute($biblionumber,$suggestionid);
 400 }
 401
 402 =head2 DelSuggestion
 403
 404 &DelSuggestion($borrowernumber,$ordernumber)
 405
 406 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
 407
 408 =cut
 409
 410 sub DelSuggestion {
 411     my ($borrowernumber,$suggestionid,$type) = @_;
 412     my $dbh = C4::Context->dbh;
 413     # check that the suggestion comes from the suggestor
 414     my $query = "
 415         SELECT suggestedby
 416         FROM   suggestions
 417         WHERE  suggestionid=?
 418     ";
 419     my $sth = $dbh->prepare($query);
 420     $sth->execute($suggestionid);
 421     my ($suggestedby) = $sth->fetchrow;
 422     if ($type eq "intranet" || $suggestedby eq $borrowernumber ) {
 423         my $queryDelete = "
 424             DELETE FROM suggestions
 425             WHERE suggestionid=?
 426         ";
 427         $sth = $dbh->prepare($queryDelete);
 428         my $suggestiondeleted=$sth->execute($suggestionid);
 429         return $suggestiondeleted;
 430     }
 431 }
 432
 433 =head2 DelSuggestionsOlderThan
 434     &DelSuggestionsOlderThan($days)
 435
 436     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 437
 438 =cut
 439 sub DelSuggestionsOlderThan {
 440     my ($days) = @_;
 441     return if not $days;
 442     my $dbh = C4::Context->dbh;
 443
 444     my $sth = $dbh->prepare("
 445         DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?);
 446     ");
 447     $sth->execute("-$days");
 448 }
 449
 450 1;
 451 __END__
 452
 453
 454 =head1 AUTHOR
 455
 456 Koha Development Team <http://koha-community.org/>
 457
 458 =cut
 459