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
40 GetSuggestionFromBiblionumber
41 GetSuggestionInfoFromBiblionumber
47 DelSuggestionsOlderThan
48 GetUnprocessedSuggestions
49 MarcRecordFromNewSuggestion
54 C4::Suggestions - Some useful functions for dealings with aqorders.
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, they 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"
77 =head2 SearchSuggestion
79 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
81 searches for a suggestion
84 C<\@array> : the aqorders found. Array of hash.
85 Note the status is stored twice :
87 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
91 sub SearchSuggestion {
92 my ($suggestion) = @_;
93 my $dbh = C4::Context->dbh;
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 U3.surname AS surnamelastmodificationby,
114 U3.firstname AS firstnamelastmodificationby,
115 BU.budget_name AS budget_name
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 LEFT JOIN borrowers AS U3 ON lastmodificationby=U3.borrowernumber
124 LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
129 # filter on biblio informations
131 qw( title author isbn publishercode copyrightdate collectiontitle ))
133 if ( $suggestion->{$field} ) {
134 push @sql_params, '%' . $suggestion->{$field} . '%';
135 push @query, qq{ AND suggestions.$field LIKE ? };
139 # filter on user branch
140 if ( C4::Context->preference('IndependentBranches')
141 && !C4::Context->IsSuperLibrarian() )
143 # If IndependentBranches is set and the logged in user is not superlibrarian
144 # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
145 my $userenv = C4::Context->userenv;
148 push @sql_params, $$userenv{branch};
150 AND (suggestions.branchcode=? OR suggestions.branchcode='')
155 elsif (defined $suggestion->{branchcode}
156 && $suggestion->{branchcode}
157 && $suggestion->{branchcode} ne '__ANY__' )
159 # If IndependentBranches is not set OR the logged in user is not superlibrarian
160 # AND the branchcode filter is passed and not '__ANY__'
161 # Then we want to filter using this parameter
162 push @sql_params, $suggestion->{branchcode};
163 push @query, qq{ AND suggestions.branchcode=? };
166 # filter on nillable fields
168 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
171 if ( exists $suggestion->{$field}
172 and defined $suggestion->{$field}
173 and $suggestion->{$field} ne '__ANY__'
175 $suggestion->{$field} ne q||
176 or $field eq 'STATUS'
179 if ( $suggestion->{$field} eq '__NONE__' ) {
180 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
183 push @sql_params, $suggestion->{$field};
184 push @query, qq{ AND suggestions.$field = ? };
189 # filter on date fields
190 my $dtf = Koha::Database->new->schema->storage->datetime_parser;
191 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
192 my $from = $field . "_from";
193 my $to = $field . "_to";
195 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
197 $to_dt = eval { dt_from_string( $suggestion->{$to} ) } if ( $suggestion->{$to} );
199 push @query, qq{ AND suggestions.$field >= ?};
200 push @sql_params, $dtf->format_date($from_dt);
203 push @query, qq{ AND suggestions.$field <= ?};
204 push @sql_params, $dtf->format_date($to_dt);
208 # By default do not search for archived suggestions
209 unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
210 push @query, q{ AND suggestions.archived = 0 };
213 $debug && warn "@query";
214 my $sth = $dbh->prepare("@query");
215 $sth->execute(@sql_params);
218 # add status as field
219 while ( my $data = $sth->fetchrow_hashref ) {
220 $data->{ $data->{STATUS} } = 1;
221 push( @results, $data );
224 return ( \@results );
229 \%sth = &GetSuggestion($suggestionid)
231 this function get the detail of the suggestion $suggestionid (input arg)
234 the result of the SQL query as a hash : $sth->fetchrow_hashref.
239 my ($suggestionid) = @_;
240 my $dbh = C4::Context->dbh;
246 my $sth = $dbh->prepare($query);
247 $sth->execute($suggestionid);
248 return ( $sth->fetchrow_hashref );
251 =head2 GetSuggestionFromBiblionumber
253 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
255 Get a suggestion from it's biblionumber.
258 the id of the suggestion which is related to the biblionumber given on input args.
262 sub GetSuggestionFromBiblionumber {
263 my ($biblionumber) = @_;
267 WHERE biblionumber=? LIMIT 1
269 my $dbh = C4::Context->dbh;
270 my $sth = $dbh->prepare($query);
271 $sth->execute($biblionumber);
272 my ($suggestionid) = $sth->fetchrow;
273 return $suggestionid;
276 =head2 GetSuggestionInfoFromBiblionumber
278 Get a suggestion and borrower's informations from it's biblionumber.
281 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
285 sub GetSuggestionInfoFromBiblionumber {
286 my ($biblionumber) = @_;
288 SELECT suggestions.*,
289 U1.surname AS surnamesuggestedby,
290 U1.firstname AS firstnamesuggestedby,
291 U1.borrowernumber AS borrnumsuggestedby
293 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
297 my $dbh = C4::Context->dbh;
298 my $sth = $dbh->prepare($query);
299 $sth->execute($biblionumber);
300 return $sth->fetchrow_hashref;
303 =head2 GetSuggestionInfo
305 Get a suggestion and borrower's informations from it's suggestionid
308 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
312 sub GetSuggestionInfo {
313 my ($suggestionid) = @_;
315 SELECT suggestions.*,
316 U1.surname AS surnamesuggestedby,
317 U1.firstname AS firstnamesuggestedby,
318 U1.borrowernumber AS borrnumsuggestedby
320 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
324 my $dbh = C4::Context->dbh;
325 my $sth = $dbh->prepare($query);
326 $sth->execute($suggestionid);
327 return $sth->fetchrow_hashref;
330 =head2 GetSuggestionByStatus
332 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
334 Get a suggestion from it's status
337 all the suggestion with C<$status>
341 sub GetSuggestionByStatus {
343 my $branchcode = shift;
344 my $dbh = C4::Context->dbh;
345 my @sql_params = ($status);
347 SELECT suggestions.*,
348 U1.surname AS surnamesuggestedby,
349 U1.firstname AS firstnamesuggestedby,
350 U1.branchcode AS branchcodesuggestedby,
351 B1.branchname AS branchnamesuggestedby,
352 U1.borrowernumber AS borrnumsuggestedby,
353 U1.categorycode AS categorycodesuggestedby,
354 C1.description AS categorydescriptionsuggestedby,
355 U2.surname AS surnamemanagedby,
356 U2.firstname AS firstnamemanagedby,
357 U2.borrowernumber AS borrnummanagedby
359 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
360 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
361 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
362 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
364 ORDER BY suggestionid
368 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
369 my $userenv = C4::Context->userenv;
371 unless ( C4::Context->IsSuperLibrarian() ) {
372 push @sql_params, $userenv->{branch};
373 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
377 push @sql_params, $branchcode;
378 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
382 my $sth = $dbh->prepare($query);
383 $sth->execute(@sql_params);
385 $results = $sth->fetchall_arrayref( {} );
392 &NewSuggestion($suggestion);
394 Insert a new suggestion on database with value given on input arg.
399 my ($suggestion) = @_;
401 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
403 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
405 delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
407 my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
408 my $suggestion_id = $suggestion_object->suggestionid;
410 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
411 if ($emailpurchasesuggestions) {
412 my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
414 my $letter = C4::Letters::GetPreparedLetter(
415 module => 'suggestions',
416 letter_code => 'NEW_SUGGESTION',
418 'branches' => $full_suggestion->{branchcode},
419 'borrowers' => $full_suggestion->{suggestedby},
420 'suggestions' => $full_suggestion,
426 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
428 Koha::Libraries->find( $full_suggestion->{branchcode} );
429 $toaddress = $library->inbound_email_address;
431 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
432 $toaddress = C4::Context->preference('ReplytoDefault')
433 || C4::Context->preference('KohaAdminEmailAddress');
437 C4::Context->preference($emailpurchasesuggestions)
438 || C4::Context->preference('ReplytoDefault')
439 || C4::Context->preference('KohaAdminEmailAddress');
442 C4::Letters::EnqueueLetter(
445 borrowernumber => $full_suggestion->{suggestedby},
446 suggestionid => $full_suggestion->{suggestionid},
447 to_address => $toaddress,
448 message_transport_type => 'email',
450 ) or warn "can't enqueue letter $letter";
454 return $suggestion_id;
459 &ModSuggestion($suggestion)
461 Modify the suggestion according to the hash passed by ref.
462 The hash HAS to contain suggestionid
463 Data not defined is not updated unless it is a note or sort1
464 Send a mail to notify the user that did the suggestion.
466 Note that there is no function to modify a suggestion.
471 my ($suggestion) = @_;
472 return unless( $suggestion and defined($suggestion->{suggestionid}) );
474 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
475 eval { # FIXME Must raise an exception instead
476 $suggestion_object->set($suggestion)->store;
480 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
482 # fetch the entire updated suggestion so that we can populate the letter
483 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
485 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
487 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
490 my $letter = C4::Letters::GetPreparedLetter(
491 module => 'suggestions',
492 letter_code => $full_suggestion->{STATUS},
493 branchcode => $full_suggestion->{branchcode},
494 lang => $patron->lang,
496 'branches' => $full_suggestion->{branchcode},
497 'borrowers' => $full_suggestion->{suggestedby},
498 'suggestions' => $full_suggestion,
499 'biblio' => $full_suggestion->{biblionumber},
504 C4::Letters::EnqueueLetter(
507 borrowernumber => $full_suggestion->{suggestedby},
508 suggestionid => $full_suggestion->{suggestionid},
509 LibraryName => C4::Context->preference("LibraryName"),
510 message_transport_type => $transport,
512 ) or warn "can't enqueue letter $letter";
515 return 1; # No useful if the exception is raised earlier
518 =head2 ConnectSuggestionAndBiblio
520 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
522 connect a suggestion to an existing biblio
526 sub ConnectSuggestionAndBiblio {
527 my ( $suggestionid, $biblionumber ) = @_;
528 my $dbh = C4::Context->dbh;
534 my $sth = $dbh->prepare($query);
535 $sth->execute( $biblionumber, $suggestionid );
540 &DelSuggestion($borrowernumber,$ordernumber)
542 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
547 my ( $borrowernumber, $suggestionid, $type ) = @_;
548 my $dbh = C4::Context->dbh;
550 # check that the suggestion comes from the suggestor
556 my $sth = $dbh->prepare($query);
557 $sth->execute($suggestionid);
558 my ($suggestedby) = $sth->fetchrow;
559 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
561 DELETE FROM suggestions
564 $sth = $dbh->prepare($queryDelete);
565 my $suggestiondeleted = $sth->execute($suggestionid);
566 return $suggestiondeleted;
570 =head2 DelSuggestionsOlderThan
571 &DelSuggestionsOlderThan($days)
573 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
574 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
578 sub DelSuggestionsOlderThan {
580 return unless $days && $days > 0;
581 my $dbh = C4::Context->dbh;
582 my $sth = $dbh->prepare(
584 DELETE FROM suggestions
585 WHERE STATUS<>'ASKED'
586 AND date < ADDDATE(NOW(), ?)
589 $sth->execute("-$days");
592 sub GetUnprocessedSuggestions {
593 my ( $number_of_days_since_the_last_modification ) = @_;
595 $number_of_days_since_the_last_modification ||= 0;
597 my $dbh = C4::Context->dbh;
599 my $s = $dbh->selectall_arrayref(q|
602 WHERE STATUS = 'ASKED'
603 AND budgetid IS NOT NULL
604 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
605 |, { Slice => {} }, $number_of_days_since_the_last_modification );
609 =head2 MarcRecordFromNewSuggestion
611 $record = MarcRecordFromNewSuggestion ( $suggestion )
613 This function build a marc record object from a suggestion
617 sub MarcRecordFromNewSuggestion {
618 my ($suggestion) = @_;
619 my $record = MARC::Record->new();
621 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
622 $record->append_fields(
623 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
626 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
627 if ($record->field( $author_tag )) {
628 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
631 $record->append_fields(
632 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
636 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
637 if ($record->field( $it_tag )) {
638 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
641 $record->append_fields(
642 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
655 Koha Development Team <http://koha-community.org/>