← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:33:30 2016

Filename/home/vagrant/kohaclone/C4/Suggestions.pm
StatementsExecuted 31 statements in 3.32ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11156µs3.02msC4::Suggestions::::CountSuggestionC4::Suggestions::CountSuggestion
11128µs38µsC4::Suggestions::::BEGIN@21C4::Suggestions::BEGIN@21
11117µs148µsC4::Suggestions::::BEGIN@29C4::Suggestions::BEGIN@29
11117µs53µsC4::Suggestions::::BEGIN@30C4::Suggestions::BEGIN@30
11117µs48µsC4::Suggestions::::BEGIN@32C4::Suggestions::BEGIN@32
11114µs80µsC4::Suggestions::::BEGIN@33C4::Suggestions::BEGIN@33
11113µs67µsC4::Suggestions::::BEGIN@28C4::Suggestions::BEGIN@28
11112µs39µsC4::Suggestions::::BEGIN@24C4::Suggestions::BEGIN@24
11112µs14µsC4::Suggestions::::BEGIN@26C4::Suggestions::BEGIN@26
11111µs102µsC4::Suggestions::::BEGIN@27C4::Suggestions::BEGIN@27
0000s0sC4::Suggestions::::ConnectSuggestionAndBiblioC4::Suggestions::ConnectSuggestionAndBiblio
0000s0sC4::Suggestions::::DelSuggestionC4::Suggestions::DelSuggestion
0000s0sC4::Suggestions::::DelSuggestionsOlderThanC4::Suggestions::DelSuggestionsOlderThan
0000s0sC4::Suggestions::::GetSuggestionC4::Suggestions::GetSuggestion
0000s0sC4::Suggestions::::GetSuggestionByStatusC4::Suggestions::GetSuggestionByStatus
0000s0sC4::Suggestions::::GetSuggestionFromBiblionumberC4::Suggestions::GetSuggestionFromBiblionumber
0000s0sC4::Suggestions::::GetSuggestionInfoC4::Suggestions::GetSuggestionInfo
0000s0sC4::Suggestions::::GetSuggestionInfoFromBiblionumberC4::Suggestions::GetSuggestionInfoFromBiblionumber
0000s0sC4::Suggestions::::GetUnprocessedSuggestionsC4::Suggestions::GetUnprocessedSuggestions
0000s0sC4::Suggestions::::ModSuggestionC4::Suggestions::ModSuggestion
0000s0sC4::Suggestions::::NewSuggestionC4::Suggestions::NewSuggestion
0000s0sC4::Suggestions::::SearchSuggestionC4::Suggestions::SearchSuggestion
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package C4::Suggestions;
2
3# Copyright 2000-2002 Katipo Communications
4# Parts Copyright Biblibre 2011
5#
6# This file is part of Koha.
7#
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.
12#
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.
17#
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>.
20
21265µs248µs
# spent 38µs (28+10) within C4::Suggestions::BEGIN@21 which was called: # once (28µs+10µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 21
use strict;
# spent 38µs making 1 call to C4::Suggestions::BEGIN@21 # spent 10µs making 1 call to strict::import
22
23#use warnings; FIXME - Bug 2505
24271µs266µs
# spent 39µs (12+27) within C4::Suggestions::BEGIN@24 which was called: # once (12µs+27µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 24
use CGI qw ( -utf8 );
# spent 39µs making 1 call to C4::Suggestions::BEGIN@24 # spent 27µs making 1 call to CGI::import
25
26239µs216µs
# spent 14µs (12+2) within C4::Suggestions::BEGIN@26 which was called: # once (12µs+2µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 26
use C4::Context;
# spent 14µs making 1 call to C4::Suggestions::BEGIN@26 # spent 2µs making 1 call to C4::Context::import
272130µs2192µs
# spent 102µs (11+90) within C4::Suggestions::BEGIN@27 which was called: # once (11µs+90µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 27
use C4::Output;
# spent 102µs making 1 call to C4::Suggestions::BEGIN@27 # spent 90µs making 1 call to Exporter::import
28296µs2121µs
# spent 67µs (13+54) within C4::Suggestions::BEGIN@28 which was called: # once (13µs+54µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 28
use C4::Debug;
# spent 67µs making 1 call to C4::Suggestions::BEGIN@28 # spent 54µs making 1 call to Exporter::import
292214µs2278µs
# spent 148µs (17+130) within C4::Suggestions::BEGIN@29 which was called: # once (17µs+130µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 29
use C4::Letters;
# spent 148µs making 1 call to C4::Suggestions::BEGIN@29 # spent 130µs making 1 call to Exporter::import
30286µs288µs
# spent 53µs (17+35) within C4::Suggestions::BEGIN@30 which was called: # once (17µs+35µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 30
use Koha::DateUtils;
# spent 53µs making 1 call to C4::Suggestions::BEGIN@30 # spent 35µs making 1 call to Exporter::import
31
32278µs279µs
# spent 48µs (17+31) within C4::Suggestions::BEGIN@32 which was called: # once (17µs+31µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 32
use List::MoreUtils qw(any);
# spent 48µs making 1 call to C4::Suggestions::BEGIN@32 # spent 31µs making 1 call to Exporter::import
3322.41ms2146µs
# spent 80µs (14+66) within C4::Suggestions::BEGIN@33 which was called: # once (14µs+66µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 33
use base qw(Exporter);
# spent 80µs making 1 call to C4::Suggestions::BEGIN@33 # spent 66µs making 1 call to base::import
34
3511µsour $VERSION = 3.07.00.049;
3612µsour @EXPORT = qw(
37 ConnectSuggestionAndBiblio
38 CountSuggestion
39 DelSuggestion
40 GetSuggestion
41 GetSuggestionByStatus
42 GetSuggestionFromBiblionumber
43 GetSuggestionInfoFromBiblionumber
44 GetSuggestionInfo
45 ModStatus
46 ModSuggestion
47 NewSuggestion
48 SearchSuggestion
49 DelSuggestionsOlderThan
50 GetUnprocessedSuggestions
51);
52
53=head1 NAME
54
55C4::Suggestions - Some useful functions for dealings with aqorders.
56
57=head1 SYNOPSIS
58
59use C4::Suggestions;
60
61=head1 DESCRIPTION
62
63The functions in this module deal with the aqorders in OPAC and in librarian interface
64
65A suggestion is done in the OPAC. It has the status "ASKED"
66
67When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
68
69When the book is ordered, the suggestion status becomes "ORDERED"
70
71When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
72
73All aqorders of a borrower can be seen by the borrower itself.
74Suggestions done by other borrowers can be seen when not "AVAILABLE"
75
76=head1 FUNCTIONS
77
78=head2 SearchSuggestion
79
80(\@array) = &SearchSuggestion($suggestionhashref_to_search)
81
82searches for a suggestion
83
84return :
85C<\@array> : the aqorders found. Array of hash.
86Note the status is stored twice :
87* in the status field
88* as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
89
90=cut
91
92sub SearchSuggestion {
93 my ($suggestion) = @_;
94 my $dbh = C4::Context->dbh;
95 my @sql_params;
96 my @query = (
97 q{
98 SELECT suggestions.*,
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
114 FROM suggestions
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 WHERE 1=1
122 }
123 );
124
125 # filter on biblio informations
126 foreach my $field (
127 qw( title author isbn publishercode copyrightdate collectiontitle ))
128 {
129 if ( $suggestion->{$field} ) {
130 push @sql_params, '%' . $suggestion->{$field} . '%';
131 push @query, qq{ AND suggestions.$field LIKE ? };
132 }
133 }
134
135 # filter on user branch
136 if ( C4::Context->preference('IndependentBranches') ) {
137 my $userenv = C4::Context->userenv;
138 if ($userenv) {
139 if ( !C4::Context->IsSuperLibrarian() && !$suggestion->{branchcode} )
140 {
141 push @sql_params, $$userenv{branch};
142 push @query, q{
143 AND (suggestions.branchcode=? OR suggestions.branchcode='')
144 };
145 }
146 }
147 } else {
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=? };
152 }
153 }
154 }
155
156 # filter on nillable fields
157 foreach my $field (
158 qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
159 )
160 {
161 if ( exists $suggestion->{$field}
162 and defined $suggestion->{$field}
163 and $suggestion->{$field} ne '__ANY__'
164 and $suggestion->{$field} ne q||
165 ) {
166 if ( $suggestion->{$field} eq '__NONE__' ) {
167 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
168 }
169 else {
170 push @sql_params, $suggestion->{$field};
171 push @query, qq{ AND suggestions.$field = ? };
172 }
173 }
174 }
175
176 # filter on date fields
177 foreach my $field (qw( suggesteddate manageddate accepteddate )) {
178 my $from = $field . "_from";
179 my $to = $field . "_to";
180 my $from_dt;
181 $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
182 my $from_sql = '0000-00-00';
183 $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
184 if ($from_dt);
185 $debug && warn "SQL for start date ($field): $from_sql";
186 if ( $suggestion->{$from} || $suggestion->{$to} ) {
187 push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
188 push @sql_params, $from_sql;
189 push @sql_params,
190 output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
191 }
192 }
193
194 $debug && warn "@query";
195 my $sth = $dbh->prepare("@query");
196 $sth->execute(@sql_params);
197 my @results;
198
199 # add status as field
200 while ( my $data = $sth->fetchrow_hashref ) {
201 $data->{ $data->{STATUS} } = 1;
202 push( @results, $data );
203 }
204
205 return ( \@results );
206}
207
208=head2 GetSuggestion
209
210\%sth = &GetSuggestion($suggestionid)
211
212this function get the detail of the suggestion $suggestionid (input arg)
213
214return :
215 the result of the SQL query as a hash : $sth->fetchrow_hashref.
216
217=cut
218
219sub GetSuggestion {
220 my ($suggestionid) = @_;
221 my $dbh = C4::Context->dbh;
222 my $query = q{
223 SELECT *
224 FROM suggestions
225 WHERE suggestionid=?
226 };
227 my $sth = $dbh->prepare($query);
228 $sth->execute($suggestionid);
229 return ( $sth->fetchrow_hashref );
230}
231
232=head2 GetSuggestionFromBiblionumber
233
234$ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
235
236Get a suggestion from it's biblionumber.
237
238return :
239the id of the suggestion which is related to the biblionumber given on input args.
240
241=cut
242
243sub GetSuggestionFromBiblionumber {
244 my ($biblionumber) = @_;
245 my $query = q{
246 SELECT suggestionid
247 FROM suggestions
248 WHERE biblionumber=? LIMIT 1
249 };
250 my $dbh = C4::Context->dbh;
251 my $sth = $dbh->prepare($query);
252 $sth->execute($biblionumber);
253 my ($suggestionid) = $sth->fetchrow;
254 return $suggestionid;
255}
256
257=head2 GetSuggestionInfoFromBiblionumber
258
259Get a suggestion and borrower's informations from it's biblionumber.
260
261return :
262all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
263
264=cut
265
266sub GetSuggestionInfoFromBiblionumber {
267 my ($biblionumber) = @_;
268 my $query = q{
269 SELECT suggestions.*,
270 U1.surname AS surnamesuggestedby,
271 U1.firstname AS firstnamesuggestedby,
272 U1.borrowernumber AS borrnumsuggestedby
273 FROM suggestions
274 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
275 WHERE biblionumber=?
276 LIMIT 1
277 };
278 my $dbh = C4::Context->dbh;
279 my $sth = $dbh->prepare($query);
280 $sth->execute($biblionumber);
281 return $sth->fetchrow_hashref;
282}
283
284=head2 GetSuggestionInfo
285
286Get a suggestion and borrower's informations from it's suggestionid
287
288return :
289all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
290
291=cut
292
293sub GetSuggestionInfo {
294 my ($suggestionid) = @_;
295 my $query = q{
296 SELECT suggestions.*,
297 U1.surname AS surnamesuggestedby,
298 U1.firstname AS firstnamesuggestedby,
299 U1.borrowernumber AS borrnumsuggestedby
300 FROM suggestions
301 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
302 WHERE suggestionid=?
303 LIMIT 1
304 };
305 my $dbh = C4::Context->dbh;
306 my $sth = $dbh->prepare($query);
307 $sth->execute($suggestionid);
308 return $sth->fetchrow_hashref;
309}
310
311=head2 GetSuggestionByStatus
312
313$aqorders = &GetSuggestionByStatus($status,[$branchcode])
314
315Get a suggestion from it's status
316
317return :
318all the suggestion with C<$status>
319
320=cut
321
322sub GetSuggestionByStatus {
323 my $status = shift;
324 my $branchcode = shift;
325 my $dbh = C4::Context->dbh;
326 my @sql_params = ($status);
327 my $query = q{
328 SELECT suggestions.*,
329 U1.surname AS surnamesuggestedby,
330 U1.firstname AS firstnamesuggestedby,
331 U1.branchcode AS branchcodesuggestedby,
332 B1.branchname AS branchnamesuggestedby,
333 U1.borrowernumber AS borrnumsuggestedby,
334 U1.categorycode AS categorycodesuggestedby,
335 C1.description AS categorydescriptionsuggestedby,
336 U2.surname AS surnamemanagedby,
337 U2.firstname AS firstnamemanagedby,
338 U2.borrowernumber AS borrnummanagedby
339 FROM suggestions
340 LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
341 LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
342 LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
343 LEFT JOIN branches AS B1 on B1.branchcode=U1.branchcode
344 WHERE status = ?
345 };
346
347 # filter on branch
348 if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
349 my $userenv = C4::Context->userenv;
350 if ($userenv) {
351 unless ( C4::Context->IsSuperLibrarian() ) {
352 push @sql_params, $userenv->{branch};
353 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
354 }
355 }
356 if ($branchcode) {
357 push @sql_params, $branchcode;
358 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
359 }
360 }
361
362 my $sth = $dbh->prepare($query);
363 $sth->execute(@sql_params);
364 my $results;
365 $results = $sth->fetchall_arrayref( {} );
366 return $results;
367}
368
369=head2 CountSuggestion
370
371&CountSuggestion($status)
372
373Count the number of aqorders with the status given on input argument.
374the arg status can be :
375
376=over 2
377
378=item * ASKED : asked by the user, not dealed by the librarian
379
380=item * ACCEPTED : accepted by the librarian, but not yet ordered
381
382=item * REJECTED : rejected by the librarian (definitive status)
383
384=item * ORDERED : ordered by the librarian (acquisition module)
385
386=back
387
388return :
389the number of suggestion with this status.
390
391=cut
392
393
# spent 3.02ms (56µs+2.97) within C4::Suggestions::CountSuggestion which was called: # once (56µs+2.97ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::__ANON__[/home/vagrant/kohaclone/mainpage.pl:107] at line 67 of mainpage.pl
sub CountSuggestion {
3941700ns my ($status) = @_;
39516µs187µs my $dbh = C4::Context->dbh;
# spent 87µs making 1 call to C4::Context::dbh
3961400ns my $sth;
397111µs16µs my $userenv = C4::Context->userenv;
# spent 6µs making 1 call to C4::Context::userenv
39817µs12.77ms if ( C4::Context->preference("IndependentBranches")
# spent 2.77ms making 1 call to C4::Context::preference
399 && !C4::Context->IsSuperLibrarian() )
400 {
401 my $query = q{
402 SELECT count(*)
403 FROM suggestions
404 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
405 WHERE STATUS=?
406 AND (borrowers.branchcode='' OR borrowers.branchcode=?)
407 };
408 $sth = $dbh->prepare($query);
409 $sth->execute( $status, $userenv->{branch} );
410 }
411 else {
4121700ns my $query = q{
413 SELECT count(*)
414 FROM suggestions
415 WHERE STATUS=?
416 };
417110µs295µs $sth = $dbh->prepare($query);
# spent 50µs making 1 call to DBI::db::prepare # spent 45µs making 1 call to DBD::mysql::db::prepare
418148µs142µs $sth->execute($status);
# spent 42µs making 1 call to DBI::st::execute
419 }
42019µs13µs my ($result) = $sth->fetchrow;
# spent 3µs making 1 call to DBI::st::fetchrow
421128µs return $result;
422}
423
424=head2 NewSuggestion
425
426
427&NewSuggestion($suggestion);
428
429Insert a new suggestion on database with value given on input arg.
430
431=cut
432
433sub NewSuggestion {
434 my ($suggestion) = @_;
435
436 for my $field ( qw(
437 suggestedby
438 managedby
439 manageddate
440 acceptedby
441 accepteddate
442 rejectedby
443 rejecteddate
444 budgetid
445 ) ) {
446 # Set the fields to NULL if not given.
447 $suggestion->{$field} ||= undef;
448 }
449
450 $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
451
452 $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
453
454 my $rs = Koha::Database->new->schema->resultset('Suggestion');
455 return $rs->create($suggestion)->id;
456}
457
458=head2 ModSuggestion
459
460&ModSuggestion($suggestion)
461
462Modify the suggestion according to the hash passed by ref.
463The hash HAS to contain suggestionid
464Data not defined is not updated unless it is a note or sort1
465Send a mail to notify the user that did the suggestion.
466
467Note that there is no function to modify a suggestion.
468
469=cut
470
471sub ModSuggestion {
472 my ($suggestion) = @_;
473 return unless( $suggestion and defined($suggestion->{suggestionid}) );
474
475 for my $field ( qw(
476 suggestedby
477 managedby
478 manageddate
479 acceptedby
480 accepteddate
481 rejectedby
482 rejecteddate
483 budgetid
484 ) ) {
485 # Set the fields to NULL if not given.
486 $suggestion->{$field} = undef
487 if exists $suggestion->{$field}
488 and ($suggestion->{$field} eq '0'
489 or $suggestion->{$field} eq '' );
490 }
491
492 my $rs = Koha::Database->new->schema->resultset('Suggestion')->find($suggestion->{suggestionid});
493 my $status_update_table = 1;
494 eval {
495 $rs->update($suggestion);
496 };
497 $status_update_table = 0 if( $@ );
498
499 if ( $suggestion->{STATUS} ) {
500
501 # fetch the entire updated suggestion so that we can populate the letter
502 my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
503 if (
504 my $letter = C4::Letters::GetPreparedLetter(
505 module => 'suggestions',
506 letter_code => $full_suggestion->{STATUS},
507 branchcode => $full_suggestion->{branchcode},
508 tables => {
509 'branches' => $full_suggestion->{branchcode},
510 'borrowers' => $full_suggestion->{suggestedby},
511 'suggestions' => $full_suggestion,
512 'biblio' => $full_suggestion->{biblionumber},
513 },
514 )
515 )
516 {
517 C4::Letters::EnqueueLetter(
518 {
519 letter => $letter,
520 borrowernumber => $full_suggestion->{suggestedby},
521 suggestionid => $full_suggestion->{suggestionid},
522 LibraryName => C4::Context->preference("LibraryName"),
523 message_transport_type => 'email',
524 }
525 ) or warn "can't enqueue letter $letter";
526 }
527 }
528 return $status_update_table;
529}
530
531=head2 ConnectSuggestionAndBiblio
532
533&ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
534
535connect a suggestion to an existing biblio
536
537=cut
538
539sub ConnectSuggestionAndBiblio {
540 my ( $suggestionid, $biblionumber ) = @_;
541 my $dbh = C4::Context->dbh;
542 my $query = q{
543 UPDATE suggestions
544 SET biblionumber=?
545 WHERE suggestionid=?
546 };
547 my $sth = $dbh->prepare($query);
548 $sth->execute( $biblionumber, $suggestionid );
549}
550
551=head2 DelSuggestion
552
553&DelSuggestion($borrowernumber,$ordernumber)
554
555Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
556
557=cut
558
559sub DelSuggestion {
560 my ( $borrowernumber, $suggestionid, $type ) = @_;
561 my $dbh = C4::Context->dbh;
562
563 # check that the suggestion comes from the suggestor
564 my $query = q{
565 SELECT suggestedby
566 FROM suggestions
567 WHERE suggestionid=?
568 };
569 my $sth = $dbh->prepare($query);
570 $sth->execute($suggestionid);
571 my ($suggestedby) = $sth->fetchrow;
572 if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
573 my $queryDelete = q{
574 DELETE FROM suggestions
575 WHERE suggestionid=?
576 };
577 $sth = $dbh->prepare($queryDelete);
578 my $suggestiondeleted = $sth->execute($suggestionid);
579 return $suggestiondeleted;
580 }
581}
582
583=head2 DelSuggestionsOlderThan
584 &DelSuggestionsOlderThan($days)
585
586 Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
587
588=cut
589
590sub DelSuggestionsOlderThan {
591 my ($days) = @_;
592 return unless $days;
593 my $dbh = C4::Context->dbh;
594 my $sth = $dbh->prepare(
595 q{
596 DELETE FROM suggestions
597 WHERE STATUS<>'ASKED'
598 AND date < ADDDATE(NOW(), ?)
599 }
600 );
601 $sth->execute("-$days");
602}
603
604sub GetUnprocessedSuggestions {
605 my ( $number_of_days_since_the_last_modification ) = @_;
606
607 $number_of_days_since_the_last_modification ||= 0;
608
609 my $dbh = C4::Context->dbh;
610
611 my $s = $dbh->selectall_arrayref(q|
612 SELECT *
613 FROM suggestions
614 WHERE STATUS = 'ASKED'
615 AND budgetid IS NOT NULL
616 AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
617 |, { Slice => {} }, $number_of_days_since_the_last_modification );
618 return $s;
619}
620
62115µs1;
622__END__