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);
36 ConnectSuggestionAndBiblio
41 GetSuggestionFromBiblionumber
42 GetSuggestionInfoFromBiblionumber
48 DelSuggestionsOlderThan
49 GetUnprocessedSuggestions
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, they 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.cardnumber AS cardnumbersuggestedby,
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,
113 BU.budget_name AS budget_name
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
121 LEFT JOIN aqbudgets AS BU ON budgetid=BU.budget_id
126 # filter on biblio informations
128 qw( title author isbn publishercode copyrightdate collectiontitle ))
130 if ( $suggestion->{$field} ) {
131 push @sql_params, '%' . $suggestion->{$field} . '%';
132 push @query, qq{ AND suggestions
.$field LIKE ?
};
136 # filter on user branch
137 if ( C4
::Context
->preference('IndependentBranches') ) {
138 my $userenv = C4
::Context
->userenv;
140 if ( !C4
::Context
->IsSuperLibrarian() && !$suggestion->{branchcode
} )
142 push @sql_params, $$userenv{branch
};
144 AND (suggestions.branchcode=? OR suggestions.branchcode='')
149 if ( defined $suggestion->{branchcode
} && $suggestion->{branchcode
} ) {
150 unless ( $suggestion->{branchcode
} eq '__ANY__' ) {
151 push @sql_params, $suggestion->{branchcode
};
152 push @query, qq{ AND suggestions
.branchcode
=?
};
157 # filter on nillable fields
159 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
162 if ( exists $suggestion->{$field}
163 and defined $suggestion->{$field}
164 and $suggestion->{$field} ne '__ANY__'
166 $suggestion->{$field} ne q
||
167 or $field eq 'STATUS'
170 if ( $suggestion->{$field} eq '__NONE__' ) {
171 push @query, qq{ AND
(suggestions
.$field = '' OR suggestions
.$field IS NULL
) };
174 push @sql_params, $suggestion->{$field};
175 push @query, qq{ AND suggestions
.$field = ?
};
180 # filter on date fields
181 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
182 my $from = $field . "_from";
183 my $to = $field . "_to";
185 $from_dt = eval { dt_from_string
( $suggestion->{$from} ) } if ( $suggestion->{$from} );
186 my $from_sql = '0000-00-00';
187 $from_sql = output_pref
({ dt
=> $from_dt, dateformat
=> 'iso', dateonly
=> 1 })
189 $debug && warn "SQL for start date ($field): $from_sql";
190 if ( $suggestion->{$from} || $suggestion->{$to} ) {
191 push @query, qq{ AND suggestions
.$field BETWEEN ? AND ?
};
192 push @sql_params, $from_sql;
194 output_pref
({ dt
=> dt_from_string
( $suggestion->{$to} ), dateformat
=> 'iso', dateonly
=> 1 }) || output_pref
({ dt
=> dt_from_string
, dateformat
=> 'iso', dateonly
=> 1 });
198 $debug && warn "@query";
199 my $sth = $dbh->prepare("@query");
200 $sth->execute(@sql_params);
203 # add status as field
204 while ( my $data = $sth->fetchrow_hashref ) {
205 $data->{ $data->{STATUS
} } = 1;
206 push( @results, $data );
209 return ( \
@results );
214 \%sth = &GetSuggestion($suggestionid)
216 this function get the detail of the suggestion $suggestionid (input arg)
219 the result of the SQL query as a hash : $sth->fetchrow_hashref.
224 my ($suggestionid) = @_;
225 my $dbh = C4
::Context
->dbh;
231 my $sth = $dbh->prepare($query);
232 $sth->execute($suggestionid);
233 return ( $sth->fetchrow_hashref );
236 =head2 GetSuggestionFromBiblionumber
238 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
240 Get a suggestion from it's biblionumber.
243 the id of the suggestion which is related to the biblionumber given on input args.
247 sub GetSuggestionFromBiblionumber
{
248 my ($biblionumber) = @_;
252 WHERE biblionumber=? LIMIT 1
254 my $dbh = C4
::Context
->dbh;
255 my $sth = $dbh->prepare($query);
256 $sth->execute($biblionumber);
257 my ($suggestionid) = $sth->fetchrow;
258 return $suggestionid;
261 =head2 GetSuggestionInfoFromBiblionumber
263 Get a suggestion and borrower's informations from it's biblionumber.
266 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
270 sub GetSuggestionInfoFromBiblionumber
{
271 my ($biblionumber) = @_;
273 SELECT suggestions.*,
274 U1.surname AS surnamesuggestedby,
275 U1.firstname AS firstnamesuggestedby,
276 U1.borrowernumber AS borrnumsuggestedby
278 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
282 my $dbh = C4
::Context
->dbh;
283 my $sth = $dbh->prepare($query);
284 $sth->execute($biblionumber);
285 return $sth->fetchrow_hashref;
288 =head2 GetSuggestionInfo
290 Get a suggestion and borrower's informations from it's suggestionid
293 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
297 sub GetSuggestionInfo
{
298 my ($suggestionid) = @_;
300 SELECT suggestions.*,
301 U1.surname AS surnamesuggestedby,
302 U1.firstname AS firstnamesuggestedby,
303 U1.borrowernumber AS borrnumsuggestedby
305 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
309 my $dbh = C4
::Context
->dbh;
310 my $sth = $dbh->prepare($query);
311 $sth->execute($suggestionid);
312 return $sth->fetchrow_hashref;
315 =head2 GetSuggestionByStatus
317 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
319 Get a suggestion from it's status
322 all the suggestion with C<$status>
326 sub GetSuggestionByStatus
{
328 my $branchcode = shift;
329 my $dbh = C4
::Context
->dbh;
330 my @sql_params = ($status);
332 SELECT suggestions.*,
333 U1.surname AS surnamesuggestedby,
334 U1.firstname AS firstnamesuggestedby,
335 U1.branchcode AS branchcodesuggestedby,
336 B1.branchname AS branchnamesuggestedby,
337 U1.borrowernumber AS borrnumsuggestedby,
338 U1.categorycode AS categorycodesuggestedby,
339 C1.description AS categorydescriptionsuggestedby,
340 U2.surname AS surnamemanagedby,
341 U2.firstname AS firstnamemanagedby,
342 U2.borrowernumber AS borrnummanagedby
344 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
345 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
346 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
347 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
352 if ( C4
::Context
->preference("IndependentBranches") || $branchcode ) {
353 my $userenv = C4
::Context
->userenv;
355 unless ( C4
::Context
->IsSuperLibrarian() ) {
356 push @sql_params, $userenv->{branch
};
357 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
361 push @sql_params, $branchcode;
362 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
366 my $sth = $dbh->prepare($query);
367 $sth->execute(@sql_params);
369 $results = $sth->fetchall_arrayref( {} );
373 =head2 CountSuggestion
375 &CountSuggestion($status)
377 Count the number of aqorders with the status given on input argument.
378 the arg status can be :
382 =item * ASKED : asked by the user, not dealed by the librarian
384 =item * ACCEPTED : accepted by the librarian, but not yet ordered
386 =item * REJECTED : rejected by the librarian (definitive status)
388 =item * ORDERED : ordered by the librarian (acquisition module)
393 the number of suggestion with this status.
397 sub CountSuggestion
{
399 my $dbh = C4
::Context
->dbh;
401 my $userenv = C4
::Context
->userenv;
402 if ( C4
::Context
->preference("IndependentBranches")
403 && !C4
::Context
->IsSuperLibrarian() )
408 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
410 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
412 $sth = $dbh->prepare($query);
413 $sth->execute( $status, $userenv->{branch
} );
421 $sth = $dbh->prepare($query);
422 $sth->execute($status);
424 my ($result) = $sth->fetchrow;
431 &NewSuggestion($suggestion);
433 Insert a new suggestion on database with value given on input arg.
438 my ($suggestion) = @_;
450 # Set the fields to NULL if not given.
451 $suggestion->{$field} ||= undef;
454 $suggestion->{STATUS
} = "ASKED" unless $suggestion->{STATUS
};
456 $suggestion->{suggesteddate
} = dt_from_string
unless $suggestion->{suggesteddate
};
458 my $suggestion_object = Koha
::Suggestion
->new( $suggestion )->store;
459 my $suggestion_id = $suggestion_object->suggestionid;
461 my $emailpurchasesuggestions = C4
::Context
->preference("EmailPurchaseSuggestions");
462 if ($emailpurchasesuggestions) {
463 my $full_suggestion = GetSuggestion
( $suggestion_id); # We should not need to refetch it!
465 my $letter = C4
::Letters
::GetPreparedLetter
(
466 module
=> 'suggestions',
467 letter_code
=> 'NEW_SUGGESTION',
469 'branches' => $full_suggestion->{branchcode
},
470 'borrowers' => $full_suggestion->{suggestedby
},
471 'suggestions' => $full_suggestion,
477 if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
479 Koha
::Libraries
->find( $full_suggestion->{branchcode
} );
481 $library->branchreplyto
482 || $library->branchemail
483 || C4
::Context
->preference('ReplytoDefault')
484 || C4
::Context
->preference('KohaAdminEmailAddress');
486 elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
487 $toaddress = C4
::Context
->preference('ReplytoDefault')
488 || C4
::Context
->preference('KohaAdminEmailAddress');
492 C4
::Context
->preference($emailpurchasesuggestions)
493 || C4
::Context
->preference('ReplytoDefault')
494 || C4
::Context
->preference('KohaAdminEmailAddress');
497 C4
::Letters
::EnqueueLetter
(
500 borrowernumber
=> $full_suggestion->{suggestedby
},
501 suggestionid
=> $full_suggestion->{suggestionid
},
502 to_address
=> $toaddress,
503 message_transport_type
=> 'email',
505 ) or warn "can't enqueue letter $letter";
509 return $suggestion_id;
514 &ModSuggestion($suggestion)
516 Modify the suggestion according to the hash passed by ref.
517 The hash HAS to contain suggestionid
518 Data not defined is not updated unless it is a note or sort1
519 Send a mail to notify the user that did the suggestion.
521 Note that there is no function to modify a suggestion.
526 my ($suggestion) = @_;
527 return unless( $suggestion and defined($suggestion->{suggestionid
}) );
539 # Set the fields to NULL if not given.
540 $suggestion->{$field} = undef
541 if exists $suggestion->{$field}
542 and ($suggestion->{$field} eq '0'
543 or $suggestion->{$field} eq '' );
546 my $suggestion_object = Koha
::Suggestions
->find( $suggestion->{suggestionid
} );
547 eval { # FIXME Must raise an exception instead
548 $suggestion_object->set($suggestion)->store;
552 if ( $suggestion->{STATUS
} ) {
554 # fetch the entire updated suggestion so that we can populate the letter
555 my $full_suggestion = GetSuggestion
( $suggestion->{suggestionid
} );
556 my $patron = Koha
::Patrons
->find( $full_suggestion->{suggestedby
} );
558 my $transport = (C4
::Context
->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ?
'sms' : 'email';
561 my $letter = C4
::Letters
::GetPreparedLetter
(
562 module
=> 'suggestions',
563 letter_code
=> $full_suggestion->{STATUS
},
564 branchcode
=> $full_suggestion->{branchcode
},
565 lang
=> $patron->lang,
567 'branches' => $full_suggestion->{branchcode
},
568 'borrowers' => $full_suggestion->{suggestedby
},
569 'suggestions' => $full_suggestion,
570 'biblio' => $full_suggestion->{biblionumber
},
575 C4
::Letters
::EnqueueLetter
(
578 borrowernumber
=> $full_suggestion->{suggestedby
},
579 suggestionid
=> $full_suggestion->{suggestionid
},
580 LibraryName
=> C4
::Context
->preference("LibraryName"),
581 message_transport_type
=> $transport,
583 ) or warn "can't enqueue letter $letter";
586 return 1; # No useful if the exception is raised earlier
589 =head2 ConnectSuggestionAndBiblio
591 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
593 connect a suggestion to an existing biblio
597 sub ConnectSuggestionAndBiblio
{
598 my ( $suggestionid, $biblionumber ) = @_;
599 my $dbh = C4
::Context
->dbh;
605 my $sth = $dbh->prepare($query);
606 $sth->execute( $biblionumber, $suggestionid );
611 &DelSuggestion($borrowernumber,$ordernumber)
613 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
618 my ( $borrowernumber, $suggestionid, $type ) = @_;
619 my $dbh = C4
::Context
->dbh;
621 # check that the suggestion comes from the suggestor
627 my $sth = $dbh->prepare($query);
628 $sth->execute($suggestionid);
629 my ($suggestedby) = $sth->fetchrow;
630 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
632 DELETE FROM suggestions
635 $sth = $dbh->prepare($queryDelete);
636 my $suggestiondeleted = $sth->execute($suggestionid);
637 return $suggestiondeleted;
641 =head2 DelSuggestionsOlderThan
642 &DelSuggestionsOlderThan($days)
644 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
645 We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
649 sub DelSuggestionsOlderThan
{
651 return unless $days && $days > 0;
652 my $dbh = C4
::Context
->dbh;
653 my $sth = $dbh->prepare(
655 DELETE FROM suggestions
656 WHERE STATUS<>'ASKED'
657 AND date < ADDDATE(NOW(), ?)
660 $sth->execute("-$days");
663 sub GetUnprocessedSuggestions
{
664 my ( $number_of_days_since_the_last_modification ) = @_;
666 $number_of_days_since_the_last_modification ||= 0;
668 my $dbh = C4
::Context
->dbh;
670 my $s = $dbh->selectall_arrayref(q
|
673 WHERE STATUS
= 'ASKED'
674 AND budgetid IS NOT NULL
675 AND CAST
(NOW
() AS DATE
) - INTERVAL ? DAY
= CAST
(suggesteddate AS DATE
)
676 |, { Slice
=> {} }, $number_of_days_since_the_last_modification );
686 Koha Development Team <http://koha-community.org/>