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
43 DelSuggestionsOlderThan
44 GetUnprocessedSuggestions
45 MarcRecordFromNewSuggestion
50 C4::Suggestions - Some useful functions for dealings with aqorders.
58 The functions in this module deal with the aqorders in OPAC and in staff interface
60 A suggestion is done in the OPAC. It has the status "ASKED"
62 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
64 When the book is ordered, the suggestion status becomes "ORDERED"
66 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
68 All aqorders of a borrower can be seen by the borrower itself.
69 Suggestions done by other borrowers can be seen when not "AVAILABLE"
75 \%sth = &GetSuggestion($suggestionid)
77 this function get the detail of the suggestion $suggestionid (input arg)
80 the result of the SQL query as a hash : $sth->fetchrow_hashref.
85 my ($suggestionid) = @_;
86 my $dbh = C4::Context->dbh;
92 my $sth = $dbh->prepare($query);
93 $sth->execute($suggestionid);
94 return ( $sth->fetchrow_hashref );
97 =head2 GetSuggestionFromBiblionumber
99 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
101 Get a suggestion from it's biblionumber.
104 the id of the suggestion which is related to the biblionumber given on input args.
108 sub GetSuggestionFromBiblionumber {
109 my ($biblionumber) = @_;
113 WHERE biblionumber=? LIMIT 1
115 my $dbh = C4::Context->dbh;
116 my $sth = $dbh->prepare($query);
117 $sth->execute($biblionumber);
118 my ($suggestionid) = $sth->fetchrow;
119 return $suggestionid;
122 =head2 GetSuggestionInfoFromBiblionumber
124 Get a suggestion and borrower's informations from it's biblionumber.
127 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
131 sub GetSuggestionInfoFromBiblionumber {
132 my ($biblionumber) = @_;
134 SELECT suggestions.*,
135 U1.surname AS surnamesuggestedby,
136 U1.firstname AS firstnamesuggestedby,
137 U1.borrowernumber AS borrnumsuggestedby
139 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
143 my $dbh = C4::Context->dbh;
144 my $sth = $dbh->prepare($query);
145 $sth->execute($biblionumber);
146 return $sth->fetchrow_hashref;
149 =head2 GetSuggestionInfo
151 Get a suggestion and borrower's informations from it's suggestionid
154 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
158 sub GetSuggestionInfo {
159 my ($suggestionid) = @_;
161 SELECT suggestions.*,
162 U1.surname AS surnamesuggestedby,
163 U1.firstname AS firstnamesuggestedby,
164 U1.borrowernumber AS borrnumsuggestedby
166 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
170 my $dbh = C4::Context->dbh;
171 my $sth = $dbh->prepare($query);
172 $sth->execute($suggestionid);
173 return $sth->fetchrow_hashref;
176 =head2 GetSuggestionByStatus
178 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
180 Get a suggestion from it's status
183 all the suggestion with C<$status>
187 sub GetSuggestionByStatus {
189 my $branchcode = shift;
190 my $dbh = C4::Context->dbh;
191 my @sql_params = ($status);
193 SELECT suggestions.*,
194 U1.surname AS surnamesuggestedby,
195 U1.firstname AS firstnamesuggestedby,
196 U1.branchcode AS branchcodesuggestedby,
197 B1.branchname AS branchnamesuggestedby,
198 U1.borrowernumber AS borrnumsuggestedby,
199 U1.categorycode AS categorycodesuggestedby,
200 C1.description AS categorydescriptionsuggestedby,
201 U2.surname AS surnamemanagedby,
202 U2.firstname AS firstnamemanagedby,
203 U2.borrowernumber AS borrnummanagedby
205 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
206 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
207 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
208 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
210 ORDER BY suggestionid
214 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
215 my $userenv = C4::Context->userenv;
217 unless ( C4::Context->IsSuperLibrarian() ) {
218 push @sql_params, $userenv->{branch};
219 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
223 push @sql_params, $branchcode;
224 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
228 my $sth = $dbh->prepare($query);
229 $sth->execute(@sql_params);
231 $results = $sth->fetchall_arrayref( {} );
237 &ModSuggestion($suggestion)
239 Modify the suggestion according to the hash passed by ref.
240 The hash HAS to contain suggestionid
241 Data not defined is not updated unless it is a note or sort1
242 Send a mail to notify the user that did the suggestion.
244 Note that there is no function to modify a suggestion.
249 my ($suggestion) = @_;
250 return unless( $suggestion and defined($suggestion->{suggestionid}) );
252 my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
253 eval { # FIXME Must raise an exception instead
254 $suggestion_object->set($suggestion)->store;
258 if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
260 # fetch the entire updated suggestion so that we can populate the letter
261 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
263 my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
265 my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
268 my $letter = C4::Letters::GetPreparedLetter(
269 module => 'suggestions',
270 letter_code => $full_suggestion->{STATUS},
271 branchcode => $full_suggestion->{branchcode},
272 lang => $patron->lang,
274 'branches' => $full_suggestion->{branchcode},
275 'borrowers' => $full_suggestion->{suggestedby},
276 'suggestions' => $full_suggestion,
277 'biblio' => $full_suggestion->{biblionumber},
282 C4::Letters::EnqueueLetter(
285 borrowernumber => $full_suggestion->{suggestedby},
286 suggestionid => $full_suggestion->{suggestionid},
287 LibraryName => C4::Context->preference("LibraryName"),
288 message_transport_type => $transport,
290 ) or warn "can't enqueue letter $letter";
293 return 1; # No useful if the exception is raised earlier
296 =head2 ConnectSuggestionAndBiblio
298 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
300 connect a suggestion to an existing biblio
304 sub ConnectSuggestionAndBiblio {
305 my ( $suggestionid, $biblionumber ) = @_;
306 my $dbh = C4::Context->dbh;
312 my $sth = $dbh->prepare($query);
313 $sth->execute( $biblionumber, $suggestionid );
318 &DelSuggestion($borrowernumber,$ordernumber)
320 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
325 my ( $borrowernumber, $suggestionid, $type ) = @_;
326 my $dbh = C4::Context->dbh;
328 # check that the suggestion comes from the suggestor
334 my $sth = $dbh->prepare($query);
335 $sth->execute($suggestionid);
336 my ($suggestedby) = $sth->fetchrow;
338 $borrowernumber //= '';
339 if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
341 DELETE FROM suggestions
344 $sth = $dbh->prepare($queryDelete);
345 my $suggestiondeleted = $sth->execute($suggestionid);
346 return $suggestiondeleted;
350 =head2 DelSuggestionsOlderThan
351 &DelSuggestionsOlderThan($days)
353 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
354 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
358 sub DelSuggestionsOlderThan {
360 return unless $days && $days > 0;
361 my $dbh = C4::Context->dbh;
362 my $sth = $dbh->prepare(
364 DELETE FROM suggestions
365 WHERE STATUS<>'ASKED'
366 AND manageddate < ADDDATE(NOW(), ?)
369 $sth->execute("-$days");
372 sub GetUnprocessedSuggestions {
373 my ( $number_of_days_since_the_last_modification ) = @_;
375 $number_of_days_since_the_last_modification ||= 0;
377 my $dbh = C4::Context->dbh;
379 my $s = $dbh->selectall_arrayref(q|
382 WHERE STATUS = 'ASKED'
383 AND budgetid IS NOT NULL
384 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
385 |, { Slice => {} }, $number_of_days_since_the_last_modification );
389 =head2 MarcRecordFromNewSuggestion
391 $record = MarcRecordFromNewSuggestion ( $suggestion )
393 This function build a marc record object from a suggestion
397 sub MarcRecordFromNewSuggestion {
398 my ($suggestion) = @_;
399 my $record = MARC::Record->new();
401 if (my $isbn = $suggestion->{isbn}) {
402 for my $field (qw(biblioitems.isbn biblioitems.issn)) {
403 my ($tag, $subfield) = GetMarcFromKohaField($field);
404 $record->append_fields(
405 MARC::Field->new($tag, ' ', ' ', $subfield => $isbn)
410 my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title');
411 $record->append_fields(
412 MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
415 my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author');
416 if ($record->field( $author_tag )) {
417 $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
420 $record->append_fields(
421 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
426 my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype');
427 if ($record->field( $it_tag )) {
428 $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
431 $record->append_fields(
432 MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
445 Koha Development Team <http://koha-community.org/>