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>.
23 #use warnings; FIXME - Bug 2505
32 use List::MoreUtils qw(any);
33 use base qw(Exporter);
35 our $VERSION = 3.07.00.049;
37 ConnectSuggestionAndBiblio
42 GetSuggestionFromBiblionumber
43 GetSuggestionInfoFromBiblionumber
49 DelSuggestionsOlderThan
50 GetUnprocessedSuggestions
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.cardnumber AS cardnumbersuggestedby,
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__'
165 $suggestion->{$field} ne q||
166 or $field eq 'STATUS'
169 if ( $suggestion->{$field} eq '__NONE__' ) {
170 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
173 push @sql_params, $suggestion->{$field};
174 push @query, qq{ AND suggestions.$field = ? };
179 # filter on date fields
180 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
181 my $from = $field . "_from";
182 my $to = $field . "_to";
184 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
185 my $from_sql = '0000-00-00';
186 $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
188 $debug && warn "SQL for start date ($field): $from_sql";
189 if ( $suggestion->{$from} || $suggestion->{$to} ) {
190 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
191 push @sql_params, $from_sql;
193 output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
197 $debug && warn "@query";
198 my $sth = $dbh->prepare("@query");
199 $sth->execute(@sql_params);
202 # add status as field
203 while ( my $data = $sth->fetchrow_hashref ) {
204 $data->{ $data->{STATUS} } = 1;
205 push( @results, $data );
208 return ( \@results );
213 \%sth = &GetSuggestion($suggestionid)
215 this function get the detail of the suggestion $suggestionid (input arg)
218 the result of the SQL query as a hash : $sth->fetchrow_hashref.
223 my ($suggestionid) = @_;
224 my $dbh = C4::Context->dbh;
230 my $sth = $dbh->prepare($query);
231 $sth->execute($suggestionid);
232 return ( $sth->fetchrow_hashref );
235 =head2 GetSuggestionFromBiblionumber
237 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
239 Get a suggestion from it's biblionumber.
242 the id of the suggestion which is related to the biblionumber given on input args.
246 sub GetSuggestionFromBiblionumber {
247 my ($biblionumber) = @_;
251 WHERE biblionumber=? LIMIT 1
253 my $dbh = C4::Context->dbh;
254 my $sth = $dbh->prepare($query);
255 $sth->execute($biblionumber);
256 my ($suggestionid) = $sth->fetchrow;
257 return $suggestionid;
260 =head2 GetSuggestionInfoFromBiblionumber
262 Get a suggestion and borrower's informations from it's biblionumber.
265 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
269 sub GetSuggestionInfoFromBiblionumber {
270 my ($biblionumber) = @_;
272 SELECT suggestions.*,
273 U1.surname AS surnamesuggestedby,
274 U1.firstname AS firstnamesuggestedby,
275 U1.borrowernumber AS borrnumsuggestedby
277 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
281 my $dbh = C4::Context->dbh;
282 my $sth = $dbh->prepare($query);
283 $sth->execute($biblionumber);
284 return $sth->fetchrow_hashref;
287 =head2 GetSuggestionInfo
289 Get a suggestion and borrower's informations from it's suggestionid
292 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
296 sub GetSuggestionInfo {
297 my ($suggestionid) = @_;
299 SELECT suggestions.*,
300 U1.surname AS surnamesuggestedby,
301 U1.firstname AS firstnamesuggestedby,
302 U1.borrowernumber AS borrnumsuggestedby
304 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
308 my $dbh = C4::Context->dbh;
309 my $sth = $dbh->prepare($query);
310 $sth->execute($suggestionid);
311 return $sth->fetchrow_hashref;
314 =head2 GetSuggestionByStatus
316 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
318 Get a suggestion from it's status
321 all the suggestion with C<$status>
325 sub GetSuggestionByStatus {
327 my $branchcode = shift;
328 my $dbh = C4::Context->dbh;
329 my @sql_params = ($status);
331 SELECT suggestions.*,
332 U1.surname AS surnamesuggestedby,
333 U1.firstname AS firstnamesuggestedby,
334 U1.branchcode AS branchcodesuggestedby,
335 B1.branchname AS branchnamesuggestedby,
336 U1.borrowernumber AS borrnumsuggestedby,
337 U1.categorycode AS categorycodesuggestedby,
338 C1.description AS categorydescriptionsuggestedby,
339 U2.surname AS surnamemanagedby,
340 U2.firstname AS firstnamemanagedby,
341 U2.borrowernumber AS borrnummanagedby
343 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
344 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
345 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
346 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
351 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
352 my $userenv = C4::Context->userenv;
354 unless ( C4::Context->IsSuperLibrarian() ) {
355 push @sql_params, $userenv->{branch};
356 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
360 push @sql_params, $branchcode;
361 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
365 my $sth = $dbh->prepare($query);
366 $sth->execute(@sql_params);
368 $results = $sth->fetchall_arrayref( {} );
372 =head2 CountSuggestion
374 &CountSuggestion($status)
376 Count the number of aqorders with the status given on input argument.
377 the arg status can be :
381 =item * ASKED : asked by the user, not dealed by the librarian
383 =item * ACCEPTED : accepted by the librarian, but not yet ordered
385 =item * REJECTED : rejected by the librarian (definitive status)
387 =item * ORDERED : ordered by the librarian (acquisition module)
392 the number of suggestion with this status.
396 sub CountSuggestion {
398 my $dbh = C4::Context->dbh;
400 my $userenv = C4::Context->userenv;
401 if ( C4::Context->preference("IndependentBranches")
402 && !C4::Context->IsSuperLibrarian() )
407 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
409 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
411 $sth = $dbh->prepare($query);
412 $sth->execute( $status, $userenv->{branch} );
420 $sth = $dbh->prepare($query);
421 $sth->execute($status);
423 my ($result) = $sth->fetchrow;
430 &NewSuggestion($suggestion);
432 Insert a new suggestion on database with value given on input arg.
437 my ($suggestion) = @_;
449 # Set the fields to NULL if not given.
450 $suggestion->{$field} ||= undef;
453 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
455 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
457 my $rs = Koha::Database->new->schema->resultset('Suggestion');
458 return $rs->create($suggestion)->id;
463 &ModSuggestion($suggestion)
465 Modify the suggestion according to the hash passed by ref.
466 The hash HAS to contain suggestionid
467 Data not defined is not updated unless it is a note or sort1
468 Send a mail to notify the user that did the suggestion.
470 Note that there is no function to modify a suggestion.
475 my ($suggestion) = @_;
476 return unless( $suggestion and defined($suggestion->{suggestionid}) );
488 # Set the fields to NULL if not given.
489 $suggestion->{$field} = undef
490 if exists $suggestion->{$field}
491 and ($suggestion->{$field} eq '0'
492 or $suggestion->{$field} eq '' );
495 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
496 my $status_update_table = 1;
498 $rs->update($suggestion);
500 $status_update_table = 0 if( $@ );
502 if ( $suggestion->{STATUS} ) {
504 # fetch the entire updated suggestion so that we can populate the letter
505 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
507 my $letter = C4::Letters::GetPreparedLetter(
508 module => 'suggestions',
509 letter_code => $full_suggestion->{STATUS},
510 branchcode => $full_suggestion->{branchcode},
512 'branches' => $full_suggestion->{branchcode},
513 'borrowers' => $full_suggestion->{suggestedby},
514 'suggestions' => $full_suggestion,
515 'biblio' => $full_suggestion->{biblionumber},
520 C4::Letters::EnqueueLetter(
523 borrowernumber => $full_suggestion->{suggestedby},
524 suggestionid => $full_suggestion->{suggestionid},
525 LibraryName => C4::Context->preference("LibraryName"),
526 message_transport_type => 'email',
528 ) or warn "can't enqueue letter $letter";
531 return $status_update_table;
534 =head2 ConnectSuggestionAndBiblio
536 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
538 connect a suggestion to an existing biblio
542 sub ConnectSuggestionAndBiblio {
543 my ( $suggestionid, $biblionumber ) = @_;
544 my $dbh = C4::Context->dbh;
550 my $sth = $dbh->prepare($query);
551 $sth->execute( $biblionumber, $suggestionid );
556 &DelSuggestion($borrowernumber,$ordernumber)
558 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
563 my ( $borrowernumber, $suggestionid, $type ) = @_;
564 my $dbh = C4::Context->dbh;
566 # check that the suggestion comes from the suggestor
572 my $sth = $dbh->prepare($query);
573 $sth->execute($suggestionid);
574 my ($suggestedby) = $sth->fetchrow;
575 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
577 DELETE FROM suggestions
580 $sth = $dbh->prepare($queryDelete);
581 my $suggestiondeleted = $sth->execute($suggestionid);
582 return $suggestiondeleted;
586 =head2 DelSuggestionsOlderThan
587 &DelSuggestionsOlderThan($days)
589 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
593 sub DelSuggestionsOlderThan {
596 my $dbh = C4::Context->dbh;
597 my $sth = $dbh->prepare(
599 DELETE FROM suggestions
600 WHERE STATUS<>'ASKED'
601 AND date < ADDDATE(NOW(), ?)
604 $sth->execute("-$days");
607 sub GetUnprocessedSuggestions {
608 my ( $number_of_days_since_the_last_modification ) = @_;
610 $number_of_days_since_the_last_modification ||= 0;
612 my $dbh = C4::Context->dbh;
614 my $s = $dbh->selectall_arrayref(q|
617 WHERE STATUS = 'ASKED'
618 AND budgetid IS NOT NULL
619 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
620 |, { Slice => {} }, $number_of_days_since_the_last_modification );
630 Koha Development Team <http://koha-community.org/>