Bug 22907: Remove previous code handling the same thing
[koha-ffzg.git] / C4 / Suggestions.pm
1 package C4::Suggestions;
2
3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright Biblibre 2011
5 #
6 # This file is part of Koha.
7 #
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.
12 #
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.
17 #
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>.
20
21 use strict;
22
23 #use warnings; FIXME - Bug 2505
24 use CGI qw ( -utf8 );
25
26 use C4::Context;
27 use C4::Output;
28 use C4::Debug;
29 use C4::Letters;
30 use Koha::DateUtils;
31
32 use List::MoreUtils qw(any);
33 use base qw(Exporter);
34
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
50 );
51
52 =head1 NAME
53
54 C4::Suggestions - Some useful functions for dealings with aqorders.
55
56 =head1 SYNOPSIS
57
58 use C4::Suggestions;
59
60 =head1 DESCRIPTION
61
62 The functions in this module deal with the aqorders in OPAC and in librarian interface
63
64 A suggestion is done in the OPAC. It has the status "ASKED"
65
66 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
67
68 When the book is ordered, the suggestion status becomes "ORDERED"
69
70 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
71
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"
74
75 =head1 FUNCTIONS
76
77 =head2 SearchSuggestion
78
79 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
80
81 searches for a suggestion
82
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.
88
89 =cut
90
91 sub SearchSuggestion {
92     my ($suggestion) = @_;
93     my $dbh = C4::Context->dbh;
94     my @sql_params;
95     my @query = (
96         q{
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
123     }
124     );
125
126     # filter on biblio informations
127     foreach my $field (
128         qw( title author isbn publishercode copyrightdate collectiontitle ))
129     {
130         if ( $suggestion->{$field} ) {
131             push @sql_params, '%' . $suggestion->{$field} . '%';
132             push @query,      qq{ AND suggestions.$field LIKE ? };
133         }
134     }
135
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} )
141             {
142                 push @sql_params, $$userenv{branch};
143                 push @query,      q{
144                     AND (suggestions.branchcode=? OR suggestions.branchcode='')
145                 };
146             }
147         }
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=? };
153             }
154         }
155     }
156
157     # filter on nillable fields
158     foreach my $field (
159         qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
160       )
161     {
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'
168                 )
169         ) {
170             if ( $suggestion->{$field} eq '__NONE__' ) {
171                 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
172             }
173             else {
174                 push @sql_params, $suggestion->{$field};
175                 push @query, qq{ AND suggestions.$field = ? };
176             }
177         }
178     }
179
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 });
195         }
196     }
197
198     $debug && warn "@query";
199     my $sth = $dbh->prepare("@query");
200     $sth->execute(@sql_params);
201     my @results;
202
203     # add status as field
204     while ( my $data = $sth->fetchrow_hashref ) {
205         $data->{ $data->{STATUS} } = 1;
206         push( @results, $data );
207     }
208
209     return ( \@results );
210 }
211
212 =head2 GetSuggestion
213
214 \%sth = &GetSuggestion($suggestionid)
215
216 this function get the detail of the suggestion $suggestionid (input arg)
217
218 return :
219     the result of the SQL query as a hash : $sth->fetchrow_hashref.
220
221 =cut
222
223 sub GetSuggestion {
224     my ($suggestionid) = @_;
225     my $dbh           = C4::Context->dbh;
226     my $query         = q{
227         SELECT *
228         FROM   suggestions
229         WHERE  suggestionid=?
230     };
231     my $sth = $dbh->prepare($query);
232     $sth->execute($suggestionid);
233     return ( $sth->fetchrow_hashref );
234 }
235
236 =head2 GetSuggestionFromBiblionumber
237
238 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
239
240 Get a suggestion from it's biblionumber.
241
242 return :
243 the id of the suggestion which is related to the biblionumber given on input args.
244
245 =cut
246
247 sub GetSuggestionFromBiblionumber {
248     my ($biblionumber) = @_;
249     my $query = q{
250         SELECT suggestionid
251         FROM   suggestions
252         WHERE  biblionumber=? LIMIT 1
253     };
254     my $dbh = C4::Context->dbh;
255     my $sth = $dbh->prepare($query);
256     $sth->execute($biblionumber);
257     my ($suggestionid) = $sth->fetchrow;
258     return $suggestionid;
259 }
260
261 =head2 GetSuggestionInfoFromBiblionumber
262
263 Get a suggestion and borrower's informations from it's biblionumber.
264
265 return :
266 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
267
268 =cut
269
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
281     };
282     my $dbh = C4::Context->dbh;
283     my $sth = $dbh->prepare($query);
284     $sth->execute($biblionumber);
285     return $sth->fetchrow_hashref;
286 }
287
288 =head2 GetSuggestionInfo
289
290 Get a suggestion and borrower's informations from it's suggestionid
291
292 return :
293 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
294
295 =cut
296
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
308     };
309     my $dbh = C4::Context->dbh;
310     my $sth = $dbh->prepare($query);
311     $sth->execute($suggestionid);
312     return $sth->fetchrow_hashref;
313 }
314
315 =head2 GetSuggestionByStatus
316
317 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
318
319 Get a suggestion from it's status
320
321 return :
322 all the suggestion with C<$status>
323
324 =cut
325
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 = ?
349     };
350
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 ='') };
358             }
359         }
360         if ($branchcode) {
361             push @sql_params, $branchcode;
362             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
363         }
364     }
365
366     my $sth = $dbh->prepare($query);
367     $sth->execute(@sql_params);
368     my $results;
369     $results = $sth->fetchall_arrayref( {} );
370     return $results;
371 }
372
373 =head2 CountSuggestion
374
375 &CountSuggestion($status)
376
377 Count the number of aqorders with the status given on input argument.
378 the arg status can be :
379
380 =over 2
381
382 =item * ASKED : asked by the user, not dealed by the librarian
383
384 =item * ACCEPTED : accepted by the librarian, but not yet ordered
385
386 =item * REJECTED : rejected by the librarian (definitive status)
387
388 =item * ORDERED : ordered by the librarian (acquisition module)
389
390 =back
391
392 return :
393 the number of suggestion with this status.
394
395 =cut
396
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() )
404     {
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=?)
411         };
412         $sth = $dbh->prepare($query);
413         $sth->execute( $status, $userenv->{branch} );
414     }
415     else {
416         my $query = q{
417             SELECT count(*)
418             FROM suggestions
419             WHERE STATUS=?
420         };
421         $sth = $dbh->prepare($query);
422         $sth->execute($status);
423     }
424     my ($result) = $sth->fetchrow;
425     return $result;
426 }
427
428 =head2 NewSuggestion
429
430
431 &NewSuggestion($suggestion);
432
433 Insert a new suggestion on database with value given on input arg.
434
435 =cut
436
437 sub NewSuggestion {
438     my ($suggestion) = @_;
439
440     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
441
442     $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
443
444     my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
445     my $suggestion_id = $suggestion_object->suggestionid;
446
447     my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
448     if ($emailpurchasesuggestions) {
449         my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
450         if (
451             my $letter = C4::Letters::GetPreparedLetter(
452                 module      => 'suggestions',
453                 letter_code => 'NEW_SUGGESTION',
454                 tables      => {
455                     'branches'    => $full_suggestion->{branchcode},
456                     'borrowers'   => $full_suggestion->{suggestedby},
457                     'suggestions' => $full_suggestion,
458                 },
459             )
460         ){
461
462             my $toaddress;
463             if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
464                 my $library =
465                   Koha::Libraries->find( $full_suggestion->{branchcode} );
466                 $toaddress =
467                      $library->branchreplyto
468                   || $library->branchemail
469                   || C4::Context->preference('ReplytoDefault')
470                   || C4::Context->preference('KohaAdminEmailAddress');
471             }
472             elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
473                 $toaddress = C4::Context->preference('ReplytoDefault')
474                   || C4::Context->preference('KohaAdminEmailAddress');
475             }
476             else {
477                 $toaddress =
478                      C4::Context->preference($emailpurchasesuggestions)
479                   || C4::Context->preference('ReplytoDefault')
480                   || C4::Context->preference('KohaAdminEmailAddress');
481             }
482
483             C4::Letters::EnqueueLetter(
484                 {
485                     letter         => $letter,
486                     borrowernumber => $full_suggestion->{suggestedby},
487                     suggestionid   => $full_suggestion->{suggestionid},
488                     to_address     => $toaddress,
489                     message_transport_type => 'email',
490                 }
491             ) or warn "can't enqueue letter $letter";
492         }
493     }
494
495     return $suggestion_id;
496 }
497
498 =head2 ModSuggestion
499
500 &ModSuggestion($suggestion)
501
502 Modify the suggestion according to the hash passed by ref.
503 The hash HAS to contain suggestionid
504 Data not defined is not updated unless it is a note or sort1
505 Send a mail to notify the user that did the suggestion.
506
507 Note that there is no function to modify a suggestion.
508
509 =cut
510
511 sub ModSuggestion {
512     my ($suggestion) = @_;
513     return unless( $suggestion and defined($suggestion->{suggestionid}) );
514
515     my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
516     eval { # FIXME Must raise an exception instead
517         $suggestion_object->set($suggestion)->store;
518     };
519     return 0 if $@;
520
521     if ( $suggestion->{STATUS} ) {
522
523         # fetch the entire updated suggestion so that we can populate the letter
524         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
525         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
526
527         my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
528
529         if (
530             my $letter = C4::Letters::GetPreparedLetter(
531                 module      => 'suggestions',
532                 letter_code => $full_suggestion->{STATUS},
533                 branchcode  => $full_suggestion->{branchcode},
534                 lang        => $patron->lang,
535                 tables      => {
536                     'branches'    => $full_suggestion->{branchcode},
537                     'borrowers'   => $full_suggestion->{suggestedby},
538                     'suggestions' => $full_suggestion,
539                     'biblio'      => $full_suggestion->{biblionumber},
540                 },
541             )
542           )
543         {
544             C4::Letters::EnqueueLetter(
545                 {
546                     letter         => $letter,
547                     borrowernumber => $full_suggestion->{suggestedby},
548                     suggestionid   => $full_suggestion->{suggestionid},
549                     LibraryName    => C4::Context->preference("LibraryName"),
550                     message_transport_type => $transport,
551                 }
552             ) or warn "can't enqueue letter $letter";
553         }
554     }
555     return 1; # No useful if the exception is raised earlier
556 }
557
558 =head2 ConnectSuggestionAndBiblio
559
560 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
561
562 connect a suggestion to an existing biblio
563
564 =cut
565
566 sub ConnectSuggestionAndBiblio {
567     my ( $suggestionid, $biblionumber ) = @_;
568     my $dbh   = C4::Context->dbh;
569     my $query = q{
570         UPDATE suggestions
571         SET    biblionumber=?
572         WHERE  suggestionid=?
573     };
574     my $sth = $dbh->prepare($query);
575     $sth->execute( $biblionumber, $suggestionid );
576 }
577
578 =head2 DelSuggestion
579
580 &DelSuggestion($borrowernumber,$ordernumber)
581
582 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
583
584 =cut
585
586 sub DelSuggestion {
587     my ( $borrowernumber, $suggestionid, $type ) = @_;
588     my $dbh = C4::Context->dbh;
589
590     # check that the suggestion comes from the suggestor
591     my $query = q{
592         SELECT suggestedby
593         FROM   suggestions
594         WHERE  suggestionid=?
595     };
596     my $sth = $dbh->prepare($query);
597     $sth->execute($suggestionid);
598     my ($suggestedby) = $sth->fetchrow;
599     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
600         my $queryDelete = q{
601             DELETE FROM suggestions
602             WHERE suggestionid=?
603         };
604         $sth = $dbh->prepare($queryDelete);
605         my $suggestiondeleted = $sth->execute($suggestionid);
606         return $suggestiondeleted;
607     }
608 }
609
610 =head2 DelSuggestionsOlderThan
611     &DelSuggestionsOlderThan($days)
612
613     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
614     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
615
616 =cut
617
618 sub DelSuggestionsOlderThan {
619     my ($days) = @_;
620     return unless $days && $days > 0;
621     my $dbh = C4::Context->dbh;
622     my $sth = $dbh->prepare(
623         q{
624         DELETE FROM suggestions
625         WHERE STATUS<>'ASKED'
626             AND date < ADDDATE(NOW(), ?)
627     }
628     );
629     $sth->execute("-$days");
630 }
631
632 sub GetUnprocessedSuggestions {
633     my ( $number_of_days_since_the_last_modification ) = @_;
634
635     $number_of_days_since_the_last_modification ||= 0;
636
637     my $dbh = C4::Context->dbh;
638
639     my $s = $dbh->selectall_arrayref(q|
640         SELECT *
641         FROM suggestions
642         WHERE STATUS = 'ASKED'
643             AND budgetid IS NOT NULL
644             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
645     |, { Slice => {} }, $number_of_days_since_the_last_modification );
646     return $s;
647 }
648
649 1;
650 __END__
651
652
653 =head1 AUTHOR
654
655 Koha Development Team <http://koha-community.org/>
656
657 =cut
658