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