Filename | /home/vagrant/kohaclone/C4/Suggestions.pm |
Statements | Executed 31 statements in 3.32ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 56µs | 3.02ms | CountSuggestion | C4::Suggestions::
1 | 1 | 1 | 28µs | 38µs | BEGIN@21 | C4::Suggestions::
1 | 1 | 1 | 17µs | 148µs | BEGIN@29 | C4::Suggestions::
1 | 1 | 1 | 17µs | 53µs | BEGIN@30 | C4::Suggestions::
1 | 1 | 1 | 17µs | 48µs | BEGIN@32 | C4::Suggestions::
1 | 1 | 1 | 14µs | 80µs | BEGIN@33 | C4::Suggestions::
1 | 1 | 1 | 13µs | 67µs | BEGIN@28 | C4::Suggestions::
1 | 1 | 1 | 12µs | 39µs | BEGIN@24 | C4::Suggestions::
1 | 1 | 1 | 12µs | 14µs | BEGIN@26 | C4::Suggestions::
1 | 1 | 1 | 11µs | 102µs | BEGIN@27 | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | ConnectSuggestionAndBiblio | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | DelSuggestion | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | DelSuggestionsOlderThan | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | GetSuggestion | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | GetSuggestionByStatus | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | GetSuggestionFromBiblionumber | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | GetSuggestionInfo | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | GetSuggestionInfoFromBiblionumber | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | GetUnprocessedSuggestions | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | ModSuggestion | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | NewSuggestion | C4::Suggestions::
0 | 0 | 0 | 0s | 0s | SearchSuggestion | C4::Suggestions::
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 | 65µs | 2 | 48µ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 # 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 | ||||
24 | 2 | 71µs | 2 | 66µ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 # spent 39µs making 1 call to C4::Suggestions::BEGIN@24
# spent 27µs making 1 call to CGI::import |
25 | |||||
26 | 2 | 39µs | 2 | 16µ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 # spent 14µs making 1 call to C4::Suggestions::BEGIN@26
# spent 2µs making 1 call to C4::Context::import |
27 | 2 | 130µs | 2 | 192µ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 # spent 102µs making 1 call to C4::Suggestions::BEGIN@27
# spent 90µs making 1 call to Exporter::import |
28 | 2 | 96µs | 2 | 121µ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 # spent 67µs making 1 call to C4::Suggestions::BEGIN@28
# spent 54µs making 1 call to Exporter::import |
29 | 2 | 214µs | 2 | 278µ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 # spent 148µs making 1 call to C4::Suggestions::BEGIN@29
# spent 130µs making 1 call to Exporter::import |
30 | 2 | 86µs | 2 | 88µ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 # spent 53µs making 1 call to C4::Suggestions::BEGIN@30
# spent 35µs making 1 call to Exporter::import |
31 | |||||
32 | 2 | 78µs | 2 | 79µ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 # spent 48µs making 1 call to C4::Suggestions::BEGIN@32
# spent 31µs making 1 call to Exporter::import |
33 | 2 | 2.41ms | 2 | 146µ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 # spent 80µs making 1 call to C4::Suggestions::BEGIN@33
# spent 66µs making 1 call to base::import |
34 | |||||
35 | 1 | 1µ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 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 | ||||
394 | 1 | 700ns | my ($status) = @_; | ||
395 | 1 | 6µs | 1 | 87µs | my $dbh = C4::Context->dbh; # spent 87µs making 1 call to C4::Context::dbh |
396 | 1 | 400ns | my $sth; | ||
397 | 1 | 11µs | 1 | 6µs | my $userenv = C4::Context->userenv; # spent 6µs making 1 call to C4::Context::userenv |
398 | 1 | 7µs | 1 | 2.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 { | ||||
412 | 1 | 700ns | my $query = q{ | ||
413 | SELECT count(*) | ||||
414 | FROM suggestions | ||||
415 | WHERE STATUS=? | ||||
416 | }; | ||||
417 | 1 | 10µs | 2 | 95µ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 |
418 | 1 | 48µs | 1 | 42µs | $sth->execute($status); # spent 42µs making 1 call to DBI::st::execute |
419 | } | ||||
420 | 1 | 9µs | 1 | 3µs | my ($result) = $sth->fetchrow; # spent 3µs making 1 call to DBI::st::fetchrow |
421 | 1 | 28µ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 | 5µs | 1; | ||
622 | __END__ |