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} if $suggestion->{branchcode} eq '';
254 my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
255 my $suggestion_id = $suggestion_object->suggestionid;
257 my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
258 if ($emailpurchasesuggestions) {
259 my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
261 my $letter = C4::Letters::GetPreparedLetter(
262 module => 'suggestions',
263 letter_code => 'NEW_SUGGESTION',
265 'branches' => $full_suggestion->{branchcode},
266 'borrowers' => $full_suggestion->{suggestedby},
267 'suggestions' => $full_suggestion,
273 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
275 Koha::Libraries->find( $full_suggestion->{branchcode} );
276 $toaddress = $library->inbound_email_address;
278 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
279 $toaddress = C4::Context->preference('ReplytoDefault')
280 || C4::Context->preference('KohaAdminEmailAddress');
284 C4::Context->preference($emailpurchasesuggestions)
285 || C4::Context->preference('ReplytoDefault')
286 || C4::Context->preference('KohaAdminEmailAddress');
289 C4::Letters::EnqueueLetter(
292 borrowernumber => $full_suggestion->{suggestedby},
293 suggestionid => $full_suggestion->{suggestionid},
294 to_address => $toaddress,
295 message_transport_type => 'email',
297 ) or warn "can't enqueue letter $letter";
301 return $suggestion_id;
306 &ModSuggestion($suggestion)
308 Modify the suggestion according to the hash passed by ref.
309 The hash HAS to contain suggestionid
310 Data not defined is not updated unless it is a note or sort1
311 Send a mail to notify the user that did the suggestion.
313 Note that there is no function to modify a suggestion.
318 my ($suggestion) = @_;
319 return unless( $suggestion and defined($suggestion->{suggestionid}) );
321 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
322 eval { # FIXME Must raise an exception instead
323 $suggestion_object->set($suggestion)->store;
327 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
329 # fetch the entire updated suggestion so that we can populate the letter
330 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
332 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
334 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
337 my $letter = C4::Letters::GetPreparedLetter(
338 module => 'suggestions',
339 letter_code => $full_suggestion->{STATUS},
340 branchcode => $full_suggestion->{branchcode},
341 lang => $patron->lang,
343 'branches' => $full_suggestion->{branchcode},
344 'borrowers' => $full_suggestion->{suggestedby},
345 'suggestions' => $full_suggestion,
346 'biblio' => $full_suggestion->{biblionumber},
351 C4::Letters::EnqueueLetter(
354 borrowernumber => $full_suggestion->{suggestedby},
355 suggestionid => $full_suggestion->{suggestionid},
356 LibraryName => C4::Context->preference("LibraryName"),
357 message_transport_type => $transport,
359 ) or warn "can't enqueue letter $letter";
362 return 1; # No useful if the exception is raised earlier
365 =head2 ConnectSuggestionAndBiblio
367 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
369 connect a suggestion to an existing biblio
373 sub ConnectSuggestionAndBiblio {
374 my ( $suggestionid, $biblionumber ) = @_;
375 my $dbh = C4::Context->dbh;
381 my $sth = $dbh->prepare($query);
382 $sth->execute( $biblionumber, $suggestionid );
387 &DelSuggestion($borrowernumber,$ordernumber)
389 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
394 my ( $borrowernumber, $suggestionid, $type ) = @_;
395 my $dbh = C4::Context->dbh;
397 # check that the suggestion comes from the suggestor
403 my $sth = $dbh->prepare($query);
404 $sth->execute($suggestionid);
405 my ($suggestedby) = $sth->fetchrow;
406 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
408 DELETE FROM suggestions
411 $sth = $dbh->prepare($queryDelete);
412 my $suggestiondeleted = $sth->execute($suggestionid);
413 return $suggestiondeleted;
417 =head2 DelSuggestionsOlderThan
418 &DelSuggestionsOlderThan($days)
420 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
421 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
425 sub DelSuggestionsOlderThan {
427 return unless $days && $days > 0;
428 my $dbh = C4::Context->dbh;
429 my $sth = $dbh->prepare(
431 DELETE FROM suggestions
432 WHERE STATUS<>'ASKED'
433 AND manageddate < ADDDATE(NOW(), ?)
436 $sth->execute("-$days");
439 sub GetUnprocessedSuggestions {
440 my ( $number_of_days_since_the_last_modification ) = @_;
442 $number_of_days_since_the_last_modification ||= 0;
444 my $dbh = C4::Context->dbh;
446 my $s = $dbh->selectall_arrayref(q|
449 WHERE STATUS = 'ASKED'
450 AND budgetid IS NOT NULL
451 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
452 |, { Slice => {} }, $number_of_days_since_the_last_modification );
456 =head2 MarcRecordFromNewSuggestion
458 $record = MarcRecordFromNewSuggestion ( $suggestion )
460 This function build a marc record object from a suggestion
464 sub MarcRecordFromNewSuggestion {
465 my ($suggestion) = @_;
466 my $record = MARC::Record->new();
468 if (my $isbn = $suggestion->{isbn}) {
469 for my $field (qw(biblioitems.isbn biblioitems.issn)) {
470 my ($tag, $subfield) = GetMarcFromKohaField($field);
471 $record->append_fields(
472 MARC::Field->new($tag, ' ', ' ', $subfield => $isbn)
477 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title');
478 $record->append_fields(
479 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
482 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author');
483 if ($record->field( $author_tag )) {
484 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
487 $record->append_fields(
488 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
493 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype');
494 if ($record->field( $it_tag )) {
495 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
498 $record->append_fields(
499 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
512 Koha Development Team <http://koha-community.org/>