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, 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.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
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('IndependentBranches') ) {
136 my $userenv = C4
::Context
->userenv;
138 if ( !C4
::Context
->IsSuperLibrarian() && !$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
=?
};
155 # filter on nillable fields
157 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
160 if ( exists $suggestion->{$field}
161 and defined $suggestion->{$field}
162 and $suggestion->{$field} ne '__ANY__'
164 $suggestion->{$field} ne q
||
165 or $field eq 'STATUS'
168 if ( $suggestion->{$field} eq '__NONE__' ) {
169 push @query, qq{ AND
(suggestions
.$field = '' OR suggestions
.$field IS NULL
) };
172 push @sql_params, $suggestion->{$field};
173 push @query, qq{ AND suggestions
.$field = ?
};
178 # filter on date fields
179 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
180 my $from = $field . "_from";
181 my $to = $field . "_to";
183 $from_dt = eval { dt_from_string
( $suggestion->{$from} ) } if ( $suggestion->{$from} );
184 my $from_sql = '0000-00-00';
185 $from_sql = output_pref
({ dt
=> $from_dt, dateformat
=> 'iso', dateonly
=> 1 })
187 $debug && warn "SQL for start date ($field): $from_sql";
188 if ( $suggestion->{$from} || $suggestion->{$to} ) {
189 push @query, qq{ AND suggestions
.$field BETWEEN ? AND ?
};
190 push @sql_params, $from_sql;
192 output_pref
({ dt
=> dt_from_string
( $suggestion->{$to} ), dateformat
=> 'iso', dateonly
=> 1 }) || output_pref
({ dt
=> dt_from_string
, dateformat
=> 'iso', dateonly
=> 1 });
196 $debug && warn "@query";
197 my $sth = $dbh->prepare("@query");
198 $sth->execute(@sql_params);
201 # add status as field
202 while ( my $data = $sth->fetchrow_hashref ) {
203 $data->{ $data->{STATUS
} } = 1;
204 push( @results, $data );
207 return ( \
@results );
212 \%sth = &GetSuggestion($suggestionid)
214 this function get the detail of the suggestion $suggestionid (input arg)
217 the result of the SQL query as a hash : $sth->fetchrow_hashref.
222 my ($suggestionid) = @_;
223 my $dbh = C4
::Context
->dbh;
229 my $sth = $dbh->prepare($query);
230 $sth->execute($suggestionid);
231 return ( $sth->fetchrow_hashref );
234 =head2 GetSuggestionFromBiblionumber
236 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
238 Get a suggestion from it's biblionumber.
241 the id of the suggestion which is related to the biblionumber given on input args.
245 sub GetSuggestionFromBiblionumber
{
246 my ($biblionumber) = @_;
250 WHERE biblionumber=? LIMIT 1
252 my $dbh = C4
::Context
->dbh;
253 my $sth = $dbh->prepare($query);
254 $sth->execute($biblionumber);
255 my ($suggestionid) = $sth->fetchrow;
256 return $suggestionid;
259 =head2 GetSuggestionInfoFromBiblionumber
261 Get a suggestion and borrower's informations from it's biblionumber.
264 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
268 sub GetSuggestionInfoFromBiblionumber
{
269 my ($biblionumber) = @_;
271 SELECT suggestions.*,
272 U1.surname AS surnamesuggestedby,
273 U1.firstname AS firstnamesuggestedby,
274 U1.borrowernumber AS borrnumsuggestedby
276 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
280 my $dbh = C4
::Context
->dbh;
281 my $sth = $dbh->prepare($query);
282 $sth->execute($biblionumber);
283 return $sth->fetchrow_hashref;
286 =head2 GetSuggestionInfo
288 Get a suggestion and borrower's informations from it's suggestionid
291 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
295 sub GetSuggestionInfo
{
296 my ($suggestionid) = @_;
298 SELECT suggestions.*,
299 U1.surname AS surnamesuggestedby,
300 U1.firstname AS firstnamesuggestedby,
301 U1.borrowernumber AS borrnumsuggestedby
303 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
307 my $dbh = C4
::Context
->dbh;
308 my $sth = $dbh->prepare($query);
309 $sth->execute($suggestionid);
310 return $sth->fetchrow_hashref;
313 =head2 GetSuggestionByStatus
315 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
317 Get a suggestion from it's status
320 all the suggestion with C<$status>
324 sub GetSuggestionByStatus
{
326 my $branchcode = shift;
327 my $dbh = C4
::Context
->dbh;
328 my @sql_params = ($status);
330 SELECT suggestions.*,
331 U1.surname AS surnamesuggestedby,
332 U1.firstname AS firstnamesuggestedby,
333 U1.branchcode AS branchcodesuggestedby,
334 B1.branchname AS branchnamesuggestedby,
335 U1.borrowernumber AS borrnumsuggestedby,
336 U1.categorycode AS categorycodesuggestedby,
337 C1.description AS categorydescriptionsuggestedby,
338 U2.surname AS surnamemanagedby,
339 U2.firstname AS firstnamemanagedby,
340 U2.borrowernumber AS borrnummanagedby
342 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
343 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
344 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
345 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
350 if ( C4
::Context
->preference("IndependentBranches") || $branchcode ) {
351 my $userenv = C4
::Context
->userenv;
353 unless ( C4
::Context
->IsSuperLibrarian() ) {
354 push @sql_params, $userenv->{branch
};
355 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
359 push @sql_params, $branchcode;
360 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
364 my $sth = $dbh->prepare($query);
365 $sth->execute(@sql_params);
367 $results = $sth->fetchall_arrayref( {} );
371 =head2 CountSuggestion
373 &CountSuggestion($status)
375 Count the number of aqorders with the status given on input argument.
376 the arg status can be :
380 =item * ASKED : asked by the user, not dealed by the librarian
382 =item * ACCEPTED : accepted by the librarian, but not yet ordered
384 =item * REJECTED : rejected by the librarian (definitive status)
386 =item * ORDERED : ordered by the librarian (acquisition module)
391 the number of suggestion with this status.
395 sub CountSuggestion
{
397 my $dbh = C4
::Context
->dbh;
399 my $userenv = C4
::Context
->userenv;
400 if ( C4
::Context
->preference("IndependentBranches")
401 && !C4
::Context
->IsSuperLibrarian() )
406 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
408 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
410 $sth = $dbh->prepare($query);
411 $sth->execute( $status, $userenv->{branch
} );
419 $sth = $dbh->prepare($query);
420 $sth->execute($status);
422 my ($result) = $sth->fetchrow;
429 &NewSuggestion($suggestion);
431 Insert a new suggestion on database with value given on input arg.
436 my ($suggestion) = @_;
448 # Set the fields to NULL if not given.
449 $suggestion->{$field} ||= undef;
452 $suggestion->{STATUS
} = "ASKED" unless $suggestion->{STATUS
};
454 $suggestion->{suggesteddate
} = dt_from_string
unless $suggestion->{suggesteddate
};
456 my $rs = Koha
::Database
->new->schema->resultset('Suggestion');
457 return $rs->create($suggestion)->id;
462 &ModSuggestion($suggestion)
464 Modify the suggestion according to the hash passed by ref.
465 The hash HAS to contain suggestionid
466 Data not defined is not updated unless it is a note or sort1
467 Send a mail to notify the user that did the suggestion.
469 Note that there is no function to modify a suggestion.
474 my ($suggestion) = @_;
475 return unless( $suggestion and defined($suggestion->{suggestionid
}) );
487 # Set the fields to NULL if not given.
488 $suggestion->{$field} = undef
489 if exists $suggestion->{$field}
490 and ($suggestion->{$field} eq '0'
491 or $suggestion->{$field} eq '' );
494 my $rs = Koha
::Database
->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid
});
495 my $status_update_table = 1;
497 $rs->update($suggestion);
499 $status_update_table = 0 if( $@
);
501 if ( $suggestion->{STATUS
} ) {
503 # fetch the entire updated suggestion so that we can populate the letter
504 my $full_suggestion = GetSuggestion
( $suggestion->{suggestionid
} );
506 my $letter = C4
::Letters
::GetPreparedLetter
(
507 module
=> 'suggestions',
508 letter_code
=> $full_suggestion->{STATUS
},
509 branchcode
=> $full_suggestion->{branchcode
},
511 'branches' => $full_suggestion->{branchcode
},
512 'borrowers' => $full_suggestion->{suggestedby
},
513 'suggestions' => $full_suggestion,
514 'biblio' => $full_suggestion->{biblionumber
},
519 C4
::Letters
::EnqueueLetter
(
522 borrowernumber
=> $full_suggestion->{suggestedby
},
523 suggestionid
=> $full_suggestion->{suggestionid
},
524 LibraryName
=> C4
::Context
->preference("LibraryName"),
525 message_transport_type
=> 'email',
527 ) or warn "can't enqueue letter $letter";
530 return $status_update_table;
533 =head2 ConnectSuggestionAndBiblio
535 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
537 connect a suggestion to an existing biblio
541 sub ConnectSuggestionAndBiblio
{
542 my ( $suggestionid, $biblionumber ) = @_;
543 my $dbh = C4
::Context
->dbh;
549 my $sth = $dbh->prepare($query);
550 $sth->execute( $biblionumber, $suggestionid );
555 &DelSuggestion($borrowernumber,$ordernumber)
557 Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
562 my ( $borrowernumber, $suggestionid, $type ) = @_;
563 my $dbh = C4
::Context
->dbh;
565 # check that the suggestion comes from the suggestor
571 my $sth = $dbh->prepare($query);
572 $sth->execute($suggestionid);
573 my ($suggestedby) = $sth->fetchrow;
574 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
576 DELETE FROM suggestions
579 $sth = $dbh->prepare($queryDelete);
580 my $suggestiondeleted = $sth->execute($suggestionid);
581 return $suggestiondeleted;
585 =head2 DelSuggestionsOlderThan
586 &DelSuggestionsOlderThan($days)
588 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
592 sub DelSuggestionsOlderThan
{
595 my $dbh = C4
::Context
->dbh;
596 my $sth = $dbh->prepare(
598 DELETE FROM suggestions
599 WHERE STATUS<>'ASKED'
600 AND date < ADDDATE(NOW(), ?)
603 $sth->execute("-$days");
606 sub GetUnprocessedSuggestions
{
607 my ( $number_of_days_since_the_last_modification ) = @_;
609 $number_of_days_since_the_last_modification ||= 0;
611 my $dbh = C4
::Context
->dbh;
613 my $s = $dbh->selectall_arrayref(q
|
616 WHERE STATUS
= 'ASKED'
617 AND budgetid IS NOT NULL
618 AND CAST
(NOW
() AS DATE
) - INTERVAL ? DAY
= CAST
(suggesteddate AS DATE
)
619 |, { Slice
=> {} }, $number_of_days_since_the_last_modification );
629 Koha Development Team <http://koha-community.org/>