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