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
44 DelSuggestionsOlderThan
45 GetUnprocessedSuggestions
46 MarcRecordFromNewSuggestion
51 C4::Suggestions - Some useful functions for dealings with aqorders.
59 The functions in this module deal with the aqorders in OPAC and in librarian interface
61 A suggestion is done in the OPAC. It has the status "ASKED"
63 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
65 When the book is ordered, the suggestion status becomes "ORDERED"
67 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
69 All aqorders of a borrower can be seen by the borrower itself.
70 Suggestions done by other borrowers can be seen when not "AVAILABLE"
76 \%sth = &GetSuggestion($suggestionid)
78 this function get the detail of the suggestion $suggestionid (input arg)
81 the result of the SQL query as a hash : $sth->fetchrow_hashref.
86 my ($suggestionid) = @_;
87 my $dbh = C4::Context->dbh;
93 my $sth = $dbh->prepare($query);
94 $sth->execute($suggestionid);
95 return ( $sth->fetchrow_hashref );
98 =head2 GetSuggestionFromBiblionumber
100 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
102 Get a suggestion from it's biblionumber.
105 the id of the suggestion which is related to the biblionumber given on input args.
109 sub GetSuggestionFromBiblionumber {
110 my ($biblionumber) = @_;
114 WHERE biblionumber=? LIMIT 1
116 my $dbh = C4::Context->dbh;
117 my $sth = $dbh->prepare($query);
118 $sth->execute($biblionumber);
119 my ($suggestionid) = $sth->fetchrow;
120 return $suggestionid;
123 =head2 GetSuggestionInfoFromBiblionumber
125 Get a suggestion and borrower's informations from it's biblionumber.
128 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
132 sub GetSuggestionInfoFromBiblionumber {
133 my ($biblionumber) = @_;
135 SELECT suggestions.*,
136 U1.surname AS surnamesuggestedby,
137 U1.firstname AS firstnamesuggestedby,
138 U1.borrowernumber AS borrnumsuggestedby
140 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
144 my $dbh = C4::Context->dbh;
145 my $sth = $dbh->prepare($query);
146 $sth->execute($biblionumber);
147 return $sth->fetchrow_hashref;
150 =head2 GetSuggestionInfo
152 Get a suggestion and borrower's informations from it's suggestionid
155 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
159 sub GetSuggestionInfo {
160 my ($suggestionid) = @_;
162 SELECT suggestions.*,
163 U1.surname AS surnamesuggestedby,
164 U1.firstname AS firstnamesuggestedby,
165 U1.borrowernumber AS borrnumsuggestedby
167 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
171 my $dbh = C4::Context->dbh;
172 my $sth = $dbh->prepare($query);
173 $sth->execute($suggestionid);
174 return $sth->fetchrow_hashref;
177 =head2 GetSuggestionByStatus
179 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
181 Get a suggestion from it's status
184 all the suggestion with C<$status>
188 sub GetSuggestionByStatus {
190 my $branchcode = shift;
191 my $dbh = C4::Context->dbh;
192 my @sql_params = ($status);
194 SELECT suggestions.*,
195 U1.surname AS surnamesuggestedby,
196 U1.firstname AS firstnamesuggestedby,
197 U1.branchcode AS branchcodesuggestedby,
198 B1.branchname AS branchnamesuggestedby,
199 U1.borrowernumber AS borrnumsuggestedby,
200 U1.categorycode AS categorycodesuggestedby,
201 C1.description AS categorydescriptionsuggestedby,
202 U2.surname AS surnamemanagedby,
203 U2.firstname AS firstnamemanagedby,
204 U2.borrowernumber AS borrnummanagedby
206 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
207 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
208 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
209 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
211 ORDER BY suggestionid
215 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
216 my $userenv = C4::Context->userenv;
218 unless ( C4::Context->IsSuperLibrarian() ) {
219 push @sql_params, $userenv->{branch};
220 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
224 push @sql_params, $branchcode;
225 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
229 my $sth = $dbh->prepare($query);
230 $sth->execute(@sql_params);
232 $results = $sth->fetchall_arrayref( {} );
239 &NewSuggestion($suggestion);
241 Insert a new suggestion on database with value given on input arg.
246 my ($suggestion) = @_;
248 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
250 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
252 delete $suggestion->{branchcode}
253 if defined $suggestion->{branchcode} and $suggestion->{branchcode} eq '';
255 my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
256 my $suggestion_id = $suggestion_object->suggestionid;
258 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
259 if ($emailpurchasesuggestions) {
260 my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
262 my $letter = C4::Letters::GetPreparedLetter(
263 module => 'suggestions',
264 letter_code => 'NEW_SUGGESTION',
266 'branches' => $full_suggestion->{branchcode},
267 'borrowers' => $full_suggestion->{suggestedby},
268 'suggestions' => $full_suggestion,
274 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
276 Koha::Libraries->find( $full_suggestion->{branchcode} );
277 $toaddress = $library->inbound_email_address;
279 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
280 $toaddress = C4::Context->preference('ReplytoDefault')
281 || C4::Context->preference('KohaAdminEmailAddress');
285 C4::Context->preference($emailpurchasesuggestions)
286 || C4::Context->preference('ReplytoDefault')
287 || C4::Context->preference('KohaAdminEmailAddress');
290 C4::Letters::EnqueueLetter(
293 borrowernumber => $full_suggestion->{suggestedby},
294 suggestionid => $full_suggestion->{suggestionid},
295 to_address => $toaddress,
296 message_transport_type => 'email',
298 ) or warn "can't enqueue letter $letter";
302 return $suggestion_id;
307 &ModSuggestion($suggestion)
309 Modify the suggestion according to the hash passed by ref.
310 The hash HAS to contain suggestionid
311 Data not defined is not updated unless it is a note or sort1
312 Send a mail to notify the user that did the suggestion.
314 Note that there is no function to modify a suggestion.
319 my ($suggestion) = @_;
320 return unless( $suggestion and defined($suggestion->{suggestionid}) );
322 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
323 eval { # FIXME Must raise an exception instead
324 $suggestion_object->set($suggestion)->store;
328 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
330 # fetch the entire updated suggestion so that we can populate the letter
331 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
333 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
335 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
338 my $letter = C4::Letters::GetPreparedLetter(
339 module => 'suggestions',
340 letter_code => $full_suggestion->{STATUS},
341 branchcode => $full_suggestion->{branchcode},
342 lang => $patron->lang,
344 'branches' => $full_suggestion->{branchcode},
345 'borrowers' => $full_suggestion->{suggestedby},
346 'suggestions' => $full_suggestion,
347 'biblio' => $full_suggestion->{biblionumber},
352 C4::Letters::EnqueueLetter(
355 borrowernumber => $full_suggestion->{suggestedby},
356 suggestionid => $full_suggestion->{suggestionid},
357 LibraryName => C4::Context->preference("LibraryName"),
358 message_transport_type => $transport,
360 ) or warn "can't enqueue letter $letter";
363 return 1; # No useful if the exception is raised earlier
366 =head2 ConnectSuggestionAndBiblio
368 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
370 connect a suggestion to an existing biblio
374 sub ConnectSuggestionAndBiblio {
375 my ( $suggestionid, $biblionumber ) = @_;
376 my $dbh = C4::Context->dbh;
382 my $sth = $dbh->prepare($query);
383 $sth->execute( $biblionumber, $suggestionid );
388 &DelSuggestion($borrowernumber,$ordernumber)
390 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
395 my ( $borrowernumber, $suggestionid, $type ) = @_;
396 my $dbh = C4::Context->dbh;
398 # check that the suggestion comes from the suggestor
404 my $sth = $dbh->prepare($query);
405 $sth->execute($suggestionid);
406 my ($suggestedby) = $sth->fetchrow;
408 $borrowernumber //= '';
409 if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
411 DELETE FROM suggestions
414 $sth = $dbh->prepare($queryDelete);
415 my $suggestiondeleted = $sth->execute($suggestionid);
416 return $suggestiondeleted;
420 =head2 DelSuggestionsOlderThan
421 &DelSuggestionsOlderThan($days)
423 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
424 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
428 sub DelSuggestionsOlderThan {
430 return unless $days && $days > 0;
431 my $dbh = C4::Context->dbh;
432 my $sth = $dbh->prepare(
434 DELETE FROM suggestions
435 WHERE STATUS<>'ASKED'
436 AND manageddate < ADDDATE(NOW(), ?)
439 $sth->execute("-$days");
442 sub GetUnprocessedSuggestions {
443 my ( $number_of_days_since_the_last_modification ) = @_;
445 $number_of_days_since_the_last_modification ||= 0;
447 my $dbh = C4::Context->dbh;
449 my $s = $dbh->selectall_arrayref(q|
452 WHERE STATUS = 'ASKED'
453 AND budgetid IS NOT NULL
454 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
455 |, { Slice => {} }, $number_of_days_since_the_last_modification );
459 =head2 MarcRecordFromNewSuggestion
461 $record = MarcRecordFromNewSuggestion ( $suggestion )
463 This function build a marc record object from a suggestion
467 sub MarcRecordFromNewSuggestion {
468 my ($suggestion) = @_;
469 my $record = MARC::Record->new();
471 if (my $isbn = $suggestion->{isbn}) {
472 for my $field (qw(biblioitems.isbn biblioitems.issn)) {
473 my ($tag, $subfield) = GetMarcFromKohaField($field);
474 $record->append_fields(
475 MARC::Field->new($tag, ' ', ' ', $subfield => $isbn)
480 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title');
481 $record->append_fields(
482 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
485 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author');
486 if ($record->field( $author_tag )) {
487 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
490 $record->append_fields(
491 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
496 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype');
497 if ($record->field( $it_tag )) {
498 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
501 $record->append_fields(
502 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
515 Koha Development Team <http://koha-community.org/>