Bug 13697: DBRev 3.21.00.20
[koha.git] / C4 / Suggestions.pm
blobb5af96e05a27f585e3330660c1c5c83d4e8d96e7
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::Dates qw(format_date format_date_in_iso);
29 use C4::Debug;
30 use C4::Letters;
31 use Koha::DateUtils qw( dt_from_string );
33 use List::MoreUtils qw(any);
34 use C4::Dates qw(format_date_in_iso);
35 use base qw(Exporter);
37 our $VERSION = 3.07.00.049;
38 our @EXPORT = qw(
39 ConnectSuggestionAndBiblio
40 CountSuggestion
41 DelSuggestion
42 GetSuggestion
43 GetSuggestionByStatus
44 GetSuggestionFromBiblionumber
45 GetSuggestionInfoFromBiblionumber
46 GetSuggestionInfo
47 ModStatus
48 ModSuggestion
49 NewSuggestion
50 SearchSuggestion
51 DelSuggestionsOlderThan
52 GetUnprocessedSuggestions
55 =head1 NAME
57 C4::Suggestions - Some useful functions for dealings with aqorders.
59 =head1 SYNOPSIS
61 use C4::Suggestions;
63 =head1 DESCRIPTION
65 The functions in this module deal with the aqorders in OPAC and in librarian interface
67 A suggestion is done in the OPAC. It has the status "ASKED"
69 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
71 When the book is ordered, the suggestion status becomes "ORDERED"
73 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
75 All aqorders of a borrower can be seen by the borrower itself.
76 Suggestions done by other borrowers can be seen when not "AVAILABLE"
78 =head1 FUNCTIONS
80 =head2 SearchSuggestion
82 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
84 searches for a suggestion
86 return :
87 C<\@array> : the aqorders found. Array of hash.
88 Note the status is stored twice :
89 * in the status field
90 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
92 =cut
94 sub SearchSuggestion {
95 my ($suggestion) = @_;
96 my $dbh = C4::Context->dbh;
97 my @sql_params;
98 my @query = (
100 SELECT suggestions.*,
101 U1.branchcode AS branchcodesuggestedby,
102 B1.branchname AS branchnamesuggestedby,
103 U1.surname AS surnamesuggestedby,
104 U1.firstname AS firstnamesuggestedby,
105 U1.cardnumber AS cardnumbersuggestedby,
106 U1.email AS emailsuggestedby,
107 U1.borrowernumber AS borrnumsuggestedby,
108 U1.categorycode AS categorycodesuggestedby,
109 C1.description AS categorydescriptionsuggestedby,
110 U2.surname AS surnamemanagedby,
111 U2.firstname AS firstnamemanagedby,
112 B2.branchname AS branchnamesuggestedby,
113 U2.email AS emailmanagedby,
114 U2.branchcode AS branchcodemanagedby,
115 U2.borrowernumber AS borrnummanagedby
116 FROM suggestions
117 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
118 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
119 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
120 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
121 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
122 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
123 WHERE 1=1
127 # filter on biblio informations
128 foreach my $field (
129 qw( title author isbn publishercode copyrightdate collectiontitle ))
131 if ( $suggestion->{$field} ) {
132 push @sql_params, '%' . $suggestion->{$field} . '%';
133 push @query, qq{ AND suggestions.$field LIKE ? };
137 # filter on user branch
138 if ( C4::Context->preference('IndependentBranches') ) {
139 my $userenv = C4::Context->userenv;
140 if ($userenv) {
141 if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
143 push @sql_params, $$userenv{branch};
144 push @query, q{
145 AND (suggestions.branchcode=? OR suggestions.branchcode='')
149 } else {
150 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
151 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
152 push @sql_params, $suggestion->{branchcode};
153 push @query, qq{ AND suggestions.branchcode=? };
158 # filter on nillable fields
159 foreach my $field (
160 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
163 if ( exists $suggestion->{$field}
164 and defined $suggestion->{$field}
165 and $suggestion->{$field} ne '__ANY__'
166 and $suggestion->{$field} ne q||
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 my $today = C4::Dates->today('iso');
180 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
181 my $from = $field . "_from";
182 my $to = $field . "_to";
183 if ( $suggestion->{$from} || $suggestion->{$to} ) {
184 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
185 push @sql_params,
186 format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
187 push @sql_params,
188 format_date_in_iso( $suggestion->{$to} ) || $today;
192 $debug && warn "@query";
193 my $sth = $dbh->prepare("@query");
194 $sth->execute(@sql_params);
195 my @results;
197 # add status as field
198 while ( my $data = $sth->fetchrow_hashref ) {
199 $data->{ $data->{STATUS} } = 1;
200 push( @results, $data );
203 return ( \@results );
206 =head2 GetSuggestion
208 \%sth = &GetSuggestion($suggestionid)
210 this function get the detail of the suggestion $suggestionid (input arg)
212 return :
213 the result of the SQL query as a hash : $sth->fetchrow_hashref.
215 =cut
217 sub GetSuggestion {
218 my ($suggestionid) = @_;
219 my $dbh = C4::Context->dbh;
220 my $query = q{
221 SELECT *
222 FROM suggestions
223 WHERE suggestionid=?
225 my $sth = $dbh->prepare($query);
226 $sth->execute($suggestionid);
227 return ( $sth->fetchrow_hashref );
230 =head2 GetSuggestionFromBiblionumber
232 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
234 Get a suggestion from it's biblionumber.
236 return :
237 the id of the suggestion which is related to the biblionumber given on input args.
239 =cut
241 sub GetSuggestionFromBiblionumber {
242 my ($biblionumber) = @_;
243 my $query = q{
244 SELECT suggestionid
245 FROM suggestions
246 WHERE biblionumber=? LIMIT 1
248 my $dbh = C4::Context->dbh;
249 my $sth = $dbh->prepare($query);
250 $sth->execute($biblionumber);
251 my ($suggestionid) = $sth->fetchrow;
252 return $suggestionid;
255 =head2 GetSuggestionInfoFromBiblionumber
257 Get a suggestion and borrower's informations from it's biblionumber.
259 return :
260 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
262 =cut
264 sub GetSuggestionInfoFromBiblionumber {
265 my ($biblionumber) = @_;
266 my $query = q{
267 SELECT suggestions.*,
268 U1.surname AS surnamesuggestedby,
269 U1.firstname AS firstnamesuggestedby,
270 U1.borrowernumber AS borrnumsuggestedby
271 FROM suggestions
272 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
273 WHERE biblionumber=?
274 LIMIT 1
276 my $dbh = C4::Context->dbh;
277 my $sth = $dbh->prepare($query);
278 $sth->execute($biblionumber);
279 return $sth->fetchrow_hashref;
282 =head2 GetSuggestionInfo
284 Get a suggestion and borrower's informations from it's suggestionid
286 return :
287 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
289 =cut
291 sub GetSuggestionInfo {
292 my ($suggestionid) = @_;
293 my $query = q{
294 SELECT suggestions.*,
295 U1.surname AS surnamesuggestedby,
296 U1.firstname AS firstnamesuggestedby,
297 U1.borrowernumber AS borrnumsuggestedby
298 FROM suggestions
299 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
300 WHERE suggestionid=?
301 LIMIT 1
303 my $dbh = C4::Context->dbh;
304 my $sth = $dbh->prepare($query);
305 $sth->execute($suggestionid);
306 return $sth->fetchrow_hashref;
309 =head2 GetSuggestionByStatus
311 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
313 Get a suggestion from it's status
315 return :
316 all the suggestion with C<$status>
318 =cut
320 sub GetSuggestionByStatus {
321 my $status = shift;
322 my $branchcode = shift;
323 my $dbh = C4::Context->dbh;
324 my @sql_params = ($status);
325 my $query = q{
326 SELECT suggestions.*,
327 U1.surname AS surnamesuggestedby,
328 U1.firstname AS firstnamesuggestedby,
329 U1.branchcode AS branchcodesuggestedby,
330 B1.branchname AS branchnamesuggestedby,
331 U1.borrowernumber AS borrnumsuggestedby,
332 U1.categorycode AS categorycodesuggestedby,
333 C1.description AS categorydescriptionsuggestedby,
334 U2.surname AS surnamemanagedby,
335 U2.firstname AS firstnamemanagedby,
336 U2.borrowernumber AS borrnummanagedby
337 FROM suggestions
338 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
339 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
340 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
341 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
342 WHERE status = ?
345 # filter on branch
346 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
347 my $userenv = C4::Context->userenv;
348 if ($userenv) {
349 unless ( C4::Context->IsSuperLibrarian() ) {
350 push @sql_params, $userenv->{branch};
351 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
354 if ($branchcode) {
355 push @sql_params, $branchcode;
356 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
360 my $sth = $dbh->prepare($query);
361 $sth->execute(@sql_params);
362 my $results;
363 $results = $sth->fetchall_arrayref( {} );
364 return $results;
367 =head2 CountSuggestion
369 &CountSuggestion($status)
371 Count the number of aqorders with the status given on input argument.
372 the arg status can be :
374 =over 2
376 =item * ASKED : asked by the user, not dealed by the librarian
378 =item * ACCEPTED : accepted by the librarian, but not yet ordered
380 =item * REJECTED : rejected by the librarian (definitive status)
382 =item * ORDERED : ordered by the librarian (acquisition module)
384 =back
386 return :
387 the number of suggestion with this status.
389 =cut
391 sub CountSuggestion {
392 my ($status) = @_;
393 my $dbh = C4::Context->dbh;
394 my $sth;
395 my $userenv = C4::Context->userenv;
396 if ( C4::Context->preference("IndependentBranches")
397 && !C4::Context->IsSuperLibrarian() )
399 my $query = q{
400 SELECT count(*)
401 FROM suggestions
402 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
403 WHERE STATUS=?
404 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
406 $sth = $dbh->prepare($query);
407 $sth->execute( $status, $userenv->{branch} );
409 else {
410 my $query = q{
411 SELECT count(*)
412 FROM suggestions
413 WHERE STATUS=?
415 $sth = $dbh->prepare($query);
416 $sth->execute($status);
418 my ($result) = $sth->fetchrow;
419 return $result;
422 =head2 NewSuggestion
425 &NewSuggestion($suggestion);
427 Insert a new suggestion on database with value given on input arg.
429 =cut
431 sub NewSuggestion {
432 my ($suggestion) = @_;
434 for my $field ( qw(
435 suggestedby
436 managedby
437 manageddate
438 acceptedby
439 accepteddate
440 rejectedby
441 rejecteddate
442 budgetid
443 ) ) {
444 # Set the fields to NULL if not given.
445 $suggestion->{$field} ||= undef;
448 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
450 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
452 my $rs = Koha::Database->new->schema->resultset('Suggestion');
453 return $rs->create($suggestion)->id;
456 =head2 ModSuggestion
458 &ModSuggestion($suggestion)
460 Modify the suggestion according to the hash passed by ref.
461 The hash HAS to contain suggestionid
462 Data not defined is not updated unless it is a note or sort1
463 Send a mail to notify the user that did the suggestion.
465 Note that there is no function to modify a suggestion.
467 =cut
469 sub ModSuggestion {
470 my ($suggestion) = @_;
471 return unless( $suggestion and defined($suggestion->{suggestionid}) );
473 for my $field ( qw(
474 suggestedby
475 managedby
476 manageddate
477 acceptedby
478 accepteddate
479 rejectedby
480 rejecteddate
481 budgetid
482 ) ) {
483 # Set the fields to NULL if not given.
484 $suggestion->{$field} = undef
485 if exists $suggestion->{$field}
486 and ($suggestion->{$field} eq '0'
487 or $suggestion->{$field} eq '' );
490 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
491 my $status_update_table = 1;
492 eval {
493 $rs->update($suggestion);
495 $status_update_table = 0 if( $@ );
497 if ( $suggestion->{STATUS} ) {
499 # fetch the entire updated suggestion so that we can populate the letter
500 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
501 if (
502 my $letter = C4::Letters::GetPreparedLetter(
503 module => 'suggestions',
504 letter_code => $full_suggestion->{STATUS},
505 branchcode => $full_suggestion->{branchcode},
506 tables => {
507 'branches' => $full_suggestion->{branchcode},
508 'borrowers' => $full_suggestion->{suggestedby},
509 'suggestions' => $full_suggestion,
510 'biblio' => $full_suggestion->{biblionumber},
515 C4::Letters::EnqueueLetter(
517 letter => $letter,
518 borrowernumber => $full_suggestion->{suggestedby},
519 suggestionid => $full_suggestion->{suggestionid},
520 LibraryName => C4::Context->preference("LibraryName"),
521 message_transport_type => 'email',
523 ) or warn "can't enqueue letter $letter";
526 return $status_update_table;
529 =head2 ConnectSuggestionAndBiblio
531 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
533 connect a suggestion to an existing biblio
535 =cut
537 sub ConnectSuggestionAndBiblio {
538 my ( $suggestionid, $biblionumber ) = @_;
539 my $dbh = C4::Context->dbh;
540 my $query = q{
541 UPDATE suggestions
542 SET biblionumber=?
543 WHERE suggestionid=?
545 my $sth = $dbh->prepare($query);
546 $sth->execute( $biblionumber, $suggestionid );
549 =head2 DelSuggestion
551 &DelSuggestion($borrowernumber,$ordernumber)
553 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
555 =cut
557 sub DelSuggestion {
558 my ( $borrowernumber, $suggestionid, $type ) = @_;
559 my $dbh = C4::Context->dbh;
561 # check that the suggestion comes from the suggestor
562 my $query = q{
563 SELECT suggestedby
564 FROM suggestions
565 WHERE suggestionid=?
567 my $sth = $dbh->prepare($query);
568 $sth->execute($suggestionid);
569 my ($suggestedby) = $sth->fetchrow;
570 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
571 my $queryDelete = q{
572 DELETE FROM suggestions
573 WHERE suggestionid=?
575 $sth = $dbh->prepare($queryDelete);
576 my $suggestiondeleted = $sth->execute($suggestionid);
577 return $suggestiondeleted;
581 =head2 DelSuggestionsOlderThan
582 &DelSuggestionsOlderThan($days)
584 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
586 =cut
588 sub DelSuggestionsOlderThan {
589 my ($days) = @_;
590 return unless $days;
591 my $dbh = C4::Context->dbh;
592 my $sth = $dbh->prepare(
594 DELETE FROM suggestions
595 WHERE STATUS<>'ASKED'
596 AND date < ADDDATE(NOW(), ?)
599 $sth->execute("-$days");
602 sub GetUnprocessedSuggestions {
603 my ( $number_of_days_since_the_last_modification ) = @_;
605 $number_of_days_since_the_last_modification ||= 0;
607 my $dbh = C4::Context->dbh;
609 my $s = $dbh->selectall_arrayref(q|
610 SELECT *
611 FROM suggestions
612 WHERE STATUS = 'ASKED'
613 AND budgetid IS NOT NULL
614 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
615 |, { Slice => {} }, $number_of_days_since_the_last_modification );
616 return $s;
620 __END__
623 =head1 AUTHOR
625 Koha Development Team <http://koha-community.org/>
627 =cut