Bug 22705: Change default value of cxn_pool to 'Static'
[koha.git] / C4 / Suggestions.pm
blob71b90005747d8324361dcb9d22e4169b6d29ff20
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 BU.budget_name AS budget_name
114 FROM suggestions
115 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
116 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
117 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
118 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
119 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
120 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
121 LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
122 WHERE 1=1
126 # filter on biblio informations
127 foreach my $field (
128 qw( title author isbn publishercode copyrightdate collectiontitle ))
130 if ( $suggestion->{$field} ) {
131 push @sql_params, '%' . $suggestion->{$field} . '%';
132 push @query, qq{ AND suggestions.$field LIKE ? };
136 # filter on user branch
137 if ( C4::Context->preference('IndependentBranches') ) {
138 my $userenv = C4::Context->userenv;
139 if ($userenv) {
140 if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
142 push @sql_params, $$userenv{branch};
143 push @query, q{
144 AND (suggestions.branchcode=? OR suggestions.branchcode='')
148 } else {
149 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
150 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
151 push @sql_params, $suggestion->{branchcode};
152 push @query, qq{ AND suggestions.branchcode=? };
157 # filter on nillable fields
158 foreach my $field (
159 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
162 if ( exists $suggestion->{$field}
163 and defined $suggestion->{$field}
164 and $suggestion->{$field} ne '__ANY__'
165 and (
166 $suggestion->{$field} ne q||
167 or $field eq 'STATUS'
170 if ( $suggestion->{$field} eq '__NONE__' ) {
171 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
173 else {
174 push @sql_params, $suggestion->{$field};
175 push @query, qq{ AND suggestions.$field = ? };
180 # filter on date fields
181 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
182 my $from = $field . "_from";
183 my $to = $field . "_to";
184 my $from_dt;
185 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
186 my $from_sql = '0000-00-00';
187 $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
188 if ($from_dt);
189 $debug && warn "SQL for start date ($field): $from_sql";
190 if ( $suggestion->{$from} || $suggestion->{$to} ) {
191 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
192 push @sql_params, $from_sql;
193 push @sql_params,
194 output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
198 $debug && warn "@query";
199 my $sth = $dbh->prepare("@query");
200 $sth->execute(@sql_params);
201 my @results;
203 # add status as field
204 while ( my $data = $sth->fetchrow_hashref ) {
205 $data->{ $data->{STATUS} } = 1;
206 push( @results, $data );
209 return ( \@results );
212 =head2 GetSuggestion
214 \%sth = &GetSuggestion($suggestionid)
216 this function get the detail of the suggestion $suggestionid (input arg)
218 return :
219 the result of the SQL query as a hash : $sth->fetchrow_hashref.
221 =cut
223 sub GetSuggestion {
224 my ($suggestionid) = @_;
225 my $dbh = C4::Context->dbh;
226 my $query = q{
227 SELECT *
228 FROM suggestions
229 WHERE suggestionid=?
231 my $sth = $dbh->prepare($query);
232 $sth->execute($suggestionid);
233 return ( $sth->fetchrow_hashref );
236 =head2 GetSuggestionFromBiblionumber
238 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
240 Get a suggestion from it's biblionumber.
242 return :
243 the id of the suggestion which is related to the biblionumber given on input args.
245 =cut
247 sub GetSuggestionFromBiblionumber {
248 my ($biblionumber) = @_;
249 my $query = q{
250 SELECT suggestionid
251 FROM suggestions
252 WHERE biblionumber=? LIMIT 1
254 my $dbh = C4::Context->dbh;
255 my $sth = $dbh->prepare($query);
256 $sth->execute($biblionumber);
257 my ($suggestionid) = $sth->fetchrow;
258 return $suggestionid;
261 =head2 GetSuggestionInfoFromBiblionumber
263 Get a suggestion and borrower's informations from it's biblionumber.
265 return :
266 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
268 =cut
270 sub GetSuggestionInfoFromBiblionumber {
271 my ($biblionumber) = @_;
272 my $query = q{
273 SELECT suggestions.*,
274 U1.surname AS surnamesuggestedby,
275 U1.firstname AS firstnamesuggestedby,
276 U1.borrowernumber AS borrnumsuggestedby
277 FROM suggestions
278 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
279 WHERE biblionumber=?
280 LIMIT 1
282 my $dbh = C4::Context->dbh;
283 my $sth = $dbh->prepare($query);
284 $sth->execute($biblionumber);
285 return $sth->fetchrow_hashref;
288 =head2 GetSuggestionInfo
290 Get a suggestion and borrower's informations from it's suggestionid
292 return :
293 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
295 =cut
297 sub GetSuggestionInfo {
298 my ($suggestionid) = @_;
299 my $query = q{
300 SELECT suggestions.*,
301 U1.surname AS surnamesuggestedby,
302 U1.firstname AS firstnamesuggestedby,
303 U1.borrowernumber AS borrnumsuggestedby
304 FROM suggestions
305 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
306 WHERE suggestionid=?
307 LIMIT 1
309 my $dbh = C4::Context->dbh;
310 my $sth = $dbh->prepare($query);
311 $sth->execute($suggestionid);
312 return $sth->fetchrow_hashref;
315 =head2 GetSuggestionByStatus
317 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
319 Get a suggestion from it's status
321 return :
322 all the suggestion with C<$status>
324 =cut
326 sub GetSuggestionByStatus {
327 my $status = shift;
328 my $branchcode = shift;
329 my $dbh = C4::Context->dbh;
330 my @sql_params = ($status);
331 my $query = q{
332 SELECT suggestions.*,
333 U1.surname AS surnamesuggestedby,
334 U1.firstname AS firstnamesuggestedby,
335 U1.branchcode AS branchcodesuggestedby,
336 B1.branchname AS branchnamesuggestedby,
337 U1.borrowernumber AS borrnumsuggestedby,
338 U1.categorycode AS categorycodesuggestedby,
339 C1.description AS categorydescriptionsuggestedby,
340 U2.surname AS surnamemanagedby,
341 U2.firstname AS firstnamemanagedby,
342 U2.borrowernumber AS borrnummanagedby
343 FROM suggestions
344 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
345 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
346 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
347 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
348 WHERE status = ?
351 # filter on branch
352 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
353 my $userenv = C4::Context->userenv;
354 if ($userenv) {
355 unless ( C4::Context->IsSuperLibrarian() ) {
356 push @sql_params, $userenv->{branch};
357 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
360 if ($branchcode) {
361 push @sql_params, $branchcode;
362 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
366 my $sth = $dbh->prepare($query);
367 $sth->execute(@sql_params);
368 my $results;
369 $results = $sth->fetchall_arrayref( {} );
370 return $results;
373 =head2 CountSuggestion
375 &CountSuggestion($status)
377 Count the number of aqorders with the status given on input argument.
378 the arg status can be :
380 =over 2
382 =item * ASKED : asked by the user, not dealed by the librarian
384 =item * ACCEPTED : accepted by the librarian, but not yet ordered
386 =item * REJECTED : rejected by the librarian (definitive status)
388 =item * ORDERED : ordered by the librarian (acquisition module)
390 =back
392 return :
393 the number of suggestion with this status.
395 =cut
397 sub CountSuggestion {
398 my ($status) = @_;
399 my $dbh = C4::Context->dbh;
400 my $sth;
401 my $userenv = C4::Context->userenv;
402 if ( C4::Context->preference("IndependentBranches")
403 && !C4::Context->IsSuperLibrarian() )
405 my $query = q{
406 SELECT count(*)
407 FROM suggestions
408 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
409 WHERE STATUS=?
410 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
412 $sth = $dbh->prepare($query);
413 $sth->execute( $status, $userenv->{branch} );
415 else {
416 my $query = q{
417 SELECT count(*)
418 FROM suggestions
419 WHERE STATUS=?
421 $sth = $dbh->prepare($query);
422 $sth->execute($status);
424 my ($result) = $sth->fetchrow;
425 return $result;
428 =head2 NewSuggestion
431 &NewSuggestion($suggestion);
433 Insert a new suggestion on database with value given on input arg.
435 =cut
437 sub NewSuggestion {
438 my ($suggestion) = @_;
440 for my $field ( qw(
441 suggestedby
442 managedby
443 manageddate
444 acceptedby
445 accepteddate
446 rejectedby
447 rejecteddate
448 budgetid
449 ) ) {
450 # Set the fields to NULL if not given.
451 $suggestion->{$field} ||= undef;
454 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
456 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
458 my $rs = Koha::Database->new->schema->resultset('Suggestion');
459 my $new_id = $rs->create($suggestion)->id;
461 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
462 if ($emailpurchasesuggestions) {
463 my $full_suggestion = GetSuggestion( $new_id );
464 if (
465 my $letter = C4::Letters::GetPreparedLetter(
466 module => 'suggestions',
467 letter_code => 'NEW_SUGGESTION',
468 tables => {
469 'branches' => $full_suggestion->{branchcode},
470 'borrowers' => $full_suggestion->{suggestedby},
471 'suggestions' => $full_suggestion,
476 my $toaddress;
477 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
478 my $library =
479 Koha::Libraries->find( $full_suggestion->{branchcode} );
480 $toaddress =
481 $library->branchreplyto
482 || $library->branchemail
483 || C4::Context->preference('ReplytoDefault')
484 || C4::Context->preference('KohaAdminEmailAddress');
486 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
487 $toaddress = C4::Context->preference('ReplytoDefault')
488 || C4::Context->preference('KohaAdminEmailAddress');
490 else {
491 $toaddress =
492 C4::Context->preference($emailpurchasesuggestions)
493 || C4::Context->preference('ReplytoDefault')
494 || C4::Context->preference('KohaAdminEmailAddress');
497 C4::Letters::EnqueueLetter(
499 letter => $letter,
500 borrowernumber => $full_suggestion->{suggestedby},
501 suggestionid => $full_suggestion->{suggestionid},
502 to_address => $toaddress,
503 message_transport_type => 'email',
505 ) or warn "can't enqueue letter $letter";
509 return $new_id;
512 =head2 ModSuggestion
514 &ModSuggestion($suggestion)
516 Modify the suggestion according to the hash passed by ref.
517 The hash HAS to contain suggestionid
518 Data not defined is not updated unless it is a note or sort1
519 Send a mail to notify the user that did the suggestion.
521 Note that there is no function to modify a suggestion.
523 =cut
525 sub ModSuggestion {
526 my ($suggestion) = @_;
527 return unless( $suggestion and defined($suggestion->{suggestionid}) );
529 for my $field ( qw(
530 suggestedby
531 managedby
532 manageddate
533 acceptedby
534 accepteddate
535 rejectedby
536 rejecteddate
537 budgetid
538 ) ) {
539 # Set the fields to NULL if not given.
540 $suggestion->{$field} = undef
541 if exists $suggestion->{$field}
542 and ($suggestion->{$field} eq '0'
543 or $suggestion->{$field} eq '' );
546 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
547 my $status_update_table = 1;
548 eval {
549 $rs->update($suggestion);
551 $status_update_table = 0 if( $@ );
553 if ( $suggestion->{STATUS} ) {
555 # fetch the entire updated suggestion so that we can populate the letter
556 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
557 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
559 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
561 if (
562 my $letter = C4::Letters::GetPreparedLetter(
563 module => 'suggestions',
564 letter_code => $full_suggestion->{STATUS},
565 branchcode => $full_suggestion->{branchcode},
566 lang => $patron->lang,
567 tables => {
568 'branches' => $full_suggestion->{branchcode},
569 'borrowers' => $full_suggestion->{suggestedby},
570 'suggestions' => $full_suggestion,
571 'biblio' => $full_suggestion->{biblionumber},
576 C4::Letters::EnqueueLetter(
578 letter => $letter,
579 borrowernumber => $full_suggestion->{suggestedby},
580 suggestionid => $full_suggestion->{suggestionid},
581 LibraryName => C4::Context->preference("LibraryName"),
582 message_transport_type => $transport,
584 ) or warn "can't enqueue letter $letter";
587 return $status_update_table;
590 =head2 ConnectSuggestionAndBiblio
592 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
594 connect a suggestion to an existing biblio
596 =cut
598 sub ConnectSuggestionAndBiblio {
599 my ( $suggestionid, $biblionumber ) = @_;
600 my $dbh = C4::Context->dbh;
601 my $query = q{
602 UPDATE suggestions
603 SET biblionumber=?
604 WHERE suggestionid=?
606 my $sth = $dbh->prepare($query);
607 $sth->execute( $biblionumber, $suggestionid );
610 =head2 DelSuggestion
612 &DelSuggestion($borrowernumber,$ordernumber)
614 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
616 =cut
618 sub DelSuggestion {
619 my ( $borrowernumber, $suggestionid, $type ) = @_;
620 my $dbh = C4::Context->dbh;
622 # check that the suggestion comes from the suggestor
623 my $query = q{
624 SELECT suggestedby
625 FROM suggestions
626 WHERE suggestionid=?
628 my $sth = $dbh->prepare($query);
629 $sth->execute($suggestionid);
630 my ($suggestedby) = $sth->fetchrow;
631 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
632 my $queryDelete = q{
633 DELETE FROM suggestions
634 WHERE suggestionid=?
636 $sth = $dbh->prepare($queryDelete);
637 my $suggestiondeleted = $sth->execute($suggestionid);
638 return $suggestiondeleted;
642 =head2 DelSuggestionsOlderThan
643 &DelSuggestionsOlderThan($days)
645 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
646 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
648 =cut
650 sub DelSuggestionsOlderThan {
651 my ($days) = @_;
652 return unless $days && $days > 0;
653 my $dbh = C4::Context->dbh;
654 my $sth = $dbh->prepare(
656 DELETE FROM suggestions
657 WHERE STATUS<>'ASKED'
658 AND date < ADDDATE(NOW(), ?)
661 $sth->execute("-$days");
664 sub GetUnprocessedSuggestions {
665 my ( $number_of_days_since_the_last_modification ) = @_;
667 $number_of_days_since_the_last_modification ||= 0;
669 my $dbh = C4::Context->dbh;
671 my $s = $dbh->selectall_arrayref(q|
672 SELECT *
673 FROM suggestions
674 WHERE STATUS = 'ASKED'
675 AND budgetid IS NOT NULL
676 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
677 |, { Slice => {} }, $number_of_days_since_the_last_modification );
678 return $s;
682 __END__
685 =head1 AUTHOR
687 Koha Development Team <http://koha-community.org/>
689 =cut