Adding Letters management to Suggestions.
[koha.git] / C4 / Suggestions.pm
blob9741a8485f876fa6477d5c1c80577f38ab3eb02c
1 package C4::Suggestions;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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.
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.
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
21 use strict;
22 use CGI;
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
45 use C4::Dates qw(format_date_in_iso);
46 use vars qw($VERSION @ISA @EXPORT);
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
75 =head1 NAME
77 C4::Suggestions - Some useful functions for dealings with aqorders.
79 =head1 SYNOPSIS
81 use C4::Suggestions;
83 =head1 DESCRIPTION
85 The functions in this module deal with the aqorders in OPAC and in librarian interface
87 A suggestion is done in the OPAC. It has the status "ASKED"
89 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
91 When the book is ordered, the suggestion status becomes "ORDERED"
93 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
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"
98 =head1 FUNCTIONS
100 =head2 SearchSuggestion
102 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
104 searches for a suggestion
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.
112 =cut
114 sub SearchSuggestion {
115 my ($suggestion)=@_;
116 my $dbh = C4::Context->dbh;
117 my @sql_params;
118 my @query =(q{
119 SELECT suggestions.*,
120 U1.branchcode AS branchcodesuggestedby,
121 B1.branchname AS branchnamesuggestedby,
122 U1.surname AS surnamesuggestedby,
123 U1.firstname AS firstnamesuggestedby,
124 U1.borrowernumber AS borrnumsuggestedby,
125 U1.categorycode AS categorycodesuggestedby,
126 C1.description AS categorydescriptionsuggestedby,
127 U2.branchcode AS branchcodemanagedby,
128 B2.branchname AS branchnamemanagedby,
129 U2.surname AS surnamemanagedby,
130 U2.firstname AS firstnamemanagedby,
131 U2.borrowernumber AS borrnummanagedby
132 FROM suggestions
133 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
134 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
135 LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode
136 LEFT JOIN branches AS B1 ON B1.branchcode = U1.branchcode
137 LEFT JOIN branches AS B2 ON B2.branchcode = U2.branchcode
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 )
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 ='')};
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
163 if ($$suggestion{$field}){
164 push @sql_params,$$suggestion{$field};
165 push @query, " and suggestions.$field=?";
167 else {
168 push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)";
172 $debug && warn "@query";
173 my $sth=$dbh->prepare("@query");
174 $sth->execute(@sql_params);
175 return ($sth->fetchall_arrayref({}));
178 =head2 GetSuggestion
180 \%sth = &GetSuggestion($ordernumber)
182 this function get the detail of the suggestion $ordernumber (input arg)
184 return :
185 the result of the SQL query as a hash : $sth->fetchrow_hashref.
187 =cut
189 sub GetSuggestion {
190 my ($ordernumber) = @_;
191 my $dbh = C4::Context->dbh;
192 my $query = "
193 SELECT *
194 FROM suggestions
195 WHERE suggestionid=?
197 my $sth = $dbh->prepare($query);
198 $sth->execute($ordernumber);
199 return($sth->fetchrow_hashref);
202 =head2 GetSuggestionFromBiblionumber
204 $ordernumber = &GetSuggestionFromBiblionumber($dbh,$biblionumber)
206 Get a suggestion from it's biblionumber.
208 return :
209 the id of the suggestion which is related to the biblionumber given on input args.
211 =cut
213 sub GetSuggestionFromBiblionumber {
214 my ($dbh,$biblionumber) = @_;
215 my $query = qq|
216 SELECT suggestionid
217 FROM suggestions
218 WHERE biblionumber=?
220 my $sth = $dbh->prepare($query);
221 $sth->execute($biblionumber);
222 my ($ordernumber) = $sth->fetchrow;
223 return $ordernumber;
226 =head2 GetSuggestionByStatus
228 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
230 Get a suggestion from it's status
232 return :
233 all the suggestion with C<$status>
235 =cut
237 sub GetSuggestionByStatus {
238 my $status = shift;
239 my $branchcode = shift;
240 my $dbh = C4::Context->dbh;
241 my @sql_params=($status);
242 my $query = qq(SELECT suggestions.*,
243 U1.surname AS surnamesuggestedby,
244 U1.firstname AS firstnamesuggestedby,
245 U1.branchcode AS branchcodesuggestedby,
246 B1.branchname AS branchnamesuggestedby,
247 U1.borrowernumber AS borrnumsuggestedby,
248 U1.categorycode AS categorycodesuggestedby,
249 C1.description AS categorydescriptionsuggestedby,
250 U2.surname AS surnamemanagedby,
251 U2.firstname AS firstnamemanagedby,
252 U2.borrowernumber AS borrnummanagedby
253 FROM suggestions
254 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
255 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
256 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
257 LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode
258 WHERE status = ?);
259 if (C4::Context->preference("IndependantBranches") || $branchcode) {
260 my $userenv = C4::Context->userenv;
261 if ($userenv) {
262 unless ($userenv->{flags} % 2 == 1){
263 push @sql_params,$userenv->{branch};
264 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
267 if ($branchcode) {
268 push @sql_params,$branchcode;
269 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
273 my $sth = $dbh->prepare($query);
274 $sth->execute(@sql_params);
276 my $results;
277 $results= $sth->fetchall_arrayref({});
278 return $results;
281 =head2 CountSuggestion
283 &CountSuggestion($status)
285 Count the number of aqorders with the status given on input argument.
286 the arg status can be :
288 =over 2
290 =item * ASKED : asked by the user, not dealed by the librarian
292 =item * ACCEPTED : accepted by the librarian, but not yet ordered
294 =item * REJECTED : rejected by the librarian (definitive status)
296 =item * ORDERED : ordered by the librarian (acquisition module)
298 =back
300 return :
301 the number of suggestion with this status.
303 =cut
305 sub CountSuggestion {
306 my ($status) = @_;
307 my $dbh = C4::Context->dbh;
308 my $sth;
309 if (C4::Context->preference("IndependantBranches")){
310 my $userenv = C4::Context->userenv;
311 if ($userenv->{flags} % 2 == 1){
312 my $query = qq |
313 SELECT count(*)
314 FROM suggestions
315 WHERE STATUS=?
317 $sth = $dbh->prepare($query);
318 $sth->execute($status);
320 else {
321 my $query = qq |
322 SELECT count(*)
323 FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
324 WHERE STATUS=?
325 AND (borrowers.branchcode='' OR borrowers.branchcode =?)
327 $sth = $dbh->prepare($query);
328 $sth->execute($status,$userenv->{branch});
331 else {
332 my $query = qq |
333 SELECT count(*)
334 FROM suggestions
335 WHERE STATUS=?
337 $sth = $dbh->prepare($query);
338 $sth->execute($status);
340 my ($result) = $sth->fetchrow;
341 return $result;
344 =head2 NewSuggestion
347 &NewSuggestion($suggestion)
349 Insert a new suggestion on database with value given on input arg.
351 =cut
353 sub NewSuggestion {
354 my ($suggestion) = @_;
355 $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS};
356 return InsertInTable("suggestions",$suggestion);
359 =head2 ModSuggestion
361 &ModSuggestion($suggestion)
363 Modify the suggestion according to the hash passed by ref.
364 The hash HAS to contain suggestionid
365 Data not defined is not updated unless it is a note or sort1
366 Send a mail to notify the user that did the suggestion.
368 Note that there is no function to modify a suggestion.
370 =cut
372 sub ModSuggestion {
373 my ($suggestion)=@_;
374 my $status_update_table=UpdateInTable("suggestions", $suggestion);
375 # check mail sending.
376 if ($$suggestion{STATUS}){
377 my $letter=C4::Letters::getletter('suggestions',$$suggestion{STATUS});
378 if ($letter){
379 my $enqueued = C4::Letters::EnqueueLetter({
380 letter=>$letter,
381 borrowernumber=>$$suggestion{suggestedby},
382 suggestionid=>$$suggestion{suggestionid},
383 msg_transport_type=>'email'
385 if (!$enqueued){warn "can't enqueue letter $letter";}
388 return $status_update_table;
391 =head2 ConnectSuggestionAndBiblio
393 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
395 connect a suggestion to an existing biblio
397 =cut
399 sub ConnectSuggestionAndBiblio {
400 my ($ordernumber,$biblionumber) = @_;
401 my $dbh=C4::Context->dbh;
402 my $query = "
403 UPDATE suggestions
404 SET biblionumber=?
405 WHERE suggestionid=?
407 my $sth = $dbh->prepare($query);
408 $sth->execute($biblionumber,$suggestionid);
411 =head2 DelSuggestion
413 &DelSuggestion($borrowernumber,$ordernumber)
415 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
417 =cut
419 sub DelSuggestion {
420 my ($borrowernumber,$ordernumber,$type) = @_;
421 my $dbh = C4::Context->dbh;
422 # check that the suggestion comes from the suggestor
423 my $query = "
424 SELECT suggestedby
425 FROM suggestions
426 WHERE suggestionid=?
428 my $sth = $dbh->prepare($query);
429 $sth->execute($ordernumber);
430 my ($suggestedby) = $sth->fetchrow;
431 if ($type eq "intranet" || $suggestedby eq $borrowernumber ) {
432 my $queryDelete = "
433 DELETE FROM suggestions
434 WHERE suggestionid=?
436 $sth = $dbh->prepare($queryDelete);
437 my $suggestiondeleted=$sth->execute($suggestionid);
438 return $suggestiondeleted;
443 __END__
446 =head1 AUTHOR
448 Koha Developement team <info@koha.org>
450 =cut