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