Bug 17605: [MASTER] Add currency to orders generated by quotes
[koha.git] / C4 / Suggestions.pm
blob8e76cea4d7e4551b42765fbf6c1c2456fe4d56b7
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, 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"
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 return $rs->create($suggestion)->id;
460 =head2 ModSuggestion
462 &ModSuggestion($suggestion)
464 Modify the suggestion according to the hash passed by ref.
465 The hash HAS to contain suggestionid
466 Data not defined is not updated unless it is a note or sort1
467 Send a mail to notify the user that did the suggestion.
469 Note that there is no function to modify a suggestion.
471 =cut
473 sub ModSuggestion {
474 my ($suggestion) = @_;
475 return unless( $suggestion and defined($suggestion->{suggestionid}) );
477 for my $field ( qw(
478 suggestedby
479 managedby
480 manageddate
481 acceptedby
482 accepteddate
483 rejectedby
484 rejecteddate
485 budgetid
486 ) ) {
487 # Set the fields to NULL if not given.
488 $suggestion->{$field} = undef
489 if exists $suggestion->{$field}
490 and ($suggestion->{$field} eq '0'
491 or $suggestion->{$field} eq '' );
494 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
495 my $status_update_table = 1;
496 eval {
497 $rs->update($suggestion);
499 $status_update_table = 0 if( $@ );
501 if ( $suggestion->{STATUS} ) {
503 # fetch the entire updated suggestion so that we can populate the letter
504 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
505 if (
506 my $letter = C4::Letters::GetPreparedLetter(
507 module => 'suggestions',
508 letter_code => $full_suggestion->{STATUS},
509 branchcode => $full_suggestion->{branchcode},
510 tables => {
511 'branches' => $full_suggestion->{branchcode},
512 'borrowers' => $full_suggestion->{suggestedby},
513 'suggestions' => $full_suggestion,
514 'biblio' => $full_suggestion->{biblionumber},
519 C4::Letters::EnqueueLetter(
521 letter => $letter,
522 borrowernumber => $full_suggestion->{suggestedby},
523 suggestionid => $full_suggestion->{suggestionid},
524 LibraryName => C4::Context->preference("LibraryName"),
525 message_transport_type => 'email',
527 ) or warn "can't enqueue letter $letter";
530 return $status_update_table;
533 =head2 ConnectSuggestionAndBiblio
535 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
537 connect a suggestion to an existing biblio
539 =cut
541 sub ConnectSuggestionAndBiblio {
542 my ( $suggestionid, $biblionumber ) = @_;
543 my $dbh = C4::Context->dbh;
544 my $query = q{
545 UPDATE suggestions
546 SET biblionumber=?
547 WHERE suggestionid=?
549 my $sth = $dbh->prepare($query);
550 $sth->execute( $biblionumber, $suggestionid );
553 =head2 DelSuggestion
555 &DelSuggestion($borrowernumber,$ordernumber)
557 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
559 =cut
561 sub DelSuggestion {
562 my ( $borrowernumber, $suggestionid, $type ) = @_;
563 my $dbh = C4::Context->dbh;
565 # check that the suggestion comes from the suggestor
566 my $query = q{
567 SELECT suggestedby
568 FROM suggestions
569 WHERE suggestionid=?
571 my $sth = $dbh->prepare($query);
572 $sth->execute($suggestionid);
573 my ($suggestedby) = $sth->fetchrow;
574 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
575 my $queryDelete = q{
576 DELETE FROM suggestions
577 WHERE suggestionid=?
579 $sth = $dbh->prepare($queryDelete);
580 my $suggestiondeleted = $sth->execute($suggestionid);
581 return $suggestiondeleted;
585 =head2 DelSuggestionsOlderThan
586 &DelSuggestionsOlderThan($days)
588 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
590 =cut
592 sub DelSuggestionsOlderThan {
593 my ($days) = @_;
594 return unless $days;
595 my $dbh = C4::Context->dbh;
596 my $sth = $dbh->prepare(
598 DELETE FROM suggestions
599 WHERE STATUS<>'ASKED'
600 AND date < ADDDATE(NOW(), ?)
603 $sth->execute("-$days");
606 sub GetUnprocessedSuggestions {
607 my ( $number_of_days_since_the_last_modification ) = @_;
609 $number_of_days_since_the_last_modification ||= 0;
611 my $dbh = C4::Context->dbh;
613 my $s = $dbh->selectall_arrayref(q|
614 SELECT *
615 FROM suggestions
616 WHERE STATUS = 'ASKED'
617 AND budgetid IS NOT NULL
618 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
619 |, { Slice => {} }, $number_of_days_since_the_last_modification );
620 return $s;
624 __END__
627 =head1 AUTHOR
629 Koha Development Team <http://koha-community.org/>
631 =cut