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>.
28 use C4::Biblio qw( GetMarcFromKohaField );
30 use Koha::Suggestions;
32 use List::MoreUtils qw(any);
33 use base qw(Exporter);
36 ConnectSuggestionAndBiblio
41 GetSuggestionFromBiblionumber
42 GetSuggestionInfoFromBiblionumber
48 DelSuggestionsOlderThan
49 GetUnprocessedSuggestions
50 MarcRecordFromNewSuggestion
55 C4::Suggestions - Some useful functions for dealings with aqorders.
63 The functions in this module deal with the aqorders in OPAC and in librarian interface
65 A suggestion is done in the OPAC. It has the status "ASKED"
67 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
69 When the book is ordered, the suggestion status becomes "ORDERED"
71 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
73 All aqorders of a borrower can be seen by the borrower itself.
74 Suggestions done by other borrowers can be seen when not "AVAILABLE"
78 =head2 SearchSuggestion
80 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
82 searches for a suggestion
85 C<\@array> : the aqorders found. Array of hash.
86 Note the status is stored twice :
88 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
92 sub SearchSuggestion {
93 my ($suggestion) = @_;
94 my $dbh = C4::Context->dbh;
99 U1.branchcode AS branchcodesuggestedby,
100 B1.branchname AS branchnamesuggestedby,
101 U1.surname AS surnamesuggestedby,
102 U1.firstname AS firstnamesuggestedby,
103 U1.cardnumber AS cardnumbersuggestedby,
104 U1.email AS emailsuggestedby,
105 U1.borrowernumber AS borrnumsuggestedby,
106 U1.categorycode AS categorycodesuggestedby,
107 C1.description AS categorydescriptionsuggestedby,
108 U2.surname AS surnamemanagedby,
109 U2.firstname AS firstnamemanagedby,
110 B2.branchname AS branchnamesuggestedby,
111 U2.email AS emailmanagedby,
112 U2.branchcode AS branchcodemanagedby,
113 U2.borrowernumber AS borrnummanagedby,
114 U3.surname AS surnamelastmodificationby,
115 U3.firstname AS firstnamelastmodificationby,
116 BU.budget_name AS budget_name
118 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
119 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
120 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
121 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
122 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
123 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
124 LEFT JOIN borrowers AS U3 ON lastmodificationby=U3.borrowernumber
125 LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
130 # filter on biblio informations
132 qw( title author isbn publishercode copyrightdate collectiontitle ))
134 if ( $suggestion->{$field} ) {
135 push @sql_params, '%' . $suggestion->{$field} . '%';
136 push @query, qq{ AND suggestions.$field LIKE ? };
140 # filter on user branch
141 if ( C4::Context->preference('IndependentBranches')
142 && !C4::Context->IsSuperLibrarian() )
144 # If IndependentBranches is set and the logged in user is not superlibrarian
145 # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
146 my $userenv = C4::Context->userenv;
149 push @sql_params, $$userenv{branch};
151 AND (suggestions.branchcode=? OR suggestions.branchcode='')
156 elsif (defined $suggestion->{branchcode}
157 && $suggestion->{branchcode}
158 && $suggestion->{branchcode} ne '__ANY__' )
160 # If IndependentBranches is not set OR the logged in user is not superlibrarian
161 # AND the branchcode filter is passed and not '__ANY__'
162 # Then we want to filter using this parameter
163 push @sql_params, $suggestion->{branchcode};
164 push @query, qq{ AND suggestions.branchcode=? };
167 # filter on nillable fields
169 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
172 if ( exists $suggestion->{$field}
173 and defined $suggestion->{$field}
174 and $suggestion->{$field} ne '__ANY__'
176 $suggestion->{$field} ne q||
177 or $field eq 'STATUS'
180 if ( $suggestion->{$field} eq '__NONE__' ) {
181 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
184 push @sql_params, $suggestion->{$field};
185 push @query, qq{ AND suggestions.$field = ? };
190 # filter on date fields
191 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
192 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
193 my $from = $field . "_from";
194 my $to = $field . "_to";
196 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
198 $to_dt = eval { dt_from_string( $suggestion->{$to} ) } if ( $suggestion->{$to} );
200 push @query, qq{ AND suggestions.$field >= ?};
201 push @sql_params, $dtf->format_date($from_dt);
204 push @query, qq{ AND suggestions.$field <= ?};
205 push @sql_params, $dtf->format_date($to_dt);
209 # By default do not search for archived suggestions
210 unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
211 push @query, q{ AND suggestions.archived = 0 };
214 $debug && warn "@query";
215 my $sth = $dbh->prepare("@query");
216 $sth->execute(@sql_params);
219 # add status as field
220 while ( my $data = $sth->fetchrow_hashref ) {
221 $data->{ $data->{STATUS} } = 1;
222 push( @results, $data );
225 return ( \@results );
230 \%sth = &GetSuggestion($suggestionid)
232 this function get the detail of the suggestion $suggestionid (input arg)
235 the result of the SQL query as a hash : $sth->fetchrow_hashref.
240 my ($suggestionid) = @_;
241 my $dbh = C4::Context->dbh;
247 my $sth = $dbh->prepare($query);
248 $sth->execute($suggestionid);
249 return ( $sth->fetchrow_hashref );
252 =head2 GetSuggestionFromBiblionumber
254 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
256 Get a suggestion from it's biblionumber.
259 the id of the suggestion which is related to the biblionumber given on input args.
263 sub GetSuggestionFromBiblionumber {
264 my ($biblionumber) = @_;
268 WHERE biblionumber=? LIMIT 1
270 my $dbh = C4::Context->dbh;
271 my $sth = $dbh->prepare($query);
272 $sth->execute($biblionumber);
273 my ($suggestionid) = $sth->fetchrow;
274 return $suggestionid;
277 =head2 GetSuggestionInfoFromBiblionumber
279 Get a suggestion and borrower's informations from it's biblionumber.
282 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
286 sub GetSuggestionInfoFromBiblionumber {
287 my ($biblionumber) = @_;
289 SELECT suggestions.*,
290 U1.surname AS surnamesuggestedby,
291 U1.firstname AS firstnamesuggestedby,
292 U1.borrowernumber AS borrnumsuggestedby
294 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
298 my $dbh = C4::Context->dbh;
299 my $sth = $dbh->prepare($query);
300 $sth->execute($biblionumber);
301 return $sth->fetchrow_hashref;
304 =head2 GetSuggestionInfo
306 Get a suggestion and borrower's informations from it's suggestionid
309 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
313 sub GetSuggestionInfo {
314 my ($suggestionid) = @_;
316 SELECT suggestions.*,
317 U1.surname AS surnamesuggestedby,
318 U1.firstname AS firstnamesuggestedby,
319 U1.borrowernumber AS borrnumsuggestedby
321 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
325 my $dbh = C4::Context->dbh;
326 my $sth = $dbh->prepare($query);
327 $sth->execute($suggestionid);
328 return $sth->fetchrow_hashref;
331 =head2 GetSuggestionByStatus
333 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
335 Get a suggestion from it's status
338 all the suggestion with C<$status>
342 sub GetSuggestionByStatus {
344 my $branchcode = shift;
345 my $dbh = C4::Context->dbh;
346 my @sql_params = ($status);
348 SELECT suggestions.*,
349 U1.surname AS surnamesuggestedby,
350 U1.firstname AS firstnamesuggestedby,
351 U1.branchcode AS branchcodesuggestedby,
352 B1.branchname AS branchnamesuggestedby,
353 U1.borrowernumber AS borrnumsuggestedby,
354 U1.categorycode AS categorycodesuggestedby,
355 C1.description AS categorydescriptionsuggestedby,
356 U2.surname AS surnamemanagedby,
357 U2.firstname AS firstnamemanagedby,
358 U2.borrowernumber AS borrnummanagedby
360 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
361 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
362 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
363 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
365 ORDER BY suggestionid
369 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
370 my $userenv = C4::Context->userenv;
372 unless ( C4::Context->IsSuperLibrarian() ) {
373 push @sql_params, $userenv->{branch};
374 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
378 push @sql_params, $branchcode;
379 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
383 my $sth = $dbh->prepare($query);
384 $sth->execute(@sql_params);
386 $results = $sth->fetchall_arrayref( {} );
390 =head2 CountSuggestion
392 &CountSuggestion($status)
394 Count the number of aqorders with the status given on input argument.
395 the arg status can be :
399 =item * ASKED : asked by the user, not dealed by the librarian
401 =item * ACCEPTED : accepted by the librarian, but not yet ordered
403 =item * REJECTED : rejected by the librarian (definitive status)
405 =item * ORDERED : ordered by the librarian (acquisition module)
410 the number of suggestion with this status.
414 sub CountSuggestion {
416 my $dbh = C4::Context->dbh;
418 my $userenv = C4::Context->userenv;
419 if ( C4::Context->preference("IndependentBranches")
420 && !C4::Context->IsSuperLibrarian() )
425 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
427 AND (suggestions.branchcode='' OR suggestions.branchcode=?)
429 $sth = $dbh->prepare($query);
430 $sth->execute( $status, $userenv->{branch} );
438 $sth = $dbh->prepare($query);
439 $sth->execute($status);
441 my ($result) = $sth->fetchrow;
448 &NewSuggestion($suggestion);
450 Insert a new suggestion on database with value given on input arg.
455 my ($suggestion) = @_;
457 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
459 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
461 delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
463 my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
464 my $suggestion_id = $suggestion_object->suggestionid;
466 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
467 if ($emailpurchasesuggestions) {
468 my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
470 my $letter = C4::Letters::GetPreparedLetter(
471 module => 'suggestions',
472 letter_code => 'NEW_SUGGESTION',
474 'branches' => $full_suggestion->{branchcode},
475 'borrowers' => $full_suggestion->{suggestedby},
476 'suggestions' => $full_suggestion,
482 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
484 Koha::Libraries->find( $full_suggestion->{branchcode} );
485 $toaddress = $library->inbound_email_address;
487 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
488 $toaddress = C4::Context->preference('ReplytoDefault')
489 || C4::Context->preference('KohaAdminEmailAddress');
493 C4::Context->preference($emailpurchasesuggestions)
494 || C4::Context->preference('ReplytoDefault')
495 || C4::Context->preference('KohaAdminEmailAddress');
498 C4::Letters::EnqueueLetter(
501 borrowernumber => $full_suggestion->{suggestedby},
502 suggestionid => $full_suggestion->{suggestionid},
503 to_address => $toaddress,
504 message_transport_type => 'email',
506 ) or warn "can't enqueue letter $letter";
510 return $suggestion_id;
515 &ModSuggestion($suggestion)
517 Modify the suggestion according to the hash passed by ref.
518 The hash HAS to contain suggestionid
519 Data not defined is not updated unless it is a note or sort1
520 Send a mail to notify the user that did the suggestion.
522 Note that there is no function to modify a suggestion.
527 my ($suggestion) = @_;
528 return unless( $suggestion and defined($suggestion->{suggestionid}) );
530 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
531 eval { # FIXME Must raise an exception instead
532 $suggestion_object->set($suggestion)->store;
536 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
538 # fetch the entire updated suggestion so that we can populate the letter
539 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
541 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
543 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
546 my $letter = C4::Letters::GetPreparedLetter(
547 module => 'suggestions',
548 letter_code => $full_suggestion->{STATUS},
549 branchcode => $full_suggestion->{branchcode},
550 lang => $patron->lang,
552 'branches' => $full_suggestion->{branchcode},
553 'borrowers' => $full_suggestion->{suggestedby},
554 'suggestions' => $full_suggestion,
555 'biblio' => $full_suggestion->{biblionumber},
560 C4::Letters::EnqueueLetter(
563 borrowernumber => $full_suggestion->{suggestedby},
564 suggestionid => $full_suggestion->{suggestionid},
565 LibraryName => C4::Context->preference("LibraryName"),
566 message_transport_type => $transport,
568 ) or warn "can't enqueue letter $letter";
571 return 1; # No useful if the exception is raised earlier
574 =head2 ConnectSuggestionAndBiblio
576 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
578 connect a suggestion to an existing biblio
582 sub ConnectSuggestionAndBiblio {
583 my ( $suggestionid, $biblionumber ) = @_;
584 my $dbh = C4::Context->dbh;
590 my $sth = $dbh->prepare($query);
591 $sth->execute( $biblionumber, $suggestionid );
596 &DelSuggestion($borrowernumber,$ordernumber)
598 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
603 my ( $borrowernumber, $suggestionid, $type ) = @_;
604 my $dbh = C4::Context->dbh;
606 # check that the suggestion comes from the suggestor
612 my $sth = $dbh->prepare($query);
613 $sth->execute($suggestionid);
614 my ($suggestedby) = $sth->fetchrow;
615 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
617 DELETE FROM suggestions
620 $sth = $dbh->prepare($queryDelete);
621 my $suggestiondeleted = $sth->execute($suggestionid);
622 return $suggestiondeleted;
626 =head2 DelSuggestionsOlderThan
627 &DelSuggestionsOlderThan($days)
629 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
630 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
634 sub DelSuggestionsOlderThan {
636 return unless $days && $days > 0;
637 my $dbh = C4::Context->dbh;
638 my $sth = $dbh->prepare(
640 DELETE FROM suggestions
641 WHERE STATUS<>'ASKED'
642 AND date < ADDDATE(NOW(), ?)
645 $sth->execute("-$days");
648 sub GetUnprocessedSuggestions {
649 my ( $number_of_days_since_the_last_modification ) = @_;
651 $number_of_days_since_the_last_modification ||= 0;
653 my $dbh = C4::Context->dbh;
655 my $s = $dbh->selectall_arrayref(q|
658 WHERE STATUS = 'ASKED'
659 AND budgetid IS NOT NULL
660 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
661 |, { Slice => {} }, $number_of_days_since_the_last_modification );
665 =head2 MarcRecordFromNewSuggestion
667 $record = MarcRecordFromNewSuggestion ( $suggestion )
669 This function build a marc record object from a suggestion
673 sub MarcRecordFromNewSuggestion {
674 my ($suggestion) = @_;
675 my $record = MARC::Record->new();
677 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
678 $record->append_fields(
679 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
682 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
683 if ($record->field( $author_tag )) {
684 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
687 $record->append_fields(
688 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
692 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
693 if ($record->field( $it_tag )) {
694 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
697 $record->append_fields(
698 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
711 Koha Development Team <http://koha-community.org/>