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