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 under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 #use warnings; FIXME - Bug 2505
28 use C4::Dates qw(format_date format_date_in_iso);
29 use C4::SQLHelper qw(:all);
32 use List::MoreUtils qw(any);
33 use C4::Dates qw(format_date_in_iso);
34 use base qw(Exporter);
36 our $VERSION = 3.07.00.049;
38 ConnectSuggestionAndBiblio
43 GetSuggestionFromBiblionumber
44 GetSuggestionInfoFromBiblionumber
50 DelSuggestionsOlderThan
55 C4::Suggestions - Some useful functions for dealings with aqorders.
63 The functions in this module deal with the aqorders in OPAC and in librarian interface
65 A suggestion is done in the OPAC. It has the status "ASKED"
67 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
69 When the book is ordered, the suggestion status becomes "ORDERED"
71 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
73 All aqorders of a borrower can be seen by the borrower itself.
74 Suggestions done by other borrowers can be seen when not "AVAILABLE"
78 =head2 SearchSuggestion
80 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
82 searches for a suggestion
85 C<\@array> : the aqorders found. Array of hash.
86 Note the status is stored twice :
88 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
92 sub SearchSuggestion {
93 my ($suggestion) = @_;
94 my $dbh = C4::Context->dbh;
99 U1.branchcode AS branchcodesuggestedby,
100 B1.branchname AS branchnamesuggestedby,
101 U1.surname AS surnamesuggestedby,
102 U1.firstname AS firstnamesuggestedby,
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
114 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
115 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
116 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
117 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
118 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
119 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
124 # filter on biblio informations
126 qw( title author isbn publishercode copyrightdate collectiontitle ))
128 if ( $suggestion->{$field} ) {
129 push @sql_params, '%' . $suggestion->{$field} . '%';
130 push @query, qq{ AND suggestions.$field LIKE ? };
134 # filter on user branch
135 if ( C4::Context->preference('IndependantBranches') ) {
136 my $userenv = C4::Context->userenv;
138 if ( ( $userenv->{flags} % 2 ) != 1 && !$suggestion->{branchcode} )
140 push @sql_params, $$userenv{branch};
142 AND (suggestions.branchcode=? OR suggestions.branchcode='')
148 # filter on nillable fields
150 qw( STATUS branchcode itemtype suggestedby managedby acceptedby budgetid biblionumber )
153 if ( exists $suggestion->{$field} ) {
154 if ( defined $suggestion->{$field} and $suggestion->{$field} ne '' )
156 push @sql_params, $suggestion->{$field};
157 push @query, qq{ AND suggestions.$field=? };
161 AND (suggestions.$field='' OR suggestions.$field IS NULL)
167 # filter on date fields
168 my $today = C4::Dates->today('iso');
169 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
170 my $from = $field . "_from";
171 my $to = $field . "_to";
172 if ( $suggestion->{$from} || $suggestion->{$to} ) {
173 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
175 format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
177 format_date_in_iso( $suggestion->{$to} ) || $today;
181 $debug && warn "@query";
182 my $sth = $dbh->prepare("@query");
183 $sth->execute(@sql_params);
186 # add status as field
187 while ( my $data = $sth->fetchrow_hashref ) {
188 $data->{ $data->{STATUS} } = 1;
189 push( @results, $data );
192 return ( \@results );
197 \%sth = &GetSuggestion($ordernumber)
199 this function get the detail of the suggestion $ordernumber (input arg)
202 the result of the SQL query as a hash : $sth->fetchrow_hashref.
207 my ($ordernumber) = @_;
208 my $dbh = C4::Context->dbh;
214 my $sth = $dbh->prepare($query);
215 $sth->execute($ordernumber);
216 return ( $sth->fetchrow_hashref );
219 =head2 GetSuggestionFromBiblionumber
221 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
223 Get a suggestion from it's biblionumber.
226 the id of the suggestion which is related to the biblionumber given on input args.
230 sub GetSuggestionFromBiblionumber {
231 my ($biblionumber) = @_;
235 WHERE biblionumber=? LIMIT 1
237 my $dbh = C4::Context->dbh;
238 my $sth = $dbh->prepare($query);
239 $sth->execute($biblionumber);
240 my ($suggestionid) = $sth->fetchrow;
241 return $suggestionid;
244 =head2 GetSuggestionInfoFromBiblionumber
246 Get a suggestion and borrower's informations from it's biblionumber.
249 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
253 sub GetSuggestionInfoFromBiblionumber {
254 my ($biblionumber) = @_;
256 SELECT suggestions.*,
257 U1.surname AS surnamesuggestedby,
258 U1.firstname AS firstnamesuggestedby,
259 U1.borrowernumber AS borrnumsuggestedby
261 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
265 my $dbh = C4::Context->dbh;
266 my $sth = $dbh->prepare($query);
267 $sth->execute($biblionumber);
268 return $sth->fetchrow_hashref;
271 =head2 GetSuggestionInfo
273 Get a suggestion and borrower's informations from it's suggestionid
276 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
280 sub GetSuggestionInfo {
281 my ($suggestionid) = @_;
283 SELECT suggestions.*,
284 U1.surname AS surnamesuggestedby,
285 U1.firstname AS firstnamesuggestedby,
286 U1.borrowernumber AS borrnumsuggestedby
288 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
292 my $dbh = C4::Context->dbh;
293 my $sth = $dbh->prepare($query);
294 $sth->execute($suggestionid);
295 return $sth->fetchrow_hashref;
298 =head2 GetSuggestionByStatus
300 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
302 Get a suggestion from it's status
305 all the suggestion with C<$status>
309 sub GetSuggestionByStatus {
311 my $branchcode = shift;
312 my $dbh = C4::Context->dbh;
313 my @sql_params = ($status);
315 SELECT suggestions.*,
316 U1.surname AS surnamesuggestedby,
317 U1.firstname AS firstnamesuggestedby,
318 U1.branchcode AS branchcodesuggestedby,
319 B1.branchname AS branchnamesuggestedby,
320 U1.borrowernumber AS borrnumsuggestedby,
321 U1.categorycode AS categorycodesuggestedby,
322 C1.description AS categorydescriptionsuggestedby,
323 U2.surname AS surnamemanagedby,
324 U2.firstname AS firstnamemanagedby,
325 U2.borrowernumber AS borrnummanagedby
327 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
328 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
329 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
330 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
335 if ( C4::Context->preference("IndependantBranches") || $branchcode ) {
336 my $userenv = C4::Context->userenv;
338 unless ( $userenv->{flags} % 2 == 1 ) {
339 push @sql_params, $userenv->{branch};
340 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
344 push @sql_params, $branchcode;
345 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
349 my $sth = $dbh->prepare($query);
350 $sth->execute(@sql_params);
352 $results = $sth->fetchall_arrayref( {} );
356 =head2 CountSuggestion
358 &CountSuggestion($status)
360 Count the number of aqorders with the status given on input argument.
361 the arg status can be :
365 =item * ASKED : asked by the user, not dealed by the librarian
367 =item * ACCEPTED : accepted by the librarian, but not yet ordered
369 =item * REJECTED : rejected by the librarian (definitive status)
371 =item * ORDERED : ordered by the librarian (acquisition module)
376 the number of suggestion with this status.
380 sub CountSuggestion {
382 my $dbh = C4::Context->dbh;
384 my $userenv = C4::Context->userenv;
385 if ( C4::Context->preference("IndependantBranches")
386 && $userenv->{flags} % 2 != 1 )
391 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
393 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
395 $sth = $dbh->prepare($query);
396 $sth->execute( $status, $userenv->{branch} );
404 $sth = $dbh->prepare($query);
405 $sth->execute($status);
407 my ($result) = $sth->fetchrow;
414 &NewSuggestion($suggestion);
416 Insert a new suggestion on database with value given on input arg.
421 my ($suggestion) = @_;
422 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
423 return InsertInTable( "suggestions", $suggestion );
428 &ModSuggestion($suggestion)
430 Modify the suggestion according to the hash passed by ref.
431 The hash HAS to contain suggestionid
432 Data not defined is not updated unless it is a note or sort1
433 Send a mail to notify the user that did the suggestion.
435 Note that there is no function to modify a suggestion.
440 my ($suggestion) = @_;
441 my $status_update_table = UpdateInTable( "suggestions", $suggestion );
443 if ( $suggestion->{STATUS} ) {
445 # fetch the entire updated suggestion so that we can populate the letter
446 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
448 my $letter = C4::Letters::GetPreparedLetter(
449 module => 'suggestions',
450 letter_code => $full_suggestion->{STATUS},
451 branchcode => $full_suggestion->{branchcode},
453 'branches' => $full_suggestion->{branchcode},
454 'borrowers' => $full_suggestion->{suggestedby},
455 'suggestions' => $full_suggestion,
456 'biblio' => $full_suggestion->{biblionumber},
461 C4::Letters::EnqueueLetter(
464 borrowernumber => $full_suggestion->{suggestedby},
465 suggestionid => $full_suggestion->{suggestionid},
466 LibraryName => C4::Context->preference("LibraryName"),
467 message_transport_type => 'email',
469 ) or warn "can't enqueue letter $letter";
472 return $status_update_table;
475 =head2 ConnectSuggestionAndBiblio
477 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
479 connect a suggestion to an existing biblio
483 sub ConnectSuggestionAndBiblio {
484 my ( $suggestionid, $biblionumber ) = @_;
485 my $dbh = C4::Context->dbh;
491 my $sth = $dbh->prepare($query);
492 $sth->execute( $biblionumber, $suggestionid );
497 &DelSuggestion($borrowernumber,$ordernumber)
499 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
504 my ( $borrowernumber, $suggestionid, $type ) = @_;
505 my $dbh = C4::Context->dbh;
507 # check that the suggestion comes from the suggestor
513 my $sth = $dbh->prepare($query);
514 $sth->execute($suggestionid);
515 my ($suggestedby) = $sth->fetchrow;
516 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
518 DELETE FROM suggestions
521 $sth = $dbh->prepare($queryDelete);
522 my $suggestiondeleted = $sth->execute($suggestionid);
523 return $suggestiondeleted;
527 =head2 DelSuggestionsOlderThan
528 &DelSuggestionsOlderThan($days)
530 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
534 sub DelSuggestionsOlderThan {
537 my $dbh = C4::Context->dbh;
538 my $sth = $dbh->prepare(
540 DELETE FROM suggestions
541 WHERE STATUS<>'ASKED'
542 AND date < ADDDATE(NOW(), ?)
545 $sth->execute("-$days");
554 Koha Development Team <http://koha-community.org/>