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