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 List::MoreUtils qw(any);
32 use C4::Dates qw(format_date_in_iso);
33 use base qw(Exporter);
35 our $VERSION = 3.07.00.049;
37 ConnectSuggestionAndBiblio
42 GetSuggestionFromBiblionumber
43 GetSuggestionInfoFromBiblionumber
49 DelSuggestionsOlderThan
54 C4::Suggestions - Some useful functions for dealings with aqorders.
62 The functions in this module deal with the aqorders in OPAC and in librarian interface
64 A suggestion is done in the OPAC. It has the status "ASKED"
66 When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
68 When the book is ordered, the suggestion status becomes "ORDERED"
70 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
72 All aqorders of a borrower can be seen by the borrower itself.
73 Suggestions done by other borrowers can be seen when not "AVAILABLE"
77 =head2 SearchSuggestion
79 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
81 searches for a suggestion
84 C<\@array> : the aqorders found. Array of hash.
85 Note the status is stored twice :
87 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
91 sub SearchSuggestion {
92 my ($suggestion) = @_;
93 my $dbh = C4::Context->dbh;
98 U1.branchcode AS branchcodesuggestedby,
99 B1.branchname AS branchnamesuggestedby,
100 U1.surname AS surnamesuggestedby,
101 U1.firstname AS firstnamesuggestedby,
102 U1.email AS emailsuggestedby,
103 U1.borrowernumber AS borrnumsuggestedby,
104 U1.categorycode AS categorycodesuggestedby,
105 C1.description AS categorydescriptionsuggestedby,
106 U2.surname AS surnamemanagedby,
107 U2.firstname AS firstnamemanagedby,
108 B2.branchname AS branchnamesuggestedby,
109 U2.email AS emailmanagedby,
110 U2.branchcode AS branchcodemanagedby,
111 U2.borrowernumber AS borrnummanagedby
113 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
114 LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
115 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
116 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
117 LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
118 LEFT JOIN categories AS C2 ON C2.categorycode=U2.categorycode
123 # filter on biblio informations
125 qw( title author isbn publishercode copyrightdate collectiontitle ))
127 if ( $suggestion->{$field} ) {
128 push @sql_params, '%' . $suggestion->{$field} . '%';
129 push @query, qq{ AND suggestions.$field LIKE ? };
133 # filter on user branch
134 if ( C4::Context->preference('IndependentBranches') ) {
135 my $userenv = C4::Context->userenv;
137 if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
139 push @sql_params, $$userenv{branch};
141 AND (suggestions.branchcode=? OR suggestions.branchcode='')
146 if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
147 unless ( $suggestion->{branchcode} eq '__ANY__' ) {
148 push @sql_params, $suggestion->{branchcode};
149 push @query, qq{ AND suggestions.branchcode=? };
154 # filter on nillable fields
156 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
159 if ( exists $suggestion->{$field} ) {
160 if ( defined $suggestion->{$field} and $suggestion->{$field} ne '' )
162 push @sql_params, $suggestion->{$field};
163 push @query, qq{ AND suggestions.$field=? };
167 AND (suggestions.$field='' OR suggestions.$field IS NULL)
173 # filter on date fields
174 my $today = C4::Dates->today('iso');
175 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
176 my $from = $field . "_from";
177 my $to = $field . "_to";
178 if ( $suggestion->{$from} || $suggestion->{$to} ) {
179 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
181 format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
183 format_date_in_iso( $suggestion->{$to} ) || $today;
187 $debug && warn "@query";
188 my $sth = $dbh->prepare("@query");
189 $sth->execute(@sql_params);
192 # add status as field
193 while ( my $data = $sth->fetchrow_hashref ) {
194 $data->{ $data->{STATUS} } = 1;
195 push( @results, $data );
198 return ( \@results );
203 \%sth = &GetSuggestion($ordernumber)
205 this function get the detail of the suggestion $ordernumber (input arg)
208 the result of the SQL query as a hash : $sth->fetchrow_hashref.
213 my ($ordernumber) = @_;
214 my $dbh = C4::Context->dbh;
220 my $sth = $dbh->prepare($query);
221 $sth->execute($ordernumber);
222 return ( $sth->fetchrow_hashref );
225 =head2 GetSuggestionFromBiblionumber
227 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
229 Get a suggestion from it's biblionumber.
232 the id of the suggestion which is related to the biblionumber given on input args.
236 sub GetSuggestionFromBiblionumber {
237 my ($biblionumber) = @_;
241 WHERE biblionumber=? LIMIT 1
243 my $dbh = C4::Context->dbh;
244 my $sth = $dbh->prepare($query);
245 $sth->execute($biblionumber);
246 my ($suggestionid) = $sth->fetchrow;
247 return $suggestionid;
250 =head2 GetSuggestionInfoFromBiblionumber
252 Get a suggestion and borrower's informations from it's biblionumber.
255 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
259 sub GetSuggestionInfoFromBiblionumber {
260 my ($biblionumber) = @_;
262 SELECT suggestions.*,
263 U1.surname AS surnamesuggestedby,
264 U1.firstname AS firstnamesuggestedby,
265 U1.borrowernumber AS borrnumsuggestedby
267 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
271 my $dbh = C4::Context->dbh;
272 my $sth = $dbh->prepare($query);
273 $sth->execute($biblionumber);
274 return $sth->fetchrow_hashref;
277 =head2 GetSuggestionInfo
279 Get a suggestion and borrower's informations from it's suggestionid
282 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
286 sub GetSuggestionInfo {
287 my ($suggestionid) = @_;
289 SELECT suggestions.*,
290 U1.surname AS surnamesuggestedby,
291 U1.firstname AS firstnamesuggestedby,
292 U1.borrowernumber AS borrnumsuggestedby
294 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
298 my $dbh = C4::Context->dbh;
299 my $sth = $dbh->prepare($query);
300 $sth->execute($suggestionid);
301 return $sth->fetchrow_hashref;
304 =head2 GetSuggestionByStatus
306 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
308 Get a suggestion from it's status
311 all the suggestion with C<$status>
315 sub GetSuggestionByStatus {
317 my $branchcode = shift;
318 my $dbh = C4::Context->dbh;
319 my @sql_params = ($status);
321 SELECT suggestions.*,
322 U1.surname AS surnamesuggestedby,
323 U1.firstname AS firstnamesuggestedby,
324 U1.branchcode AS branchcodesuggestedby,
325 B1.branchname AS branchnamesuggestedby,
326 U1.borrowernumber AS borrnumsuggestedby,
327 U1.categorycode AS categorycodesuggestedby,
328 C1.description AS categorydescriptionsuggestedby,
329 U2.surname AS surnamemanagedby,
330 U2.firstname AS firstnamemanagedby,
331 U2.borrowernumber AS borrnummanagedby
333 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
334 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
335 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
336 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
341 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
342 my $userenv = C4::Context->userenv;
344 unless ( C4::Context->IsSuperLibrarian() ) {
345 push @sql_params, $userenv->{branch};
346 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
350 push @sql_params, $branchcode;
351 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
355 my $sth = $dbh->prepare($query);
356 $sth->execute(@sql_params);
358 $results = $sth->fetchall_arrayref( {} );
362 =head2 CountSuggestion
364 &CountSuggestion($status)
366 Count the number of aqorders with the status given on input argument.
367 the arg status can be :
371 =item * ASKED : asked by the user, not dealed by the librarian
373 =item * ACCEPTED : accepted by the librarian, but not yet ordered
375 =item * REJECTED : rejected by the librarian (definitive status)
377 =item * ORDERED : ordered by the librarian (acquisition module)
382 the number of suggestion with this status.
386 sub CountSuggestion {
388 my $dbh = C4::Context->dbh;
390 my $userenv = C4::Context->userenv;
391 if ( C4::Context->preference("IndependentBranches")
392 && !C4::Context->IsSuperLibrarian() )
397 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
399 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
401 $sth = $dbh->prepare($query);
402 $sth->execute( $status, $userenv->{branch} );
410 $sth = $dbh->prepare($query);
411 $sth->execute($status);
413 my ($result) = $sth->fetchrow;
420 &NewSuggestion($suggestion);
422 Insert a new suggestion on database with value given on input arg.
427 my ($suggestion) = @_;
429 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
431 my $rs = Koha::Database->new->schema->resultset('Suggestion');
432 return $rs->create($suggestion)->id;
437 &ModSuggestion($suggestion)
439 Modify the suggestion according to the hash passed by ref.
440 The hash HAS to contain suggestionid
441 Data not defined is not updated unless it is a note or sort1
442 Send a mail to notify the user that did the suggestion.
444 Note that there is no function to modify a suggestion.
449 my ($suggestion) = @_;
450 return unless( $suggestion and defined($suggestion->{suggestionid}) );
452 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
453 my $status_update_table = 1;
455 $rs->update($suggestion);
457 $status_update_table = 0 if( $@ );
459 if ( $suggestion->{STATUS} ) {
461 # fetch the entire updated suggestion so that we can populate the letter
462 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
464 my $letter = C4::Letters::GetPreparedLetter(
465 module => 'suggestions',
466 letter_code => $full_suggestion->{STATUS},
467 branchcode => $full_suggestion->{branchcode},
469 'branches' => $full_suggestion->{branchcode},
470 'borrowers' => $full_suggestion->{suggestedby},
471 'suggestions' => $full_suggestion,
472 'biblio' => $full_suggestion->{biblionumber},
477 C4::Letters::EnqueueLetter(
480 borrowernumber => $full_suggestion->{suggestedby},
481 suggestionid => $full_suggestion->{suggestionid},
482 LibraryName => C4::Context->preference("LibraryName"),
483 message_transport_type => 'email',
485 ) or warn "can't enqueue letter $letter";
488 return $status_update_table;
491 =head2 ConnectSuggestionAndBiblio
493 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
495 connect a suggestion to an existing biblio
499 sub ConnectSuggestionAndBiblio {
500 my ( $suggestionid, $biblionumber ) = @_;
501 my $dbh = C4::Context->dbh;
507 my $sth = $dbh->prepare($query);
508 $sth->execute( $biblionumber, $suggestionid );
513 &DelSuggestion($borrowernumber,$ordernumber)
515 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
520 my ( $borrowernumber, $suggestionid, $type ) = @_;
521 my $dbh = C4::Context->dbh;
523 # check that the suggestion comes from the suggestor
529 my $sth = $dbh->prepare($query);
530 $sth->execute($suggestionid);
531 my ($suggestedby) = $sth->fetchrow;
532 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
534 DELETE FROM suggestions
537 $sth = $dbh->prepare($queryDelete);
538 my $suggestiondeleted = $sth->execute($suggestionid);
539 return $suggestiondeleted;
543 =head2 DelSuggestionsOlderThan
544 &DelSuggestionsOlderThan($days)
546 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
550 sub DelSuggestionsOlderThan {
553 my $dbh = C4::Context->dbh;
554 my $sth = $dbh->prepare(
556 DELETE FROM suggestions
557 WHERE STATUS<>'ASKED'
558 AND date < ADDDATE(NOW(), ?)
561 $sth->execute("-$days");
570 Koha Development Team <http://koha-community.org/>