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