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