C4/Suggestions.pm

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