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>.
27 use C4::Biblio qw( GetMarcFromKohaField );
29 use Koha::Suggestions;
31 use List::MoreUtils qw(any);
32 use base qw(Exporter);
35 ConnectSuggestionAndBiblio
39 GetSuggestionFromBiblionumber
40 GetSuggestionInfoFromBiblionumber
46 DelSuggestionsOlderThan
47 GetUnprocessedSuggestions
48 MarcRecordFromNewSuggestion
53 C4::Suggestions - Some useful functions for dealings with aqorders.
61 The functions in this module deal with the aqorders in OPAC and in librarian interface
63 A suggestion is done in the OPAC. It has the status "ASKED"
65 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
67 When the book is ordered, the suggestion status becomes "ORDERED"
69 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
71 All aqorders of a borrower can be seen by the borrower itself.
72 Suggestions done by other borrowers can be seen when not "AVAILABLE"
76 =head2 SearchSuggestion
78 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
80 searches for a suggestion
83 C<\@array> : the aqorders found. Array of hash.
84 Note the status is stored twice :
86 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
90 sub SearchSuggestion {
91 my ($suggestion) = @_;
92 my $dbh = C4::Context->dbh;
97 U1.branchcode AS branchcodesuggestedby,
98 B1.branchname AS branchnamesuggestedby,
99 U1.surname AS surnamesuggestedby,
100 U1.firstname AS firstnamesuggestedby,
101 U1.cardnumber AS cardnumbersuggestedby,
102 U1.email AS emailsuggestedby,
103 U1.borrowernumber AS borrnumsuggestedby,
104 U1.categorycode AS categorycodesuggestedby,
105 C1.description AS categorydescriptionsuggestedby,
106 U2.surname AS surnamemanagedby,
107 U2.firstname AS firstnamemanagedby,
108 B2.branchname AS branchnamesuggestedby,
109 U2.email AS emailmanagedby,
110 U2.branchcode AS branchcodemanagedby,
111 U2.borrowernumber AS borrnummanagedby,
112 U3.surname AS surnamelastmodificationby,
113 U3.firstname AS firstnamelastmodificationby,
114 BU.budget_name AS budget_name
116 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
117 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
118 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
119 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
120 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
121 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
122 LEFT JOIN borrowers AS U3 ON lastmodificationby=U3.borrowernumber
123 LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
128 # filter on biblio informations
130 qw( title author isbn publishercode copyrightdate collectiontitle ))
132 if ( $suggestion->{$field} ) {
133 push @sql_params, '%' . $suggestion->{$field} . '%';
134 push @query, qq{ AND suggestions.$field LIKE ? };
138 # filter on user branch
139 if ( C4::Context->preference('IndependentBranches')
140 && !C4::Context->IsSuperLibrarian() )
142 # If IndependentBranches is set and the logged in user is not superlibrarian
143 # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
144 my $userenv = C4::Context->userenv;
147 push @sql_params, $$userenv{branch};
149 AND (suggestions.branchcode=? OR suggestions.branchcode='')
154 elsif (defined $suggestion->{branchcode}
155 && $suggestion->{branchcode}
156 && $suggestion->{branchcode} ne '__ANY__' )
158 # If IndependentBranches is not set OR the logged in user is not superlibrarian
159 # AND the branchcode filter is passed and not '__ANY__'
160 # Then we want to filter using this parameter
161 push @sql_params, $suggestion->{branchcode};
162 push @query, qq{ AND suggestions.branchcode=? };
165 # filter on nillable fields
167 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
170 if ( exists $suggestion->{$field}
171 and defined $suggestion->{$field}
172 and $suggestion->{$field} ne '__ANY__'
174 $suggestion->{$field} ne q||
175 or $field eq 'STATUS'
178 if ( $suggestion->{$field} eq '__NONE__' ) {
179 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
182 push @sql_params, $suggestion->{$field};
183 push @query, qq{ AND suggestions.$field = ? };
188 # filter on date fields
189 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
190 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
191 my $from = $field . "_from";
192 my $to = $field . "_to";
194 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
196 $to_dt = eval { dt_from_string( $suggestion->{$to} ) } if ( $suggestion->{$to} );
198 push @query, qq{ AND suggestions.$field >= ?};
199 push @sql_params, $dtf->format_date($from_dt);
202 push @query, qq{ AND suggestions.$field <= ?};
203 push @sql_params, $dtf->format_date($to_dt);
207 # By default do not search for archived suggestions
208 unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
209 push @query, q{ AND suggestions.archived = 0 };
212 my $sth = $dbh->prepare("@query");
213 $sth->execute(@sql_params);
216 # add status as field
217 while ( my $data = $sth->fetchrow_hashref ) {
218 $data->{ $data->{STATUS} } = 1;
219 push( @results, $data );
222 return ( \@results );
227 \%sth = &GetSuggestion($suggestionid)
229 this function get the detail of the suggestion $suggestionid (input arg)
232 the result of the SQL query as a hash : $sth->fetchrow_hashref.
237 my ($suggestionid) = @_;
238 my $dbh = C4::Context->dbh;
244 my $sth = $dbh->prepare($query);
245 $sth->execute($suggestionid);
246 return ( $sth->fetchrow_hashref );
249 =head2 GetSuggestionFromBiblionumber
251 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
253 Get a suggestion from it's biblionumber.
256 the id of the suggestion which is related to the biblionumber given on input args.
260 sub GetSuggestionFromBiblionumber {
261 my ($biblionumber) = @_;
265 WHERE biblionumber=? LIMIT 1
267 my $dbh = C4::Context->dbh;
268 my $sth = $dbh->prepare($query);
269 $sth->execute($biblionumber);
270 my ($suggestionid) = $sth->fetchrow;
271 return $suggestionid;
274 =head2 GetSuggestionInfoFromBiblionumber
276 Get a suggestion and borrower's informations from it's biblionumber.
279 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
283 sub GetSuggestionInfoFromBiblionumber {
284 my ($biblionumber) = @_;
286 SELECT suggestions.*,
287 U1.surname AS surnamesuggestedby,
288 U1.firstname AS firstnamesuggestedby,
289 U1.borrowernumber AS borrnumsuggestedby
291 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
295 my $dbh = C4::Context->dbh;
296 my $sth = $dbh->prepare($query);
297 $sth->execute($biblionumber);
298 return $sth->fetchrow_hashref;
301 =head2 GetSuggestionInfo
303 Get a suggestion and borrower's informations from it's suggestionid
306 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
310 sub GetSuggestionInfo {
311 my ($suggestionid) = @_;
313 SELECT suggestions.*,
314 U1.surname AS surnamesuggestedby,
315 U1.firstname AS firstnamesuggestedby,
316 U1.borrowernumber AS borrnumsuggestedby
318 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
322 my $dbh = C4::Context->dbh;
323 my $sth = $dbh->prepare($query);
324 $sth->execute($suggestionid);
325 return $sth->fetchrow_hashref;
328 =head2 GetSuggestionByStatus
330 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
332 Get a suggestion from it's status
335 all the suggestion with C<$status>
339 sub GetSuggestionByStatus {
341 my $branchcode = shift;
342 my $dbh = C4::Context->dbh;
343 my @sql_params = ($status);
345 SELECT suggestions.*,
346 U1.surname AS surnamesuggestedby,
347 U1.firstname AS firstnamesuggestedby,
348 U1.branchcode AS branchcodesuggestedby,
349 B1.branchname AS branchnamesuggestedby,
350 U1.borrowernumber AS borrnumsuggestedby,
351 U1.categorycode AS categorycodesuggestedby,
352 C1.description AS categorydescriptionsuggestedby,
353 U2.surname AS surnamemanagedby,
354 U2.firstname AS firstnamemanagedby,
355 U2.borrowernumber AS borrnummanagedby
357 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
358 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
359 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
360 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
362 ORDER BY suggestionid
366 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
367 my $userenv = C4::Context->userenv;
369 unless ( C4::Context->IsSuperLibrarian() ) {
370 push @sql_params, $userenv->{branch};
371 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
375 push @sql_params, $branchcode;
376 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
380 my $sth = $dbh->prepare($query);
381 $sth->execute(@sql_params);
383 $results = $sth->fetchall_arrayref( {} );
390 &NewSuggestion($suggestion);
392 Insert a new suggestion on database with value given on input arg.
397 my ($suggestion) = @_;
399 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
401 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
403 delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
405 my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
406 my $suggestion_id = $suggestion_object->suggestionid;
408 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
409 if ($emailpurchasesuggestions) {
410 my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
412 my $letter = C4::Letters::GetPreparedLetter(
413 module => 'suggestions',
414 letter_code => 'NEW_SUGGESTION',
416 'branches' => $full_suggestion->{branchcode},
417 'borrowers' => $full_suggestion->{suggestedby},
418 'suggestions' => $full_suggestion,
424 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
426 Koha::Libraries->find( $full_suggestion->{branchcode} );
427 $toaddress = $library->inbound_email_address;
429 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
430 $toaddress = C4::Context->preference('ReplytoDefault')
431 || C4::Context->preference('KohaAdminEmailAddress');
435 C4::Context->preference($emailpurchasesuggestions)
436 || C4::Context->preference('ReplytoDefault')
437 || C4::Context->preference('KohaAdminEmailAddress');
440 C4::Letters::EnqueueLetter(
443 borrowernumber => $full_suggestion->{suggestedby},
444 suggestionid => $full_suggestion->{suggestionid},
445 to_address => $toaddress,
446 message_transport_type => 'email',
448 ) or warn "can't enqueue letter $letter";
452 return $suggestion_id;
457 &ModSuggestion($suggestion)
459 Modify the suggestion according to the hash passed by ref.
460 The hash HAS to contain suggestionid
461 Data not defined is not updated unless it is a note or sort1
462 Send a mail to notify the user that did the suggestion.
464 Note that there is no function to modify a suggestion.
469 my ($suggestion) = @_;
470 return unless( $suggestion and defined($suggestion->{suggestionid}) );
472 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
473 eval { # FIXME Must raise an exception instead
474 $suggestion_object->set($suggestion)->store;
478 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
480 # fetch the entire updated suggestion so that we can populate the letter
481 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
483 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
485 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
488 my $letter = C4::Letters::GetPreparedLetter(
489 module => 'suggestions',
490 letter_code => $full_suggestion->{STATUS},
491 branchcode => $full_suggestion->{branchcode},
492 lang => $patron->lang,
494 'branches' => $full_suggestion->{branchcode},
495 'borrowers' => $full_suggestion->{suggestedby},
496 'suggestions' => $full_suggestion,
497 'biblio' => $full_suggestion->{biblionumber},
502 C4::Letters::EnqueueLetter(
505 borrowernumber => $full_suggestion->{suggestedby},
506 suggestionid => $full_suggestion->{suggestionid},
507 LibraryName => C4::Context->preference("LibraryName"),
508 message_transport_type => $transport,
510 ) or warn "can't enqueue letter $letter";
513 return 1; # No useful if the exception is raised earlier
516 =head2 ConnectSuggestionAndBiblio
518 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
520 connect a suggestion to an existing biblio
524 sub ConnectSuggestionAndBiblio {
525 my ( $suggestionid, $biblionumber ) = @_;
526 my $dbh = C4::Context->dbh;
532 my $sth = $dbh->prepare($query);
533 $sth->execute( $biblionumber, $suggestionid );
538 &DelSuggestion($borrowernumber,$ordernumber)
540 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
545 my ( $borrowernumber, $suggestionid, $type ) = @_;
546 my $dbh = C4::Context->dbh;
548 # check that the suggestion comes from the suggestor
554 my $sth = $dbh->prepare($query);
555 $sth->execute($suggestionid);
556 my ($suggestedby) = $sth->fetchrow;
557 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
559 DELETE FROM suggestions
562 $sth = $dbh->prepare($queryDelete);
563 my $suggestiondeleted = $sth->execute($suggestionid);
564 return $suggestiondeleted;
568 =head2 DelSuggestionsOlderThan
569 &DelSuggestionsOlderThan($days)
571 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
572 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
576 sub DelSuggestionsOlderThan {
578 return unless $days && $days > 0;
579 my $dbh = C4::Context->dbh;
580 my $sth = $dbh->prepare(
582 DELETE FROM suggestions
583 WHERE STATUS<>'ASKED'
584 AND date < ADDDATE(NOW(), ?)
587 $sth->execute("-$days");
590 sub GetUnprocessedSuggestions {
591 my ( $number_of_days_since_the_last_modification ) = @_;
593 $number_of_days_since_the_last_modification ||= 0;
595 my $dbh = C4::Context->dbh;
597 my $s = $dbh->selectall_arrayref(q|
600 WHERE STATUS = 'ASKED'
601 AND budgetid IS NOT NULL
602 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
603 |, { Slice => {} }, $number_of_days_since_the_last_modification );
607 =head2 MarcRecordFromNewSuggestion
609 $record = MarcRecordFromNewSuggestion ( $suggestion )
611 This function build a marc record object from a suggestion
615 sub MarcRecordFromNewSuggestion {
616 my ($suggestion) = @_;
617 my $record = MARC::Record->new();
619 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
620 $record->append_fields(
621 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
624 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
625 if ($record->field( $author_tag )) {
626 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
629 $record->append_fields(
630 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
634 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
635 if ($record->field( $it_tag )) {
636 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
639 $record->append_fields(
640 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
653 Koha Development Team <http://koha-community.org/>