1 package C4::Suggestions;
3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright Biblibre 2011
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 #use warnings; FIXME - Bug 2505
28 use C4::Dates qw(format_date);
29 use C4::SQLHelper qw(:all);
32 use List::MoreUtils qw<any>;
33 use C4::Dates qw(format_date_in_iso);
34 use base qw(Exporter);
37 ConnectSuggestionAndBiblio
42 GetSuggestionFromBiblionumber
47 DelSuggestionsOlderThan
52 C4::Suggestions - Some useful functions for dealings with aqorders.
60 The functions in this module deal with the aqorders in OPAC and in librarian interface
62 A suggestion is done in the OPAC. It has the status "ASKED"
64 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
66 When the book is ordered, the suggestion status becomes "ORDERED"
68 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
70 All aqorders of a borrower can be seen by the borrower itself.
71 Suggestions done by other borrowers can be seen when not "AVAILABLE"
75 =head2 SearchSuggestion
77 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
79 searches for a suggestion
82 C<\@array> : the aqorders found. Array of hash.
83 Note the status is stored twice :
85 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
89 sub SearchSuggestion {
91 my $dbh = C4::Context->dbh;
94 q{ SELECT suggestions.*,
95 U1.branchcode AS branchcodesuggestedby,
96 B1.branchname AS branchnamesuggestedby,
97 U1.surname AS surnamesuggestedby,
98 U1.firstname AS firstnamesuggestedby,
99 U1.email AS emailsuggestedby,
100 U1.borrowernumber AS borrnumsuggestedby,
101 U1.categorycode AS categorycodesuggestedby,
102 C1.description AS categorydescriptionsuggestedby,
103 U2.surname AS surnamemanagedby,
104 U2.firstname AS firstnamemanagedby,
105 B2.branchname AS branchnamesuggestedby,
106 U2.email AS emailmanagedby,
107 U2.branchcode AS branchcodemanagedby,
108 U2.borrowernumber AS borrnummanagedby
110 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
111 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
112 LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode
113 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
114 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
115 LEFT JOIN categories AS C2 ON C2.categorycode = U2.categorycode
116 WHERE STATUS NOT IN ('CLAIMED')
118 if ( my $s = $suggestion->{$_} ) {
119 push @sql_params,'%'.$s.'%';
120 " and suggestions.$_ like ? ";
122 } qw( title author isbn publishercode collectiontitle )
125 my $userenv = C4::Context->userenv;
126 if (C4::Context->preference('IndependantBranches')) {
128 if (($userenv->{flags} % 2) != 1 && !$suggestion->{branchcode}){
129 push @sql_params,$$userenv{branch};
130 push @query,q{ and (branchcode = ? or branchcode ='')};
135 foreach my $field (grep { my $fieldname=$_;
136 any {$fieldname eq $_ } qw<
137 STATUS branchcode itemtype suggestedby managedby acceptedby
138 bookfundid biblionumber
141 if ($$suggestion{$field}){
142 push @sql_params,$suggestion->{$field};
143 push @query, " and suggestions.$field=?";
146 push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)";
150 $debug && warn "@query";
151 my $sth=$dbh->prepare("@query");
152 $sth->execute(@sql_params);
154 while ( my $data=$sth->fetchrow_hashref ){
155 $$data{$$data{STATUS}} = 1;
156 push(@results,$data);
163 \%sth = &GetSuggestion($ordernumber)
165 this function get the detail of the suggestion $ordernumber (input arg)
168 the result of the SQL query as a hash : $sth->fetchrow_hashref.
173 my ($ordernumber) = @_;
174 my $dbh = C4::Context->dbh;
180 my $sth = $dbh->prepare($query);
181 $sth->execute($ordernumber);
182 return($sth->fetchrow_hashref);
185 =head2 GetSuggestionFromBiblionumber
187 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
189 Get a suggestion from it's biblionumber.
192 the id of the suggestion which is related to the biblionumber given on input args.
196 sub GetSuggestionFromBiblionumber {
197 my ($biblionumber) = @_;
203 my $dbh=C4::Context->dbh;
204 my $sth = $dbh->prepare($query);
205 $sth->execute($biblionumber);
206 my ($ordernumber) = $sth->fetchrow;
210 =head2 GetSuggestionByStatus
212 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
214 Get a suggestion from it's status
217 all the suggestion with C<$status>
221 sub GetSuggestionByStatus {
223 my $branchcode = shift;
224 my $dbh = C4::Context->dbh;
225 my @sql_params=($status);
226 my $query = qq(SELECT suggestions.*,
227 U1.surname AS surnamesuggestedby,
228 U1.firstname AS firstnamesuggestedby,
229 U1.branchcode AS branchcodesuggestedby,
230 B1.branchname AS branchnamesuggestedby,
231 U1.borrowernumber AS borrnumsuggestedby,
232 U1.categorycode AS categorycodesuggestedby,
233 C1.description AS categorydescriptionsuggestedby,
234 U2.surname AS surnamemanagedby,
235 U2.firstname AS firstnamemanagedby,
236 U2.borrowernumber AS borrnummanagedby
238 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
239 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
240 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
241 LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode
243 if (C4::Context->preference("IndependantBranches") || $branchcode) {
244 my $userenv = C4::Context->userenv;
246 unless ($userenv->{flags} % 2 == 1){
247 push @sql_params,$userenv->{branch};
248 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
252 push @sql_params,$branchcode;
253 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
257 my $sth = $dbh->prepare($query);
258 $sth->execute(@sql_params);
261 $results= $sth->fetchall_arrayref({});
265 =head2 CountSuggestion
267 &CountSuggestion($status)
269 Count the number of aqorders with the status given on input argument.
270 the arg status can be :
274 =item * ASKED : asked by the user, not dealed by the librarian
276 =item * ACCEPTED : accepted by the librarian, but not yet ordered
278 =item * REJECTED : rejected by the librarian (definitive status)
280 =item * ORDERED : ordered by the librarian (acquisition module)
285 the number of suggestion with this status.
289 sub CountSuggestion {
291 my $dbh = C4::Context->dbh;
293 if (C4::Context->preference("IndependantBranches")){
294 my $userenv = C4::Context->userenv;
295 if ($userenv->{flags} % 2 == 1){
301 $sth = $dbh->prepare($query);
302 $sth->execute($status);
307 FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
309 AND (borrowers.branchcode='' OR borrowers.branchcode =?)
311 $sth = $dbh->prepare($query);
312 $sth->execute($status,$userenv->{branch});
321 $sth = $dbh->prepare($query);
322 $sth->execute($status);
324 my ($result) = $sth->fetchrow;
331 &NewSuggestion($suggestion);
333 Insert a new suggestion on database with value given on input arg.
338 my ($suggestion) = @_;
339 $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS};
340 return InsertInTable("suggestions",$suggestion);
345 &ModSuggestion($suggestion)
347 Modify the suggestion according to the hash passed by ref.
348 The hash HAS to contain suggestionid
349 Data not defined is not updated unless it is a note or sort1
350 Send a mail to notify the user that did the suggestion.
352 Note that there is no function to modify a suggestion.
358 my $status_update_table=UpdateInTable("suggestions", $suggestion);
360 if ($suggestion->{STATUS}) {
361 # fetch the entire updated suggestion so that we can populate the letter
362 my $full_suggestion = GetSuggestion($suggestion->{suggestionid});
363 my $letter = C4::Letters::getletter('suggestions', $full_suggestion->{STATUS});
365 C4::Letters::parseletter($letter, 'branches', $full_suggestion->{branchcode});
366 C4::Letters::parseletter($letter, 'borrowers', $full_suggestion->{suggestedby});
367 C4::Letters::parseletter($letter, 'suggestions', $full_suggestion->{suggestionid});
368 C4::Letters::parseletter($letter, 'biblio', $full_suggestion->{biblionumber});
369 my $enqueued = C4::Letters::EnqueueLetter({
371 borrowernumber => $full_suggestion->{suggestedby},
372 suggestionid => $full_suggestion->{suggestionid},
373 LibraryName => C4::Context->preference("LibraryName"),
374 message_transport_type => 'email',
376 if (!$enqueued){warn "can't enqueue letter $letter";}
379 return $status_update_table;
382 =head2 ConnectSuggestionAndBiblio
384 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
386 connect a suggestion to an existing biblio
390 sub ConnectSuggestionAndBiblio {
391 my ($suggestionid,$biblionumber) = @_;
392 my $dbh=C4::Context->dbh;
398 my $sth = $dbh->prepare($query);
399 $sth->execute($biblionumber,$suggestionid);
404 &DelSuggestion($borrowernumber,$ordernumber)
406 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
411 my ($borrowernumber,$suggestionid,$type) = @_;
412 my $dbh = C4::Context->dbh;
413 # check that the suggestion comes from the suggestor
419 my $sth = $dbh->prepare($query);
420 $sth->execute($suggestionid);
421 my ($suggestedby) = $sth->fetchrow;
422 if ($type eq "intranet" || $suggestedby eq $borrowernumber ) {
424 DELETE FROM suggestions
427 $sth = $dbh->prepare($queryDelete);
428 my $suggestiondeleted=$sth->execute($suggestionid);
429 return $suggestiondeleted;
433 =head2 DelSuggestionsOlderThan
434 &DelSuggestionsOlderThan($days)
436 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
439 sub DelSuggestionsOlderThan {
442 my $dbh = C4::Context->dbh;
444 my $sth = $dbh->prepare("
445 DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?);
447 $sth->execute("-$days");
456 Koha Development Team <http://koha-community.org/>