Bug 5770: (QA follow-up) Adapt for replyto handling
[koha.git] / C4 / Suggestions.pm
blob39faddde3f9c35151f2c0863a232eae479a5fb49
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
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21 use strict;
23 #use warnings; FIXME - Bug 2505
24 use CGI qw ( -utf8 );
26 use C4::Context;
27 use C4::Output;
28 use C4::Debug;
29 use C4::Letters;
30 use Koha::DateUtils;
32 use List::MoreUtils qw(any);
33 use base qw(Exporter);
35 our @EXPORT = qw(
36 ConnectSuggestionAndBiblio
37 CountSuggestion
38 DelSuggestion
39 GetSuggestion
40 GetSuggestionByStatus
41 GetSuggestionFromBiblionumber
42 GetSuggestionInfoFromBiblionumber
43 GetSuggestionInfo
44 ModStatus
45 ModSuggestion
46 NewSuggestion
47 SearchSuggestion
48 DelSuggestionsOlderThan
49 GetUnprocessedSuggestions
52 =head1 NAME
54 C4::Suggestions - Some useful functions for dealings with aqorders.
56 =head1 SYNOPSIS
58 use C4::Suggestions;
60 =head1 DESCRIPTION
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, they 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"
75 =head1 FUNCTIONS
77 =head2 SearchSuggestion
79 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
81 searches for a suggestion
83 return :
84 C<\@array> : the aqorders found. Array of hash.
85 Note the status is stored twice :
86 * in the status field
87 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
89 =cut
91 sub SearchSuggestion {
92 my ($suggestion) = @_;
93 my $dbh = C4::Context->dbh;
94 my @sql_params;
95 my @query = (
97 SELECT suggestions.*,
98 U1.branchcode AS branchcodesuggestedby,
99 B1.branchname AS branchnamesuggestedby,
100 U1.surname AS surnamesuggestedby,
101 U1.firstname AS firstnamesuggestedby,
102 U1.cardnumber AS cardnumbersuggestedby,
103 U1.email AS emailsuggestedby,
104 U1.borrowernumber AS borrnumsuggestedby,
105 U1.categorycode AS categorycodesuggestedby,
106 C1.description AS categorydescriptionsuggestedby,
107 U2.surname AS surnamemanagedby,
108 U2.firstname AS firstnamemanagedby,
109 B2.branchname AS branchnamesuggestedby,
110 U2.email AS emailmanagedby,
111 U2.branchcode AS branchcodemanagedby,
112 U2.borrowernumber AS borrnummanagedby
113 FROM suggestions
114 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
115 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
116 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
117 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
118 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
119 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
120 WHERE 1=1
124 # filter on biblio informations
125 foreach my $field (
126 qw( title author isbn publishercode copyrightdate collectiontitle ))
128 if ( $suggestion->{$field} ) {
129 push @sql_params, '%' . $suggestion->{$field} . '%';
130 push @query, qq{ AND suggestions.$field LIKE ? };
134 # filter on user branch
135 if ( C4::Context->preference('IndependentBranches') ) {
136 my $userenv = C4::Context->userenv;
137 if ($userenv) {
138 if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
140 push @sql_params, $$userenv{branch};
141 push @query, q{
142 AND (suggestions.branchcode=? OR suggestions.branchcode='')
146 } else {
147 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
148 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
149 push @sql_params, $suggestion->{branchcode};
150 push @query, qq{ AND suggestions.branchcode=? };
155 # filter on nillable fields
156 foreach my $field (
157 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
160 if ( exists $suggestion->{$field}
161 and defined $suggestion->{$field}
162 and $suggestion->{$field} ne '__ANY__'
163 and (
164 $suggestion->{$field} ne q||
165 or $field eq 'STATUS'
168 if ( $suggestion->{$field} eq '__NONE__' ) {
169 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
171 else {
172 push @sql_params, $suggestion->{$field};
173 push @query, qq{ AND suggestions.$field = ? };
178 # filter on date fields
179 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
180 my $from = $field . "_from";
181 my $to = $field . "_to";
182 my $from_dt;
183 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
184 my $from_sql = '0000-00-00';
185 $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
186 if ($from_dt);
187 $debug && warn "SQL for start date ($field): $from_sql";
188 if ( $suggestion->{$from} || $suggestion->{$to} ) {
189 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
190 push @sql_params, $from_sql;
191 push @sql_params,
192 output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
196 $debug && warn "@query";
197 my $sth = $dbh->prepare("@query");
198 $sth->execute(@sql_params);
199 my @results;
201 # add status as field
202 while ( my $data = $sth->fetchrow_hashref ) {
203 $data->{ $data->{STATUS} } = 1;
204 push( @results, $data );
207 return ( \@results );
210 =head2 GetSuggestion
212 \%sth = &GetSuggestion($suggestionid)
214 this function get the detail of the suggestion $suggestionid (input arg)
216 return :
217 the result of the SQL query as a hash : $sth->fetchrow_hashref.
219 =cut
221 sub GetSuggestion {
222 my ($suggestionid) = @_;
223 my $dbh = C4::Context->dbh;
224 my $query = q{
225 SELECT *
226 FROM suggestions
227 WHERE suggestionid=?
229 my $sth = $dbh->prepare($query);
230 $sth->execute($suggestionid);
231 return ( $sth->fetchrow_hashref );
234 =head2 GetSuggestionFromBiblionumber
236 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
238 Get a suggestion from it's biblionumber.
240 return :
241 the id of the suggestion which is related to the biblionumber given on input args.
243 =cut
245 sub GetSuggestionFromBiblionumber {
246 my ($biblionumber) = @_;
247 my $query = q{
248 SELECT suggestionid
249 FROM suggestions
250 WHERE biblionumber=? LIMIT 1
252 my $dbh = C4::Context->dbh;
253 my $sth = $dbh->prepare($query);
254 $sth->execute($biblionumber);
255 my ($suggestionid) = $sth->fetchrow;
256 return $suggestionid;
259 =head2 GetSuggestionInfoFromBiblionumber
261 Get a suggestion and borrower's informations from it's biblionumber.
263 return :
264 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
266 =cut
268 sub GetSuggestionInfoFromBiblionumber {
269 my ($biblionumber) = @_;
270 my $query = q{
271 SELECT suggestions.*,
272 U1.surname AS surnamesuggestedby,
273 U1.firstname AS firstnamesuggestedby,
274 U1.borrowernumber AS borrnumsuggestedby
275 FROM suggestions
276 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
277 WHERE biblionumber=?
278 LIMIT 1
280 my $dbh = C4::Context->dbh;
281 my $sth = $dbh->prepare($query);
282 $sth->execute($biblionumber);
283 return $sth->fetchrow_hashref;
286 =head2 GetSuggestionInfo
288 Get a suggestion and borrower's informations from it's suggestionid
290 return :
291 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
293 =cut
295 sub GetSuggestionInfo {
296 my ($suggestionid) = @_;
297 my $query = q{
298 SELECT suggestions.*,
299 U1.surname AS surnamesuggestedby,
300 U1.firstname AS firstnamesuggestedby,
301 U1.borrowernumber AS borrnumsuggestedby
302 FROM suggestions
303 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
304 WHERE suggestionid=?
305 LIMIT 1
307 my $dbh = C4::Context->dbh;
308 my $sth = $dbh->prepare($query);
309 $sth->execute($suggestionid);
310 return $sth->fetchrow_hashref;
313 =head2 GetSuggestionByStatus
315 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
317 Get a suggestion from it's status
319 return :
320 all the suggestion with C<$status>
322 =cut
324 sub GetSuggestionByStatus {
325 my $status = shift;
326 my $branchcode = shift;
327 my $dbh = C4::Context->dbh;
328 my @sql_params = ($status);
329 my $query = q{
330 SELECT suggestions.*,
331 U1.surname AS surnamesuggestedby,
332 U1.firstname AS firstnamesuggestedby,
333 U1.branchcode AS branchcodesuggestedby,
334 B1.branchname AS branchnamesuggestedby,
335 U1.borrowernumber AS borrnumsuggestedby,
336 U1.categorycode AS categorycodesuggestedby,
337 C1.description AS categorydescriptionsuggestedby,
338 U2.surname AS surnamemanagedby,
339 U2.firstname AS firstnamemanagedby,
340 U2.borrowernumber AS borrnummanagedby
341 FROM suggestions
342 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
343 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
344 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
345 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
346 WHERE status = ?
349 # filter on branch
350 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
351 my $userenv = C4::Context->userenv;
352 if ($userenv) {
353 unless ( C4::Context->IsSuperLibrarian() ) {
354 push @sql_params, $userenv->{branch};
355 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
358 if ($branchcode) {
359 push @sql_params, $branchcode;
360 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
364 my $sth = $dbh->prepare($query);
365 $sth->execute(@sql_params);
366 my $results;
367 $results = $sth->fetchall_arrayref( {} );
368 return $results;
371 =head2 CountSuggestion
373 &CountSuggestion($status)
375 Count the number of aqorders with the status given on input argument.
376 the arg status can be :
378 =over 2
380 =item * ASKED : asked by the user, not dealed by the librarian
382 =item * ACCEPTED : accepted by the librarian, but not yet ordered
384 =item * REJECTED : rejected by the librarian (definitive status)
386 =item * ORDERED : ordered by the librarian (acquisition module)
388 =back
390 return :
391 the number of suggestion with this status.
393 =cut
395 sub CountSuggestion {
396 my ($status) = @_;
397 my $dbh = C4::Context->dbh;
398 my $sth;
399 my $userenv = C4::Context->userenv;
400 if ( C4::Context->preference("IndependentBranches")
401 && !C4::Context->IsSuperLibrarian() )
403 my $query = q{
404 SELECT count(*)
405 FROM suggestions
406 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
407 WHERE STATUS=?
408 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
410 $sth = $dbh->prepare($query);
411 $sth->execute( $status, $userenv->{branch} );
413 else {
414 my $query = q{
415 SELECT count(*)
416 FROM suggestions
417 WHERE STATUS=?
419 $sth = $dbh->prepare($query);
420 $sth->execute($status);
422 my ($result) = $sth->fetchrow;
423 return $result;
426 =head2 NewSuggestion
429 &NewSuggestion($suggestion);
431 Insert a new suggestion on database with value given on input arg.
433 =cut
435 sub NewSuggestion {
436 my ($suggestion) = @_;
438 for my $field ( qw(
439 suggestedby
440 managedby
441 manageddate
442 acceptedby
443 accepteddate
444 rejectedby
445 rejecteddate
446 budgetid
447 ) ) {
448 # Set the fields to NULL if not given.
449 $suggestion->{$field} ||= undef;
452 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
454 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
456 my $rs = Koha::Database->new->schema->resultset('Suggestion');
457 my $new_id = $rs->create($suggestion)->id;
459 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
460 if ($emailpurchasesuggestions) {
461 my $full_suggestion = GetSuggestion( $new_id );
462 if (
463 my $letter = C4::Letters::GetPreparedLetter(
464 module => 'suggestions',
465 letter_code => 'NEW_SUGGESTION',
466 tables => {
467 'branches' => $full_suggestion->{branchcode},
468 'borrowers' => $full_suggestion->{suggestedby},
469 'suggestions' => $full_suggestion,
474 my $toaddress;
475 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
476 my $library =
477 Koha::Libraries->find( $full_suggestion->{branchcode} );
478 $toaddress =
479 $library->branchreplyto
480 || $library->branchemail
481 || C4::Context->preference('ReplytoDefault')
482 || C4::Context->preference('KohaAdminEmailAddress');
484 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
485 $toaddress = C4::Context->preference('ReplytoDefault')
486 || C4::Context->preference('KohaAdminEmailAddress');
488 else {
489 $toaddress =
490 C4::Context->preference($emailpurchasesuggestions)
491 || C4::Context->preference('ReplytoDefault')
492 || C4::Context->preference('KohaAdminEmailAddress');
495 C4::Letters::EnqueueLetter(
497 letter => $letter,
498 borrowernumber => $full_suggestion->{suggestedby},
499 suggestionid => $full_suggestion->{suggestionid},
500 to_address => $toaddress,
501 message_transport_type => 'email',
503 ) or warn "can't enqueue letter $letter";
507 return $new_id;
510 =head2 ModSuggestion
512 &ModSuggestion($suggestion)
514 Modify the suggestion according to the hash passed by ref.
515 The hash HAS to contain suggestionid
516 Data not defined is not updated unless it is a note or sort1
517 Send a mail to notify the user that did the suggestion.
519 Note that there is no function to modify a suggestion.
521 =cut
523 sub ModSuggestion {
524 my ($suggestion) = @_;
525 return unless( $suggestion and defined($suggestion->{suggestionid}) );
527 for my $field ( qw(
528 suggestedby
529 managedby
530 manageddate
531 acceptedby
532 accepteddate
533 rejectedby
534 rejecteddate
535 budgetid
536 ) ) {
537 # Set the fields to NULL if not given.
538 $suggestion->{$field} = undef
539 if exists $suggestion->{$field}
540 and ($suggestion->{$field} eq '0'
541 or $suggestion->{$field} eq '' );
544 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
545 my $status_update_table = 1;
546 eval {
547 $rs->update($suggestion);
549 $status_update_table = 0 if( $@ );
551 if ( $suggestion->{STATUS} ) {
553 # fetch the entire updated suggestion so that we can populate the letter
554 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
555 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
557 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
559 if (
560 my $letter = C4::Letters::GetPreparedLetter(
561 module => 'suggestions',
562 letter_code => $full_suggestion->{STATUS},
563 branchcode => $full_suggestion->{branchcode},
564 lang => $patron->lang,
565 tables => {
566 'branches' => $full_suggestion->{branchcode},
567 'borrowers' => $full_suggestion->{suggestedby},
568 'suggestions' => $full_suggestion,
569 'biblio' => $full_suggestion->{biblionumber},
574 C4::Letters::EnqueueLetter(
576 letter => $letter,
577 borrowernumber => $full_suggestion->{suggestedby},
578 suggestionid => $full_suggestion->{suggestionid},
579 LibraryName => C4::Context->preference("LibraryName"),
580 message_transport_type => $transport,
582 ) or warn "can't enqueue letter $letter";
585 return $status_update_table;
588 =head2 ConnectSuggestionAndBiblio
590 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
592 connect a suggestion to an existing biblio
594 =cut
596 sub ConnectSuggestionAndBiblio {
597 my ( $suggestionid, $biblionumber ) = @_;
598 my $dbh = C4::Context->dbh;
599 my $query = q{
600 UPDATE suggestions
601 SET biblionumber=?
602 WHERE suggestionid=?
604 my $sth = $dbh->prepare($query);
605 $sth->execute( $biblionumber, $suggestionid );
608 =head2 DelSuggestion
610 &DelSuggestion($borrowernumber,$ordernumber)
612 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
614 =cut
616 sub DelSuggestion {
617 my ( $borrowernumber, $suggestionid, $type ) = @_;
618 my $dbh = C4::Context->dbh;
620 # check that the suggestion comes from the suggestor
621 my $query = q{
622 SELECT suggestedby
623 FROM suggestions
624 WHERE suggestionid=?
626 my $sth = $dbh->prepare($query);
627 $sth->execute($suggestionid);
628 my ($suggestedby) = $sth->fetchrow;
629 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
630 my $queryDelete = q{
631 DELETE FROM suggestions
632 WHERE suggestionid=?
634 $sth = $dbh->prepare($queryDelete);
635 my $suggestiondeleted = $sth->execute($suggestionid);
636 return $suggestiondeleted;
640 =head2 DelSuggestionsOlderThan
641 &DelSuggestionsOlderThan($days)
643 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
644 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
646 =cut
648 sub DelSuggestionsOlderThan {
649 my ($days) = @_;
650 return unless $days && $days > 0;
651 my $dbh = C4::Context->dbh;
652 my $sth = $dbh->prepare(
654 DELETE FROM suggestions
655 WHERE STATUS<>'ASKED'
656 AND date < ADDDATE(NOW(), ?)
659 $sth->execute("-$days");
662 sub GetUnprocessedSuggestions {
663 my ( $number_of_days_since_the_last_modification ) = @_;
665 $number_of_days_since_the_last_modification ||= 0;
667 my $dbh = C4::Context->dbh;
669 my $s = $dbh->selectall_arrayref(q|
670 SELECT *
671 FROM suggestions
672 WHERE STATUS = 'ASKED'
673 AND budgetid IS NOT NULL
674 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
675 |, { Slice => {} }, $number_of_days_since_the_last_modification );
676 return $s;
680 __END__
683 =head1 AUTHOR
685 Koha Development Team <http://koha-community.org/>
687 =cut