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='')
147 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
148 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
149 push @sql_params, $suggestion->{branchcode};
150 push @query, qq{ AND suggestions.branchcode=? };
154 AND (suggestions.branchcode='' OR suggestions.branchcode IS NULL)
159 # filter on nillable fields
161 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
164 if ( exists $suggestion->{$field} ) {
165 if ( defined $suggestion->{$field} and $suggestion->{$field} ne '' )
167 push @sql_params, $suggestion->{$field};
168 push @query, qq{ AND suggestions.$field=? };
172 AND (suggestions.$field='' OR suggestions.$field IS NULL)
178 # filter on date fields
179 my $today = C4::Dates->today('iso');
180 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
181 my $from = $field . "_from";
182 my $to = $field . "_to";
183 if ( $suggestion->{$from} || $suggestion->{$to} ) {
184 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
186 format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
188 format_date_in_iso( $suggestion->{$to} ) || $today;
192 $debug && warn "@query";
193 my $sth = $dbh->prepare("@query");
194 $sth->execute(@sql_params);
197 # add status as field
198 while ( my $data = $sth->fetchrow_hashref ) {
199 $data->{ $data->{STATUS} } = 1;
200 push( @results, $data );
203 return ( \@results );
208 \%sth = &GetSuggestion($ordernumber)
210 this function get the detail of the suggestion $ordernumber (input arg)
213 the result of the SQL query as a hash : $sth->fetchrow_hashref.
218 my ($ordernumber) = @_;
219 my $dbh = C4::Context->dbh;
225 my $sth = $dbh->prepare($query);
226 $sth->execute($ordernumber);
227 return ( $sth->fetchrow_hashref );
230 =head2 GetSuggestionFromBiblionumber
232 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
234 Get a suggestion from it's biblionumber.
237 the id of the suggestion which is related to the biblionumber given on input args.
241 sub GetSuggestionFromBiblionumber {
242 my ($biblionumber) = @_;
246 WHERE biblionumber=? LIMIT 1
248 my $dbh = C4::Context->dbh;
249 my $sth = $dbh->prepare($query);
250 $sth->execute($biblionumber);
251 my ($suggestionid) = $sth->fetchrow;
252 return $suggestionid;
255 =head2 GetSuggestionInfoFromBiblionumber
257 Get a suggestion and borrower's informations from it's biblionumber.
260 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
264 sub GetSuggestionInfoFromBiblionumber {
265 my ($biblionumber) = @_;
267 SELECT suggestions.*,
268 U1.surname AS surnamesuggestedby,
269 U1.firstname AS firstnamesuggestedby,
270 U1.borrowernumber AS borrnumsuggestedby
272 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
276 my $dbh = C4::Context->dbh;
277 my $sth = $dbh->prepare($query);
278 $sth->execute($biblionumber);
279 return $sth->fetchrow_hashref;
282 =head2 GetSuggestionInfo
284 Get a suggestion and borrower's informations from it's suggestionid
287 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
291 sub GetSuggestionInfo {
292 my ($suggestionid) = @_;
294 SELECT suggestions.*,
295 U1.surname AS surnamesuggestedby,
296 U1.firstname AS firstnamesuggestedby,
297 U1.borrowernumber AS borrnumsuggestedby
299 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
303 my $dbh = C4::Context->dbh;
304 my $sth = $dbh->prepare($query);
305 $sth->execute($suggestionid);
306 return $sth->fetchrow_hashref;
309 =head2 GetSuggestionByStatus
311 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
313 Get a suggestion from it's status
316 all the suggestion with C<$status>
320 sub GetSuggestionByStatus {
322 my $branchcode = shift;
323 my $dbh = C4::Context->dbh;
324 my @sql_params = ($status);
326 SELECT suggestions.*,
327 U1.surname AS surnamesuggestedby,
328 U1.firstname AS firstnamesuggestedby,
329 U1.branchcode AS branchcodesuggestedby,
330 B1.branchname AS branchnamesuggestedby,
331 U1.borrowernumber AS borrnumsuggestedby,
332 U1.categorycode AS categorycodesuggestedby,
333 C1.description AS categorydescriptionsuggestedby,
334 U2.surname AS surnamemanagedby,
335 U2.firstname AS firstnamemanagedby,
336 U2.borrowernumber AS borrnummanagedby
338 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
339 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
340 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
341 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
346 if ( C4::Context->preference("IndependantBranches") || $branchcode ) {
347 my $userenv = C4::Context->userenv;
349 unless ( $userenv->{flags} % 2 == 1 ) {
350 push @sql_params, $userenv->{branch};
351 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
355 push @sql_params, $branchcode;
356 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
360 my $sth = $dbh->prepare($query);
361 $sth->execute(@sql_params);
363 $results = $sth->fetchall_arrayref( {} );
367 =head2 CountSuggestion
369 &CountSuggestion($status)
371 Count the number of aqorders with the status given on input argument.
372 the arg status can be :
376 =item * ASKED : asked by the user, not dealed by the librarian
378 =item * ACCEPTED : accepted by the librarian, but not yet ordered
380 =item * REJECTED : rejected by the librarian (definitive status)
382 =item * ORDERED : ordered by the librarian (acquisition module)
387 the number of suggestion with this status.
391 sub CountSuggestion {
393 my $dbh = C4::Context->dbh;
395 my $userenv = C4::Context->userenv;
396 if ( C4::Context->preference("IndependantBranches")
397 && $userenv->{flags} % 2 != 1 )
402 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
404 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
406 $sth = $dbh->prepare($query);
407 $sth->execute( $status, $userenv->{branch} );
415 $sth = $dbh->prepare($query);
416 $sth->execute($status);
418 my ($result) = $sth->fetchrow;
425 &NewSuggestion($suggestion);
427 Insert a new suggestion on database with value given on input arg.
432 my ($suggestion) = @_;
433 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
434 return InsertInTable( "suggestions", $suggestion );
439 &ModSuggestion($suggestion)
441 Modify the suggestion according to the hash passed by ref.
442 The hash HAS to contain suggestionid
443 Data not defined is not updated unless it is a note or sort1
444 Send a mail to notify the user that did the suggestion.
446 Note that there is no function to modify a suggestion.
451 my ($suggestion) = @_;
452 my $status_update_table = UpdateInTable( "suggestions", $suggestion );
454 if ( $suggestion->{STATUS} ) {
456 # fetch the entire updated suggestion so that we can populate the letter
457 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
459 my $letter = C4::Letters::GetPreparedLetter(
460 module => 'suggestions',
461 letter_code => $full_suggestion->{STATUS},
462 branchcode => $full_suggestion->{branchcode},
464 'branches' => $full_suggestion->{branchcode},
465 'borrowers' => $full_suggestion->{suggestedby},
466 'suggestions' => $full_suggestion,
467 'biblio' => $full_suggestion->{biblionumber},
472 C4::Letters::EnqueueLetter(
475 borrowernumber => $full_suggestion->{suggestedby},
476 suggestionid => $full_suggestion->{suggestionid},
477 LibraryName => C4::Context->preference("LibraryName"),
478 message_transport_type => 'email',
480 ) or warn "can't enqueue letter $letter";
483 return $status_update_table;
486 =head2 ConnectSuggestionAndBiblio
488 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
490 connect a suggestion to an existing biblio
494 sub ConnectSuggestionAndBiblio {
495 my ( $suggestionid, $biblionumber ) = @_;
496 my $dbh = C4::Context->dbh;
502 my $sth = $dbh->prepare($query);
503 $sth->execute( $biblionumber, $suggestionid );
508 &DelSuggestion($borrowernumber,$ordernumber)
510 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
515 my ( $borrowernumber, $suggestionid, $type ) = @_;
516 my $dbh = C4::Context->dbh;
518 # check that the suggestion comes from the suggestor
524 my $sth = $dbh->prepare($query);
525 $sth->execute($suggestionid);
526 my ($suggestedby) = $sth->fetchrow;
527 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
529 DELETE FROM suggestions
532 $sth = $dbh->prepare($queryDelete);
533 my $suggestiondeleted = $sth->execute($suggestionid);
534 return $suggestiondeleted;
538 =head2 DelSuggestionsOlderThan
539 &DelSuggestionsOlderThan($days)
541 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
545 sub DelSuggestionsOlderThan {
548 my $dbh = C4::Context->dbh;
549 my $sth = $dbh->prepare(
551 DELETE FROM suggestions
552 WHERE STATUS<>'ASKED'
553 AND date < ADDDATE(NOW(), ?)
556 $sth->execute("-$days");
565 Koha Development Team <http://koha-community.org/>