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 format_date_in_iso);
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);
35 our $VERSION = 3.07.00.049;
37 ConnectSuggestionAndBiblio
42 GetSuggestionFromBiblionumber
43 GetSuggestionInfoFromBiblionumber
49 DelSuggestionsOlderThan
54 C4::Suggestions - Some useful functions for dealings with aqorders.
62 The functions in this module deal with the aqorders in OPAC and in librarian interface
64 A suggestion is done in the OPAC. It has the status "ASKED"
66 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
68 When the book is ordered, the suggestion status becomes "ORDERED"
70 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
72 All aqorders of a borrower can be seen by the borrower itself.
73 Suggestions done by other borrowers can be seen when not "AVAILABLE"
77 =head2 SearchSuggestion
79 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
81 searches for a suggestion
84 C<\@array> : the aqorders found. Array of hash.
85 Note the status is stored twice :
87 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
91 sub SearchSuggestion {
93 my $dbh = C4::Context->dbh;
96 q{ SELECT suggestions.*,
97 U1.branchcode AS branchcodesuggestedby,
98 B1.branchname AS branchnamesuggestedby,
99 U1.surname AS surnamesuggestedby,
100 U1.firstname AS firstnamesuggestedby,
101 U1.email AS emailsuggestedby,
102 U1.borrowernumber AS borrnumsuggestedby,
103 U1.categorycode AS categorycodesuggestedby,
104 C1.description AS categorydescriptionsuggestedby,
105 U2.surname AS surnamemanagedby,
106 U2.firstname AS firstnamemanagedby,
107 B2.branchname AS branchnamesuggestedby,
108 U2.email AS emailmanagedby,
109 U2.branchcode AS branchcodemanagedby,
110 U2.borrowernumber AS borrnummanagedby
112 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
113 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
114 LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode
115 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
116 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
117 LEFT JOIN categories AS C2 ON C2.categorycode = U2.categorycode
120 if ( my $s = $suggestion->{$_} ) {
121 push @sql_params,'%'.$s.'%';
122 " and suggestions.$_ like ? ";
124 } qw( title author isbn publishercode collectiontitle )
127 my $userenv = C4::Context->userenv;
128 if (C4::Context->preference('IndependantBranches')) {
130 if (($userenv->{flags} % 2) != 1 && !$suggestion->{branchcode}){
131 push @sql_params,$$userenv{branch};
132 push @query,q{ and (suggestions.branchcode = ? or suggestions.branchcode ='')};
136 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
137 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
138 push @sql_params, $suggestion->{branchcode};
139 push @query, qq{ AND suggestions.branchcode=? };
144 foreach my $field (grep { my $fieldname=$_;
145 any {$fieldname eq $_ } qw<
146 STATUS itemtype suggestedby managedby acceptedby
147 bookfundid biblionumber
150 if ($$suggestion{$field}){
151 push @sql_params,$suggestion->{$field};
152 push @query, " and suggestions.$field=?";
155 push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)";
159 my $today = C4::Dates->today('iso');
161 foreach ( qw( suggesteddate manageddate accepteddate ) ) {
162 my $from = $_ . "_from";
164 if ($$suggestion{$from} || $$suggestion{$to}) {
165 push @query, " AND suggestions.suggesteddate BETWEEN '"
166 . (format_date_in_iso($$suggestion{$from}) || 0000-00-00) . "' AND '" . (format_date_in_iso($$suggestion{$to}) || $today) . "'";
170 $debug && warn "@query";
171 my $sth=$dbh->prepare("@query");
172 $sth->execute(@sql_params);
174 while ( my $data=$sth->fetchrow_hashref ){
175 $$data{$$data{STATUS}} = 1;
176 push(@results,$data);
183 \%sth = &GetSuggestion($ordernumber)
185 this function get the detail of the suggestion $ordernumber (input arg)
188 the result of the SQL query as a hash : $sth->fetchrow_hashref.
193 my ($ordernumber) = @_;
194 my $dbh = C4::Context->dbh;
200 my $sth = $dbh->prepare($query);
201 $sth->execute($ordernumber);
202 return($sth->fetchrow_hashref);
205 =head2 GetSuggestionFromBiblionumber
207 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
209 Get a suggestion from it's biblionumber.
212 the id of the suggestion which is related to the biblionumber given on input args.
216 sub GetSuggestionFromBiblionumber {
217 my ($biblionumber) = @_;
221 WHERE biblionumber=? LIMIT 1
223 my $dbh=C4::Context->dbh;
224 my $sth = $dbh->prepare($query);
225 $sth->execute($biblionumber);
226 my ($suggestionid) = $sth->fetchrow;
227 return $suggestionid;
230 =head2 GetSuggestionInfoFromBiblionumber
232 Get a suggestion and borrower's informations from it's biblionumber.
235 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
239 sub GetSuggestionInfoFromBiblionumber {
240 my ($biblionumber) = @_;
242 SELECT suggestions.*,
243 U1.surname AS surnamesuggestedby,
244 U1.firstname AS firstnamesuggestedby,
245 U1.borrowernumber AS borrnumsuggestedby
247 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
248 WHERE biblionumber = ? LIMIT 1
250 my $dbh = C4::Context->dbh;
251 my $sth = $dbh->prepare($query);
252 $sth->execute($biblionumber);
253 return $sth->fetchrow_hashref;
256 =head2 GetSuggestionInfo
258 Get a suggestion and borrower's informations from it's suggestionid
261 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
265 sub GetSuggestionInfo {
266 my ($suggestionid) = @_;
268 SELECT suggestions.*,
269 U1.surname AS surnamesuggestedby,
270 U1.firstname AS firstnamesuggestedby,
271 U1.borrowernumber AS borrnumsuggestedby
273 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
274 WHERE suggestionid = ? LIMIT 1
276 my $dbh = C4::Context->dbh;
277 my $sth = $dbh->prepare($query);
278 $sth->execute($suggestionid);
279 return $sth->fetchrow_hashref;
282 =head2 GetSuggestionByStatus
284 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
286 Get a suggestion from it's status
289 all the suggestion with C<$status>
293 sub GetSuggestionByStatus {
295 my $branchcode = shift;
296 my $dbh = C4::Context->dbh;
297 my @sql_params=($status);
298 my $query = qq(SELECT suggestions.*,
299 U1.surname AS surnamesuggestedby,
300 U1.firstname AS firstnamesuggestedby,
301 U1.branchcode AS branchcodesuggestedby,
302 B1.branchname AS branchnamesuggestedby,
303 U1.borrowernumber AS borrnumsuggestedby,
304 U1.categorycode AS categorycodesuggestedby,
305 C1.description AS categorydescriptionsuggestedby,
306 U2.surname AS surnamemanagedby,
307 U2.firstname AS firstnamemanagedby,
308 U2.borrowernumber AS borrnummanagedby
310 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
311 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
312 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
313 LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode
315 if (C4::Context->preference("IndependantBranches") || $branchcode) {
316 my $userenv = C4::Context->userenv;
318 unless ($userenv->{flags} % 2 == 1){
319 push @sql_params,$userenv->{branch};
320 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
324 push @sql_params,$branchcode;
325 $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
329 my $sth = $dbh->prepare($query);
330 $sth->execute(@sql_params);
333 $results= $sth->fetchall_arrayref({});
337 =head2 CountSuggestion
339 &CountSuggestion($status)
341 Count the number of aqorders with the status given on input argument.
342 the arg status can be :
346 =item * ASKED : asked by the user, not dealed by the librarian
348 =item * ACCEPTED : accepted by the librarian, but not yet ordered
350 =item * REJECTED : rejected by the librarian (definitive status)
352 =item * ORDERED : ordered by the librarian (acquisition module)
357 the number of suggestion with this status.
361 sub CountSuggestion {
363 my $dbh = C4::Context->dbh;
365 if (C4::Context->preference("IndependantBranches")){
366 my $userenv = C4::Context->userenv;
367 if ($userenv->{flags} % 2 == 1){
373 $sth = $dbh->prepare($query);
374 $sth->execute($status);
379 FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
381 AND (borrowers.branchcode='' OR borrowers.branchcode =?)
383 $sth = $dbh->prepare($query);
384 $sth->execute($status,$userenv->{branch});
393 $sth = $dbh->prepare($query);
394 $sth->execute($status);
396 my ($result) = $sth->fetchrow;
403 &NewSuggestion($suggestion);
405 Insert a new suggestion on database with value given on input arg.
410 my ($suggestion) = @_;
411 $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS};
412 return InsertInTable("suggestions",$suggestion);
417 &ModSuggestion($suggestion)
419 Modify the suggestion according to the hash passed by ref.
420 The hash HAS to contain suggestionid
421 Data not defined is not updated unless it is a note or sort1
422 Send a mail to notify the user that did the suggestion.
424 Note that there is no function to modify a suggestion.
430 my $status_update_table=UpdateInTable("suggestions", $suggestion);
432 if ($suggestion->{STATUS}) {
433 # fetch the entire updated suggestion so that we can populate the letter
434 my $full_suggestion = GetSuggestion($suggestion->{suggestionid});
435 if ( my $letter = C4::Letters::GetPreparedLetter (
436 module => 'suggestions',
437 letter_code => $full_suggestion->{STATUS},
438 branchcode => $full_suggestion->{branchcode},
440 'branches' => $full_suggestion->{branchcode},
441 'borrowers' => $full_suggestion->{suggestedby},
442 'suggestions' => $full_suggestion,
443 'biblio' => $full_suggestion->{biblionumber},
446 C4::Letters::EnqueueLetter({
448 borrowernumber => $full_suggestion->{suggestedby},
449 suggestionid => $full_suggestion->{suggestionid},
450 LibraryName => C4::Context->preference("LibraryName"),
451 message_transport_type => 'email',
452 }) or warn "can't enqueue letter $letter";
455 return $status_update_table;
458 =head2 ConnectSuggestionAndBiblio
460 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
462 connect a suggestion to an existing biblio
466 sub ConnectSuggestionAndBiblio {
467 my ($suggestionid,$biblionumber) = @_;
468 my $dbh=C4::Context->dbh;
474 my $sth = $dbh->prepare($query);
475 $sth->execute($biblionumber,$suggestionid);
480 &DelSuggestion($borrowernumber,$ordernumber)
482 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
487 my ($borrowernumber,$suggestionid,$type) = @_;
488 my $dbh = C4::Context->dbh;
489 # check that the suggestion comes from the suggestor
495 my $sth = $dbh->prepare($query);
496 $sth->execute($suggestionid);
497 my ($suggestedby) = $sth->fetchrow;
498 if ($type eq "intranet" || $suggestedby eq $borrowernumber ) {
500 DELETE FROM suggestions
503 $sth = $dbh->prepare($queryDelete);
504 my $suggestiondeleted=$sth->execute($suggestionid);
505 return $suggestiondeleted;
509 =head2 DelSuggestionsOlderThan
510 &DelSuggestionsOlderThan($days)
512 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
515 sub DelSuggestionsOlderThan {
518 my $dbh = C4::Context->dbh;
520 my $sth = $dbh->prepare("
521 DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?);
523 $sth->execute("-$days");
532 Koha Development Team <http://koha-community.org/>