Profile of C4/Suggestions.pm

Filename	/home/vagrant/kohaclone/C4/Suggestions.pm
Statements	Executed 31 statements in 2.38ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	63µs	2.54ms	C4::Suggestions::::CountSuggestionC4::Suggestions::CountSuggestion
1	1	1	24µs	36µs	C4::Suggestions::::BEGIN@21C4::Suggestions::BEGIN@21
1	1	1	13µs	126µs	C4::Suggestions::::BEGIN@29C4::Suggestions::BEGIN@29
1	1	1	13µs	105µs	C4::Suggestions::::BEGIN@27C4::Suggestions::BEGIN@27
1	1	1	13µs	42µs	C4::Suggestions::::BEGIN@24C4::Suggestions::BEGIN@24
1	1	1	12µs	54µs	C4::Suggestions::::BEGIN@28C4::Suggestions::BEGIN@28
1	1	1	12µs	37µs	C4::Suggestions::::BEGIN@30C4::Suggestions::BEGIN@30
1	1	1	12µs	60µs	C4::Suggestions::::BEGIN@33C4::Suggestions::BEGIN@33
1	1	1	12µs	26µs	C4::Suggestions::::BEGIN@32C4::Suggestions::BEGIN@32
1	1	1	10µs	14µs	C4::Suggestions::::BEGIN@26C4::Suggestions::BEGIN@26
0	0	0	0s	0s	C4::Suggestions::ConnectSuggestionAndBiblio
0	0	0	0s	0s	C4::Suggestions::::DelSuggestionC4::Suggestions::DelSuggestion
0	0	0	0s	0s	C4::Suggestions::DelSuggestionsOlderThan
0	0	0	0s	0s	C4::Suggestions::::GetSuggestionC4::Suggestions::GetSuggestion
0	0	0	0s	0s	C4::Suggestions::GetSuggestionByStatus
0	0	0	0s	0s	C4::Suggestions::GetSuggestionFromBiblionumber
0	0	0	0s	0s	C4::Suggestions::::GetSuggestionInfoC4::Suggestions::GetSuggestionInfo
0	0	0	0s	0s	C4::Suggestions::GetSuggestionInfoFromBiblionumber
0	0	0	0s	0s	C4::Suggestions::GetUnprocessedSuggestions
0	0	0	0s	0s	C4::Suggestions::::ModSuggestionC4::Suggestions::ModSuggestion
0	0	0	0s	0s	C4::Suggestions::::NewSuggestionC4::Suggestions::NewSuggestion
0	0	0	0s	0s	C4::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
1					package 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
21	2	53µs	2	48µs	# spent 36µs (24+12) within C4::Suggestions::BEGIN@21 which was called: # once (24µs+12µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 21 use strict; # spent 36µs making 1 call to C4::Suggestions::BEGIN@21 # spent 12µs making 1 call to strict::import
22
23					#use warnings; FIXME - Bug 2505
24	2	64µs	2	72µs	# spent 42µs (13+30) within C4::Suggestions::BEGIN@24 which was called: # once (13µs+30µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 24 use CGI qw ( -utf8 ); # spent 42µs making 1 call to C4::Suggestions::BEGIN@24 # spent 30µs making 1 call to CGI::import
25
26	2	36µs	2	17µs	# spent 14µs (10+3) within C4::Suggestions::BEGIN@26 which was called: # once (10µs+3µ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 3µs making 1 call to C4::Context::import
27	2	126µs	2	196µs	# spent 105µs (13+92) within C4::Suggestions::BEGIN@27 which was called: # once (13µs+92µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 27 use C4::Output; # spent 105µs making 1 call to C4::Suggestions::BEGIN@27 # spent 92µs making 1 call to Exporter::import
28	2	78µs	2	95µs	# spent 54µs (12+41) within C4::Suggestions::BEGIN@28 which was called: # once (12µs+41µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 28 use C4::Debug; # spent 54µs making 1 call to C4::Suggestions::BEGIN@28 # spent 41µs making 1 call to Exporter::import
29	2	148µs	2	238µs	# spent 126µs (13+112) within C4::Suggestions::BEGIN@29 which was called: # once (13µs+112µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 29 use C4::Letters; # spent 126µs making 1 call to C4::Suggestions::BEGIN@29 # spent 112µs making 1 call to Exporter::import
30	2	59µs	2	61µs	# spent 37µs (12+25) within C4::Suggestions::BEGIN@30 which was called: # once (12µs+25µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 30 use Koha::DateUtils; # spent 37µs making 1 call to C4::Suggestions::BEGIN@30 # spent 25µs making 1 call to Exporter::import
31
32	2	47µs	2	41µs	# spent 26µs (12+15) within C4::Suggestions::BEGIN@32 which was called: # once (12µs+15µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 32 use List::MoreUtils qw(any); # spent 26µs making 1 call to C4::Suggestions::BEGIN@32 # spent 15µs making 1 call to Exporter::import
33	2	1.63ms	2	108µs	# spent 60µs (12+48) within C4::Suggestions::BEGIN@33 which was called: # once (12µs+48µs) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::BEGIN@29 at line 33 use base qw(Exporter); # spent 60µs making 1 call to C4::Suggestions::BEGIN@33 # spent 48µs making 1 call to base::import
34
35	1	2µs			our $VERSION = 3.07.00.049;
36	1	2µs			our @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
55					C4::Suggestions - Some useful functions for dealings with aqorders.
56
57					=head1 SYNOPSIS
58
59					use C4::Suggestions;
60
61					=head1 DESCRIPTION
62
63					The functions in this module deal with the aqorders in OPAC and in librarian interface
64
65					A suggestion is done in the OPAC. It has the status "ASKED"
66
67					When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".
68
69					When the book is ordered, the suggestion status becomes "ORDERED"
70
71					When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
72
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"
75
76					=head1 FUNCTIONS
77
78					=head2 SearchSuggestion
79
80					(\@array) = &SearchSuggestion($suggestionhashref_to_search)
81
82					searches for a suggestion
83
84					return :
85					C<\@array> : the aqorders found. Array of hash.
86					Note 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
92					sub 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
212					this function get the detail of the suggestion $suggestionid (input arg)
213
214					return :
215					the result of the SQL query as a hash : $sth->fetchrow_hashref.
216
217					=cut
218
219					sub 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
236					Get a suggestion from it's biblionumber.
237
238					return :
239					the id of the suggestion which is related to the biblionumber given on input args.
240
241					=cut
242
243					sub 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
259					Get a suggestion and borrower's informations from it's biblionumber.
260
261					return :
262					all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
263
264					=cut
265
266					sub 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
286					Get a suggestion and borrower's informations from it's suggestionid
287
288					return :
289					all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
290
291					=cut
292
293					sub 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
315					Get a suggestion from it's status
316
317					return :
318					all the suggestion with C<$status>
319
320					=cut
321
322					sub 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
373					Count the number of aqorders with the status given on input argument.
374					the 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
388					return :
389					the number of suggestion with this status.
390
391					=cut
392
393					# spent 2.54ms (63µs+2.48) within C4::Suggestions::CountSuggestion which was called: # once (63µs+2.48ms) by CGI::Compile::ROOT::home_vagrant_kohaclone_mainpage_2epl::__ANON__[/home/vagrant/kohaclone/mainpage.pl:107] at line 67 of mainpage.pl sub CountSuggestion {
394	1	900ns			my ($status) = @_;
395	1	5µs	1	80µs	my $dbh = C4::Context->dbh; # spent 80µs making 1 call to C4::Context::dbh
396	1	300ns			my $sth;
397	1	10µs	1	5µs	my $userenv = C4::Context->userenv; # spent 5µs making 1 call to C4::Context::userenv
398	1	6µs	1	2.29ms	if ( C4::Context->preference("IndependentBranches") # spent 2.29ms 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 {
412	1	600ns			my $query = q{
413					SELECT count(*)
414					FROM suggestions
415					WHERE STATUS=?
416					};
417	1	11µs	2	97µs	$sth = $dbh->prepare($query); # spent 52µs making 1 call to DBI::db::prepare # spent 45µs making 1 call to DBD::mysql::db::prepare
418	1	55µs	1	49µs	$sth->execute($status); # spent 49µs making 1 call to DBI::st::execute
419					}
420	1	16µs	1	3µs	my ($result) = $sth->fetchrow; # spent 3µs making 1 call to DBI::st::fetchrow
421	1	30µs			return $result;
422					}
423
424					=head2 NewSuggestion
425
426
427					&NewSuggestion($suggestion);
428
429					Insert a new suggestion on database with value given on input arg.
430
431					=cut
432
433					sub 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
462					Modify the suggestion according to the hash passed by ref.
463					The hash HAS to contain suggestionid
464					Data not defined is not updated unless it is a note or sort1
465					Send a mail to notify the user that did the suggestion.
466
467					Note that there is no function to modify a suggestion.
468
469					=cut
470
471					sub 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
535					connect a suggestion to an existing biblio
536
537					=cut
538
539					sub 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
555					Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
556
557					=cut
558
559					sub 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
590					sub 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
604					sub 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
621	1	6µs			1;
622					__END__