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