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