Bug 2742 Followup patch fixing Norwegian bokmål, adding nynorsk
[koha.git] / C4 / Suggestions.pm
blob81ff73169609dff39ecd5dabd21a148c2e30c04e
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
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 use strict;
22 #use warnings; FIXME - Bug 2505
23 use CGI;
25 use C4::Context;
26 use C4::Output;
27 use C4::Dates qw(format_date);
28 use C4::SQLHelper qw(:all);
29 use C4::Debug;
30 use C4::Letters;
31 use List::MoreUtils qw<any>;
32 use C4::Dates qw(format_date_in_iso);
33 use base qw(Exporter);
34 our $VERSION = 3.01;
35 our @EXPORT = qw<
36 ConnectSuggestionAndBiblio
37 CountSuggestion
38 DelSuggestion
39 GetSuggestion
40 GetSuggestionByStatus
41 GetSuggestionFromBiblionumber
42 ModStatus
43 ModSuggestion
44 NewSuggestion
45 SearchSuggestion
49 =head1 NAME
51 C4::Suggestions - Some useful functions for dealings with aqorders.
53 =head1 SYNOPSIS
55 use C4::Suggestions;
57 =head1 DESCRIPTION
59 The functions in this module deal with the aqorders in OPAC and in librarian interface
61 A suggestion is done in the OPAC. It has the status "ASKED"
63 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
65 When the book is ordered, the suggestion status becomes "ORDERED"
67 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
69 All aqorders of a borrower can be seen by the borrower itself.
70 Suggestions done by other borrowers can be seen when not "AVAILABLE"
72 =head1 FUNCTIONS
74 =head2 SearchSuggestion
76 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
78 searches for a suggestion
80 return :
81 C<\@array> : the aqorders found. Array of hash.
82 Note the status is stored twice :
83 * in the status field
84 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
86 =cut
88 sub SearchSuggestion {
89 my ($suggestion)=@_;
90 my $dbh = C4::Context->dbh;
91 my @sql_params;
92 my @query = (
93 q{ SELECT suggestions.*,
94 U1.branchcode AS branchcodesuggestedby,
95 B1.branchname AS branchnamesuggestedby,
96 U1.surname AS surnamesuggestedby,
97 U1.firstname AS firstnamesuggestedby,
98 U1.email AS emailsuggestedby,
99 U1.borrowernumber AS borrnumsuggestedby,
100 U1.categorycode AS categorycodesuggestedby,
101 C1.description AS categorydescriptionsuggestedby,
102 U2.surname AS surnamemanagedby,
103 U2.firstname AS firstnamemanagedby,
104 B2.branchname AS branchnamesuggestedby,
105 U2.email AS emailmanagedby,
106 U2.branchcode AS branchcodemanagedby,
107 U2.borrowernumber AS borrnummanagedby
108 FROM suggestions
109 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
110 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
111 LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode
112 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
113 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
114 LEFT JOIN categories AS C2 ON C2.categorycode = U2.categorycode
115 WHERE STATUS NOT IN ('CLAIMED')
116 } , map {
117 if ( my $s = $suggestion->{$_} ) {
118 push @sql_params,'%'.$s.'%';
119 " and suggestions.$_ like ? ";
120 } else { () }
121 } qw( title author isbn publishercode collectiontitle )
124 my $userenv = C4::Context->userenv;
125 if (C4::Context->preference('IndependantBranches')) {
126 if ($userenv) {
127 if (($userenv->{flags} % 2) != 1 && !$suggestion->{branchcode}){
128 push @sql_params,$$userenv{branch};
129 push @query,q{ and (branchcode = ? or branchcode ='')};
134 foreach my $field (grep { my $fieldname=$_;
135 any {$fieldname eq $_ } qw<
136 STATUS branchcode itemtype suggestedby managedby acceptedby
137 bookfundid biblionumber
138 >} keys %$suggestion
140 if ($$suggestion{$field}){
141 push @sql_params,$suggestion->{$field};
142 push @query, " and suggestions.$field=?";
144 else {
145 push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)";
149 $debug && warn "@query";
150 my $sth=$dbh->prepare("@query");
151 $sth->execute(@sql_params);
152 my @results;
153 while ( my $data=$sth->fetchrow_hashref ){
154 $$data{$$data{STATUS}} = 1;
155 push(@results,$data);
157 return (\@results);
160 =head2 GetSuggestion
162 \%sth = &GetSuggestion($ordernumber)
164 this function get the detail of the suggestion $ordernumber (input arg)
166 return :
167 the result of the SQL query as a hash : $sth->fetchrow_hashref.
169 =cut
171 sub GetSuggestion {
172 my ($ordernumber) = @_;
173 my $dbh = C4::Context->dbh;
174 my $query = "
175 SELECT *
176 FROM suggestions
177 WHERE suggestionid=?
179 my $sth = $dbh->prepare($query);
180 $sth->execute($ordernumber);
181 return($sth->fetchrow_hashref);
184 =head2 GetSuggestionFromBiblionumber
186 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
188 Get a suggestion from it's biblionumber.
190 return :
191 the id of the suggestion which is related to the biblionumber given on input args.
193 =cut
195 sub GetSuggestionFromBiblionumber {
196 my ($biblionumber) = @_;
197 my $query = q{
198 SELECT suggestionid
199 FROM suggestions
200 WHERE biblionumber=?
202 my $dbh=C4::Context->dbh;
203 my $sth = $dbh->prepare($query);
204 $sth->execute($biblionumber);
205 my ($ordernumber) = $sth->fetchrow;
206 return $ordernumber;
209 =head2 GetSuggestionByStatus
211 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
213 Get a suggestion from it's status
215 return :
216 all the suggestion with C<$status>
218 =cut
220 sub GetSuggestionByStatus {
221 my $status = shift;
222 my $branchcode = shift;
223 my $dbh = C4::Context->dbh;
224 my @sql_params=($status);
225 my $query = qq(SELECT suggestions.*,
226 U1.surname AS surnamesuggestedby,
227 U1.firstname AS firstnamesuggestedby,
228 U1.branchcode AS branchcodesuggestedby,
229 B1.branchname AS branchnamesuggestedby,
230 U1.borrowernumber AS borrnumsuggestedby,
231 U1.categorycode AS categorycodesuggestedby,
232 C1.description AS categorydescriptionsuggestedby,
233 U2.surname AS surnamemanagedby,
234 U2.firstname AS firstnamemanagedby,
235 U2.borrowernumber AS borrnummanagedby
236 FROM suggestions
237 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
238 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
239 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
240 LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode
241 WHERE status = ?);
242 if (C4::Context->preference("IndependantBranches") || $branchcode) {
243 my $userenv = C4::Context->userenv;
244 if ($userenv) {
245 unless ($userenv->{flags} % 2 == 1){
246 push @sql_params,$userenv->{branch};
247 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
250 if ($branchcode) {
251 push @sql_params,$branchcode;
252 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
256 my $sth = $dbh->prepare($query);
257 $sth->execute(@sql_params);
259 my $results;
260 $results= $sth->fetchall_arrayref({});
261 return $results;
264 =head2 CountSuggestion
266 &CountSuggestion($status)
268 Count the number of aqorders with the status given on input argument.
269 the arg status can be :
271 =over 2
273 =item * ASKED : asked by the user, not dealed by the librarian
275 =item * ACCEPTED : accepted by the librarian, but not yet ordered
277 =item * REJECTED : rejected by the librarian (definitive status)
279 =item * ORDERED : ordered by the librarian (acquisition module)
281 =back
283 return :
284 the number of suggestion with this status.
286 =cut
288 sub CountSuggestion {
289 my ($status) = @_;
290 my $dbh = C4::Context->dbh;
291 my $sth;
292 if (C4::Context->preference("IndependantBranches")){
293 my $userenv = C4::Context->userenv;
294 if ($userenv->{flags} % 2 == 1){
295 my $query = qq |
296 SELECT count(*)
297 FROM suggestions
298 WHERE STATUS=?
300 $sth = $dbh->prepare($query);
301 $sth->execute($status);
303 else {
304 my $query = qq |
305 SELECT count(*)
306 FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
307 WHERE STATUS=?
308 AND (borrowers.branchcode='' OR borrowers.branchcode =?)
310 $sth = $dbh->prepare($query);
311 $sth->execute($status,$userenv->{branch});
314 else {
315 my $query = qq |
316 SELECT count(*)
317 FROM suggestions
318 WHERE STATUS=?
320 $sth = $dbh->prepare($query);
321 $sth->execute($status);
323 my ($result) = $sth->fetchrow;
324 return $result;
327 =head2 NewSuggestion
330 &NewSuggestion($suggestion);
332 Insert a new suggestion on database with value given on input arg.
334 =cut
336 sub NewSuggestion {
337 my ($suggestion) = @_;
338 $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS};
339 return InsertInTable("suggestions",$suggestion);
342 =head2 ModSuggestion
344 &ModSuggestion($suggestion)
346 Modify the suggestion according to the hash passed by ref.
347 The hash HAS to contain suggestionid
348 Data not defined is not updated unless it is a note or sort1
349 Send a mail to notify the user that did the suggestion.
351 Note that there is no function to modify a suggestion.
353 =cut
355 sub ModSuggestion {
356 my ($suggestion)=@_;
357 my $status_update_table=UpdateInTable("suggestions", $suggestion);
359 if ($suggestion->{STATUS}) {
360 # fetch the entire updated suggestion so that we can populate the letter
361 my $full_suggestion = GetSuggestion($suggestion->{suggestionid});
362 my $letter = C4::Letters::getletter('suggestions', $full_suggestion->{STATUS});
363 if ($letter) {
364 C4::Letters::parseletter($letter, 'branches', $full_suggestion->{branchcode});
365 C4::Letters::parseletter($letter, 'borrowers', $full_suggestion->{suggestedby});
366 C4::Letters::parseletter($letter, 'suggestions', $full_suggestion->{suggestionid});
367 C4::Letters::parseletter($letter, 'biblio', $full_suggestion->{biblionumber});
368 my $enqueued = C4::Letters::EnqueueLetter({
369 letter => $letter,
370 borrowernumber => $full_suggestion->{suggestedby},
371 suggestionid => $full_suggestion->{suggestionid},
372 LibraryName => C4::Context->preference("LibraryName"),
373 message_transport_type => 'email',
375 if (!$enqueued){warn "can't enqueue letter $letter";}
378 return $status_update_table;
381 =head2 ConnectSuggestionAndBiblio
383 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
385 connect a suggestion to an existing biblio
387 =cut
389 sub ConnectSuggestionAndBiblio {
390 my ($suggestionid,$biblionumber) = @_;
391 my $dbh=C4::Context->dbh;
392 my $query = "
393 UPDATE suggestions
394 SET biblionumber=?
395 WHERE suggestionid=?
397 my $sth = $dbh->prepare($query);
398 $sth->execute($biblionumber,$suggestionid);
401 =head2 DelSuggestion
403 &DelSuggestion($borrowernumber,$ordernumber)
405 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
407 =cut
409 sub DelSuggestion {
410 my ($borrowernumber,$suggestionid,$type) = @_;
411 my $dbh = C4::Context->dbh;
412 # check that the suggestion comes from the suggestor
413 my $query = "
414 SELECT suggestedby
415 FROM suggestions
416 WHERE suggestionid=?
418 my $sth = $dbh->prepare($query);
419 $sth->execute($suggestionid);
420 my ($suggestedby) = $sth->fetchrow;
421 if ($type eq "intranet" || $suggestedby eq $borrowernumber ) {
422 my $queryDelete = "
423 DELETE FROM suggestions
424 WHERE suggestionid=?
426 $sth = $dbh->prepare($queryDelete);
427 my $suggestiondeleted=$sth->execute($suggestionid);
428 return $suggestiondeleted;
433 __END__
436 =head1 AUTHOR
438 Koha Development Team <http://koha-community.org/>
440 =cut