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);
31 use Koha::DateUtils qw( dt_from_string );
33 use List::MoreUtils qw(any);
34 use C4::Dates qw(format_date_in_iso);
35 use base qw(Exporter);
37 our $VERSION = 3.07.00.049;
39 ConnectSuggestionAndBiblio
44 GetSuggestionFromBiblionumber
45 GetSuggestionInfoFromBiblionumber
51 DelSuggestionsOlderThan
56 C4::Suggestions - Some useful functions for dealings with aqorders.
64 The functions in this module deal with the aqorders in OPAC and in librarian interface
66 A suggestion is done in the OPAC. It has the status "ASKED"
68 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
70 When the book is ordered, the suggestion status becomes "ORDERED"
72 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
74 All aqorders of a borrower can be seen by the borrower itself.
75 Suggestions done by other borrowers can be seen when not "AVAILABLE"
79 =head2 SearchSuggestion
81 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
83 searches for a suggestion
86 C<\@array> : the aqorders found. Array of hash.
87 Note the status is stored twice :
89 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
93 sub SearchSuggestion {
94 my ($suggestion) = @_;
95 my $dbh = C4::Context->dbh;
100 U1.branchcode AS branchcodesuggestedby,
101 B1.branchname AS branchnamesuggestedby,
102 U1.surname AS surnamesuggestedby,
103 U1.firstname AS firstnamesuggestedby,
104 U1.email AS emailsuggestedby,
105 U1.borrowernumber AS borrnumsuggestedby,
106 U1.categorycode AS categorycodesuggestedby,
107 C1.description AS categorydescriptionsuggestedby,
108 U2.surname AS surnamemanagedby,
109 U2.firstname AS firstnamemanagedby,
110 B2.branchname AS branchnamesuggestedby,
111 U2.email AS emailmanagedby,
112 U2.branchcode AS branchcodemanagedby,
113 U2.borrowernumber AS borrnummanagedby
115 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
116 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
117 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
118 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
119 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
120 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
125 # filter on biblio informations
127 qw( title author isbn publishercode copyrightdate collectiontitle ))
129 if ( $suggestion->{$field} ) {
130 push @sql_params, '%' . $suggestion->{$field} . '%';
131 push @query, qq{ AND suggestions.$field LIKE ? };
135 # filter on user branch
136 if ( C4::Context->preference('IndependentBranches') ) {
137 my $userenv = C4::Context->userenv;
139 if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
141 push @sql_params, $$userenv{branch};
143 AND (suggestions.branchcode=? OR suggestions.branchcode='')
148 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
149 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
150 push @sql_params, $suggestion->{branchcode};
151 push @query, qq{ AND suggestions.branchcode=? };
156 # filter on nillable fields
158 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
161 if ( exists $suggestion->{$field}
162 and defined $suggestion->{$field}
163 and $suggestion->{$field} ne '__ANY__'
164 and $suggestion->{$field} ne q||
166 if ( $suggestion->{$field} eq '__NONE__' ) {
167 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
170 push @sql_params, $suggestion->{$field};
171 push @query, qq{ AND suggestions.$field = ? };
176 # filter on date fields
177 my $today = C4::Dates->today('iso');
178 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
179 my $from = $field . "_from";
180 my $to = $field . "_to";
181 if ( $suggestion->{$from} || $suggestion->{$to} ) {
182 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
184 format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
186 format_date_in_iso( $suggestion->{$to} ) || $today;
190 $debug && warn "@query";
191 my $sth = $dbh->prepare("@query");
192 $sth->execute(@sql_params);
195 # add status as field
196 while ( my $data = $sth->fetchrow_hashref ) {
197 $data->{ $data->{STATUS} } = 1;
198 push( @results, $data );
201 return ( \@results );
206 \%sth = &GetSuggestion($suggestionid)
208 this function get the detail of the suggestion $suggestionid (input arg)
211 the result of the SQL query as a hash : $sth->fetchrow_hashref.
216 my ($suggestionid) = @_;
217 my $dbh = C4::Context->dbh;
223 my $sth = $dbh->prepare($query);
224 $sth->execute($suggestionid);
225 return ( $sth->fetchrow_hashref );
228 =head2 GetSuggestionFromBiblionumber
230 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
232 Get a suggestion from it's biblionumber.
235 the id of the suggestion which is related to the biblionumber given on input args.
239 sub GetSuggestionFromBiblionumber {
240 my ($biblionumber) = @_;
244 WHERE biblionumber=? LIMIT 1
246 my $dbh = C4::Context->dbh;
247 my $sth = $dbh->prepare($query);
248 $sth->execute($biblionumber);
249 my ($suggestionid) = $sth->fetchrow;
250 return $suggestionid;
253 =head2 GetSuggestionInfoFromBiblionumber
255 Get a suggestion and borrower's informations from it's biblionumber.
258 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
262 sub GetSuggestionInfoFromBiblionumber {
263 my ($biblionumber) = @_;
265 SELECT suggestions.*,
266 U1.surname AS surnamesuggestedby,
267 U1.firstname AS firstnamesuggestedby,
268 U1.borrowernumber AS borrnumsuggestedby
270 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
274 my $dbh = C4::Context->dbh;
275 my $sth = $dbh->prepare($query);
276 $sth->execute($biblionumber);
277 return $sth->fetchrow_hashref;
280 =head2 GetSuggestionInfo
282 Get a suggestion and borrower's informations from it's suggestionid
285 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
289 sub GetSuggestionInfo {
290 my ($suggestionid) = @_;
292 SELECT suggestions.*,
293 U1.surname AS surnamesuggestedby,
294 U1.firstname AS firstnamesuggestedby,
295 U1.borrowernumber AS borrnumsuggestedby
297 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
301 my $dbh = C4::Context->dbh;
302 my $sth = $dbh->prepare($query);
303 $sth->execute($suggestionid);
304 return $sth->fetchrow_hashref;
307 =head2 GetSuggestionByStatus
309 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
311 Get a suggestion from it's status
314 all the suggestion with C<$status>
318 sub GetSuggestionByStatus {
320 my $branchcode = shift;
321 my $dbh = C4::Context->dbh;
322 my @sql_params = ($status);
324 SELECT suggestions.*,
325 U1.surname AS surnamesuggestedby,
326 U1.firstname AS firstnamesuggestedby,
327 U1.branchcode AS branchcodesuggestedby,
328 B1.branchname AS branchnamesuggestedby,
329 U1.borrowernumber AS borrnumsuggestedby,
330 U1.categorycode AS categorycodesuggestedby,
331 C1.description AS categorydescriptionsuggestedby,
332 U2.surname AS surnamemanagedby,
333 U2.firstname AS firstnamemanagedby,
334 U2.borrowernumber AS borrnummanagedby
336 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
337 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
338 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
339 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
344 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
345 my $userenv = C4::Context->userenv;
347 unless ( C4::Context->IsSuperLibrarian() ) {
348 push @sql_params, $userenv->{branch};
349 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
353 push @sql_params, $branchcode;
354 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
358 my $sth = $dbh->prepare($query);
359 $sth->execute(@sql_params);
361 $results = $sth->fetchall_arrayref( {} );
365 =head2 CountSuggestion
367 &CountSuggestion($status)
369 Count the number of aqorders with the status given on input argument.
370 the arg status can be :
374 =item * ASKED : asked by the user, not dealed by the librarian
376 =item * ACCEPTED : accepted by the librarian, but not yet ordered
378 =item * REJECTED : rejected by the librarian (definitive status)
380 =item * ORDERED : ordered by the librarian (acquisition module)
385 the number of suggestion with this status.
389 sub CountSuggestion {
391 my $dbh = C4::Context->dbh;
393 my $userenv = C4::Context->userenv;
394 if ( C4::Context->preference("IndependentBranches")
395 && !C4::Context->IsSuperLibrarian() )
400 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
402 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
404 $sth = $dbh->prepare($query);
405 $sth->execute( $status, $userenv->{branch} );
413 $sth = $dbh->prepare($query);
414 $sth->execute($status);
416 my ($result) = $sth->fetchrow;
423 &NewSuggestion($suggestion);
425 Insert a new suggestion on database with value given on input arg.
430 my ($suggestion) = @_;
441 # Set the fields to NULL if not given.
442 $suggestion->{$field} ||= undef;
445 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
447 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
449 my $rs = Koha::Database->new->schema->resultset('Suggestion');
450 return $rs->create($suggestion)->id;
455 &ModSuggestion($suggestion)
457 Modify the suggestion according to the hash passed by ref.
458 The hash HAS to contain suggestionid
459 Data not defined is not updated unless it is a note or sort1
460 Send a mail to notify the user that did the suggestion.
462 Note that there is no function to modify a suggestion.
467 my ($suggestion) = @_;
468 return unless( $suggestion and defined($suggestion->{suggestionid}) );
479 # Set the fields to NULL if not given.
480 $suggestion->{$field} = undef
481 if exists $suggestion->{$field}
482 and ($suggestion->{$field} eq '0'
483 or $suggestion->{$field} eq '' );
486 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
487 my $status_update_table = 1;
489 $rs->update($suggestion);
491 $status_update_table = 0 if( $@ );
493 if ( $suggestion->{STATUS} ) {
495 # fetch the entire updated suggestion so that we can populate the letter
496 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
498 my $letter = C4::Letters::GetPreparedLetter(
499 module => 'suggestions',
500 letter_code => $full_suggestion->{STATUS},
501 branchcode => $full_suggestion->{branchcode},
503 'branches' => $full_suggestion->{branchcode},
504 'borrowers' => $full_suggestion->{suggestedby},
505 'suggestions' => $full_suggestion,
506 'biblio' => $full_suggestion->{biblionumber},
511 C4::Letters::EnqueueLetter(
514 borrowernumber => $full_suggestion->{suggestedby},
515 suggestionid => $full_suggestion->{suggestionid},
516 LibraryName => C4::Context->preference("LibraryName"),
517 message_transport_type => 'email',
519 ) or warn "can't enqueue letter $letter";
522 return $status_update_table;
525 =head2 ConnectSuggestionAndBiblio
527 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
529 connect a suggestion to an existing biblio
533 sub ConnectSuggestionAndBiblio {
534 my ( $suggestionid, $biblionumber ) = @_;
535 my $dbh = C4::Context->dbh;
541 my $sth = $dbh->prepare($query);
542 $sth->execute( $biblionumber, $suggestionid );
547 &DelSuggestion($borrowernumber,$ordernumber)
549 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
554 my ( $borrowernumber, $suggestionid, $type ) = @_;
555 my $dbh = C4::Context->dbh;
557 # check that the suggestion comes from the suggestor
563 my $sth = $dbh->prepare($query);
564 $sth->execute($suggestionid);
565 my ($suggestedby) = $sth->fetchrow;
566 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
568 DELETE FROM suggestions
571 $sth = $dbh->prepare($queryDelete);
572 my $suggestiondeleted = $sth->execute($suggestionid);
573 return $suggestiondeleted;
577 =head2 DelSuggestionsOlderThan
578 &DelSuggestionsOlderThan($days)
580 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
584 sub DelSuggestionsOlderThan {
587 my $dbh = C4::Context->dbh;
588 my $sth = $dbh->prepare(
590 DELETE FROM suggestions
591 WHERE STATUS<>'ASKED'
592 AND date < ADDDATE(NOW(), ?)
595 $sth->execute("-$days");
604 Koha Development Team <http://koha-community.org/>