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 staff 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( {} );
238 &ModSuggestion($suggestion)
240 Modify the suggestion according to the hash passed by ref.
241 The hash HAS to contain suggestionid
242 Data not defined is not updated unless it is a note or sort1
243 Send a mail to notify the user that did the suggestion.
245 Note that there is no function to modify a suggestion.
250 my ($suggestion) = @_;
251 return unless( $suggestion and defined($suggestion->{suggestionid}) );
253 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
254 eval { # FIXME Must raise an exception instead
255 $suggestion_object->set($suggestion)->store;
259 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
261 # fetch the entire updated suggestion so that we can populate the letter
262 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
264 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
266 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
269 my $letter = C4::Letters::GetPreparedLetter(
270 module => 'suggestions',
271 letter_code => $full_suggestion->{STATUS},
272 branchcode => $full_suggestion->{branchcode},
273 lang => $patron->lang,
275 'branches' => $full_suggestion->{branchcode},
276 'borrowers' => $full_suggestion->{suggestedby},
277 'suggestions' => $full_suggestion,
278 'biblio' => $full_suggestion->{biblionumber},
283 C4::Letters::EnqueueLetter(
286 borrowernumber => $full_suggestion->{suggestedby},
287 suggestionid => $full_suggestion->{suggestionid},
288 LibraryName => C4::Context->preference("LibraryName"),
289 message_transport_type => $transport,
291 ) or warn "can't enqueue letter $letter";
294 return 1; # No useful if the exception is raised earlier
297 =head2 ConnectSuggestionAndBiblio
299 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
301 connect a suggestion to an existing biblio
305 sub ConnectSuggestionAndBiblio {
306 my ( $suggestionid, $biblionumber ) = @_;
307 my $dbh = C4::Context->dbh;
313 my $sth = $dbh->prepare($query);
314 $sth->execute( $biblionumber, $suggestionid );
319 &DelSuggestion($borrowernumber,$ordernumber)
321 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
326 my ( $borrowernumber, $suggestionid, $type ) = @_;
327 my $dbh = C4::Context->dbh;
329 # check that the suggestion comes from the suggestor
335 my $sth = $dbh->prepare($query);
336 $sth->execute($suggestionid);
337 my ($suggestedby) = $sth->fetchrow;
339 $borrowernumber //= '';
340 if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
342 DELETE FROM suggestions
345 $sth = $dbh->prepare($queryDelete);
346 my $suggestiondeleted = $sth->execute($suggestionid);
347 return $suggestiondeleted;
351 =head2 DelSuggestionsOlderThan
352 &DelSuggestionsOlderThan($days)
354 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
355 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
359 sub DelSuggestionsOlderThan {
361 return unless $days && $days > 0;
362 my $dbh = C4::Context->dbh;
363 my $sth = $dbh->prepare(
365 DELETE FROM suggestions
366 WHERE STATUS<>'ASKED'
367 AND manageddate < ADDDATE(NOW(), ?)
370 $sth->execute("-$days");
373 sub GetUnprocessedSuggestions {
374 my ( $number_of_days_since_the_last_modification ) = @_;
376 $number_of_days_since_the_last_modification ||= 0;
378 my $dbh = C4::Context->dbh;
380 my $s = $dbh->selectall_arrayref(q|
383 WHERE STATUS = 'ASKED'
384 AND budgetid IS NOT NULL
385 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
386 |, { Slice => {} }, $number_of_days_since_the_last_modification );
390 =head2 MarcRecordFromNewSuggestion
392 $record = MarcRecordFromNewSuggestion ( $suggestion )
394 This function build a marc record object from a suggestion
398 sub MarcRecordFromNewSuggestion {
399 my ($suggestion) = @_;
400 my $record = MARC::Record->new();
402 if (my $isbn = $suggestion->{isbn}) {
403 for my $field (qw(biblioitems.isbn biblioitems.issn)) {
404 my ($tag, $subfield) = GetMarcFromKohaField($field);
405 $record->append_fields(
406 MARC::Field->new($tag, ' ', ' ', $subfield => $isbn)
411 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title');
412 $record->append_fields(
413 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
416 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author');
417 if ($record->field( $author_tag )) {
418 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
421 $record->append_fields(
422 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
427 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype');
428 if ($record->field( $it_tag )) {
429 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
432 $record->append_fields(
433 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
446 Koha Development Team <http://koha-community.org/>