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 );
28 use Koha::DateUtils qw( dt_from_string );
29 use Koha::Suggestions;
31 use base qw(Exporter);
34 ConnectSuggestionAndBiblio
38 GetSuggestionFromBiblionumber
39 GetSuggestionInfoFromBiblionumber
45 DelSuggestionsOlderThan
46 GetUnprocessedSuggestions
47 MarcRecordFromNewSuggestion
52 C4::Suggestions - Some useful functions for dealings with aqorders.
60 The functions in this module deal with the aqorders in OPAC and in librarian interface
62 A suggestion is done in the OPAC. It has the status "ASKED"
64 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
66 When the book is ordered, the suggestion status becomes "ORDERED"
68 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
70 All aqorders of a borrower can be seen by the borrower itself.
71 Suggestions done by other borrowers can be seen when not "AVAILABLE"
75 =head2 SearchSuggestion
77 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
79 searches for a suggestion
82 C<\@array> : the aqorders found. Array of hash.
83 Note the status is stored twice :
85 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
89 sub SearchSuggestion {
90 my ($suggestion) = @_;
91 my $dbh = C4::Context->dbh;
96 U1.branchcode AS branchcodesuggestedby,
97 B1.branchname AS branchnamesuggestedby,
98 U1.surname AS surnamesuggestedby,
99 U1.firstname AS firstnamesuggestedby,
100 U1.cardnumber AS cardnumbersuggestedby,
101 U1.email AS emailsuggestedby,
102 U1.borrowernumber AS borrnumsuggestedby,
103 U1.categorycode AS categorycodesuggestedby,
104 C1.description AS categorydescriptionsuggestedby,
105 U2.surname AS surnamemanagedby,
106 U2.firstname AS firstnamemanagedby,
107 B2.branchname AS branchnamesuggestedby,
108 U2.email AS emailmanagedby,
109 U2.branchcode AS branchcodemanagedby,
110 U2.borrowernumber AS borrnummanagedby,
111 U3.surname AS surnamelastmodificationby,
112 U3.firstname AS firstnamelastmodificationby,
113 BU.budget_name AS budget_name
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 borrowers AS U3 ON lastmodificationby=U3.borrowernumber
122 LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
127 # filter on biblio informations
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 && !C4::Context->IsSuperLibrarian() )
141 # If IndependentBranches is set and the logged in user is not superlibrarian
142 # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
143 my $userenv = C4::Context->userenv;
146 push @sql_params, $$userenv{branch};
148 AND (suggestions.branchcode=? OR suggestions.branchcode='')
153 elsif (defined $suggestion->{branchcode}
154 && $suggestion->{branchcode}
155 && $suggestion->{branchcode} ne '__ANY__' )
157 # If IndependentBranches is not set OR the logged in user is not superlibrarian
158 # AND the branchcode filter is passed and not '__ANY__'
159 # Then we want to filter using this parameter
160 push @sql_params, $suggestion->{branchcode};
161 push @query, qq{ AND suggestions.branchcode=? };
164 # filter on nillable fields
166 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
169 if ( exists $suggestion->{$field}
170 and defined $suggestion->{$field}
171 and $suggestion->{$field} ne '__ANY__'
173 $suggestion->{$field} ne q||
174 or $field eq 'STATUS'
177 if ( $suggestion->{$field} eq '__NONE__' ) {
178 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
181 push @sql_params, $suggestion->{$field};
182 push @query, qq{ AND suggestions.$field = ? };
187 # filter on date fields
188 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
189 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
190 my $from = $field . "_from";
191 my $to = $field . "_to";
193 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
195 $to_dt = eval { dt_from_string( $suggestion->{$to} ) } if ( $suggestion->{$to} );
197 push @query, qq{ AND suggestions.$field >= ?};
198 push @sql_params, $dtf->format_date($from_dt);
201 push @query, qq{ AND suggestions.$field <= ?};
202 push @sql_params, $dtf->format_date($to_dt);
206 # By default do not search for archived suggestions
207 unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
208 push @query, q{ AND suggestions.archived = 0 };
211 my $sth = $dbh->prepare("@query");
212 $sth->execute(@sql_params);
215 # add status as field
216 while ( my $data = $sth->fetchrow_hashref ) {
217 $data->{ $data->{STATUS} } = 1;
218 push( @results, $data );
221 return ( \@results );
226 \%sth = &GetSuggestion($suggestionid)
228 this function get the detail of the suggestion $suggestionid (input arg)
231 the result of the SQL query as a hash : $sth->fetchrow_hashref.
236 my ($suggestionid) = @_;
237 my $dbh = C4::Context->dbh;
243 my $sth = $dbh->prepare($query);
244 $sth->execute($suggestionid);
245 return ( $sth->fetchrow_hashref );
248 =head2 GetSuggestionFromBiblionumber
250 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
252 Get a suggestion from it's biblionumber.
255 the id of the suggestion which is related to the biblionumber given on input args.
259 sub GetSuggestionFromBiblionumber {
260 my ($biblionumber) = @_;
264 WHERE biblionumber=? LIMIT 1
266 my $dbh = C4::Context->dbh;
267 my $sth = $dbh->prepare($query);
268 $sth->execute($biblionumber);
269 my ($suggestionid) = $sth->fetchrow;
270 return $suggestionid;
273 =head2 GetSuggestionInfoFromBiblionumber
275 Get a suggestion and borrower's informations from it's biblionumber.
278 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
282 sub GetSuggestionInfoFromBiblionumber {
283 my ($biblionumber) = @_;
285 SELECT suggestions.*,
286 U1.surname AS surnamesuggestedby,
287 U1.firstname AS firstnamesuggestedby,
288 U1.borrowernumber AS borrnumsuggestedby
290 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
294 my $dbh = C4::Context->dbh;
295 my $sth = $dbh->prepare($query);
296 $sth->execute($biblionumber);
297 return $sth->fetchrow_hashref;
300 =head2 GetSuggestionInfo
302 Get a suggestion and borrower's informations from it's suggestionid
305 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
309 sub GetSuggestionInfo {
310 my ($suggestionid) = @_;
312 SELECT suggestions.*,
313 U1.surname AS surnamesuggestedby,
314 U1.firstname AS firstnamesuggestedby,
315 U1.borrowernumber AS borrnumsuggestedby
317 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
321 my $dbh = C4::Context->dbh;
322 my $sth = $dbh->prepare($query);
323 $sth->execute($suggestionid);
324 return $sth->fetchrow_hashref;
327 =head2 GetSuggestionByStatus
329 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
331 Get a suggestion from it's status
334 all the suggestion with C<$status>
338 sub GetSuggestionByStatus {
340 my $branchcode = shift;
341 my $dbh = C4::Context->dbh;
342 my @sql_params = ($status);
344 SELECT suggestions.*,
345 U1.surname AS surnamesuggestedby,
346 U1.firstname AS firstnamesuggestedby,
347 U1.branchcode AS branchcodesuggestedby,
348 B1.branchname AS branchnamesuggestedby,
349 U1.borrowernumber AS borrnumsuggestedby,
350 U1.categorycode AS categorycodesuggestedby,
351 C1.description AS categorydescriptionsuggestedby,
352 U2.surname AS surnamemanagedby,
353 U2.firstname AS firstnamemanagedby,
354 U2.borrowernumber AS borrnummanagedby
356 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
357 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
358 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
359 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
361 ORDER BY suggestionid
365 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
366 my $userenv = C4::Context->userenv;
368 unless ( C4::Context->IsSuperLibrarian() ) {
369 push @sql_params, $userenv->{branch};
370 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
374 push @sql_params, $branchcode;
375 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
379 my $sth = $dbh->prepare($query);
380 $sth->execute(@sql_params);
382 $results = $sth->fetchall_arrayref( {} );
389 &NewSuggestion($suggestion);
391 Insert a new suggestion on database with value given on input arg.
396 my ($suggestion) = @_;
398 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
400 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
402 delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
404 my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
405 my $suggestion_id = $suggestion_object->suggestionid;
407 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
408 if ($emailpurchasesuggestions) {
409 my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
411 my $letter = C4::Letters::GetPreparedLetter(
412 module => 'suggestions',
413 letter_code => 'NEW_SUGGESTION',
415 'branches' => $full_suggestion->{branchcode},
416 'borrowers' => $full_suggestion->{suggestedby},
417 'suggestions' => $full_suggestion,
423 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
425 Koha::Libraries->find( $full_suggestion->{branchcode} );
426 $toaddress = $library->inbound_email_address;
428 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
429 $toaddress = C4::Context->preference('ReplytoDefault')
430 || C4::Context->preference('KohaAdminEmailAddress');
434 C4::Context->preference($emailpurchasesuggestions)
435 || C4::Context->preference('ReplytoDefault')
436 || C4::Context->preference('KohaAdminEmailAddress');
439 C4::Letters::EnqueueLetter(
442 borrowernumber => $full_suggestion->{suggestedby},
443 suggestionid => $full_suggestion->{suggestionid},
444 to_address => $toaddress,
445 message_transport_type => 'email',
447 ) or warn "can't enqueue letter $letter";
451 return $suggestion_id;
456 &ModSuggestion($suggestion)
458 Modify the suggestion according to the hash passed by ref.
459 The hash HAS to contain suggestionid
460 Data not defined is not updated unless it is a note or sort1
461 Send a mail to notify the user that did the suggestion.
463 Note that there is no function to modify a suggestion.
468 my ($suggestion) = @_;
469 return unless( $suggestion and defined($suggestion->{suggestionid}) );
471 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
472 eval { # FIXME Must raise an exception instead
473 $suggestion_object->set($suggestion)->store;
477 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
479 # fetch the entire updated suggestion so that we can populate the letter
480 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
482 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
484 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
487 my $letter = C4::Letters::GetPreparedLetter(
488 module => 'suggestions',
489 letter_code => $full_suggestion->{STATUS},
490 branchcode => $full_suggestion->{branchcode},
491 lang => $patron->lang,
493 'branches' => $full_suggestion->{branchcode},
494 'borrowers' => $full_suggestion->{suggestedby},
495 'suggestions' => $full_suggestion,
496 'biblio' => $full_suggestion->{biblionumber},
501 C4::Letters::EnqueueLetter(
504 borrowernumber => $full_suggestion->{suggestedby},
505 suggestionid => $full_suggestion->{suggestionid},
506 LibraryName => C4::Context->preference("LibraryName"),
507 message_transport_type => $transport,
509 ) or warn "can't enqueue letter $letter";
512 return 1; # No useful if the exception is raised earlier
515 =head2 ConnectSuggestionAndBiblio
517 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
519 connect a suggestion to an existing biblio
523 sub ConnectSuggestionAndBiblio {
524 my ( $suggestionid, $biblionumber ) = @_;
525 my $dbh = C4::Context->dbh;
531 my $sth = $dbh->prepare($query);
532 $sth->execute( $biblionumber, $suggestionid );
537 &DelSuggestion($borrowernumber,$ordernumber)
539 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
544 my ( $borrowernumber, $suggestionid, $type ) = @_;
545 my $dbh = C4::Context->dbh;
547 # check that the suggestion comes from the suggestor
553 my $sth = $dbh->prepare($query);
554 $sth->execute($suggestionid);
555 my ($suggestedby) = $sth->fetchrow;
556 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
558 DELETE FROM suggestions
561 $sth = $dbh->prepare($queryDelete);
562 my $suggestiondeleted = $sth->execute($suggestionid);
563 return $suggestiondeleted;
567 =head2 DelSuggestionsOlderThan
568 &DelSuggestionsOlderThan($days)
570 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
571 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
575 sub DelSuggestionsOlderThan {
577 return unless $days && $days > 0;
578 my $dbh = C4::Context->dbh;
579 my $sth = $dbh->prepare(
581 DELETE FROM suggestions
582 WHERE STATUS<>'ASKED'
583 AND date < ADDDATE(NOW(), ?)
586 $sth->execute("-$days");
589 sub GetUnprocessedSuggestions {
590 my ( $number_of_days_since_the_last_modification ) = @_;
592 $number_of_days_since_the_last_modification ||= 0;
594 my $dbh = C4::Context->dbh;
596 my $s = $dbh->selectall_arrayref(q|
599 WHERE STATUS = 'ASKED'
600 AND budgetid IS NOT NULL
601 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
602 |, { Slice => {} }, $number_of_days_since_the_last_modification );
606 =head2 MarcRecordFromNewSuggestion
608 $record = MarcRecordFromNewSuggestion ( $suggestion )
610 This function build a marc record object from a suggestion
614 sub MarcRecordFromNewSuggestion {
615 my ($suggestion) = @_;
616 my $record = MARC::Record->new();
618 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
619 $record->append_fields(
620 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
623 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
624 if ($record->field( $author_tag )) {
625 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
628 $record->append_fields(
629 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
633 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
634 if ($record->field( $it_tag )) {
635 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
638 $record->append_fields(
639 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
652 Koha Development Team <http://koha-community.org/>