File Coverage

File:C4/Suggestions.pm
Coverage:17.8%

linestmtbrancondsubtimecode
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 under the
9# terms of the GNU General Public License as published by the Free Software
10# Foundation; either version 2 of the License, or (at your option) any later
11# version.
12#
13# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License along
18# with Koha; if not, write to the Free Software Foundation, Inc.,
19# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21
22
2
2
2
2
3176
15
45
use strict;
23#use warnings; FIXME - Bug 2505
24
2
2
2
2
62161
95912
42
use CGI;
25
26
2
2
2
2
123
4
15
use C4::Context;
27
2
2
2
2
418
4
262
use C4::Output;
28
2
2
2
2
10
3
103
use C4::Dates qw(format_date format_date_in_iso);
29
2
2
2
2
9
2
129
use C4::SQLHelper qw(:all);
30
2
2
2
2
4
1
164
use C4::Debug;
31
2
2
2
2
252
7
358
use C4::Letters;
32
2
2
2
2
10
3
133
use List::MoreUtils qw<any>;
33
2
2
2
2
8
3
78
use C4::Dates qw(format_date_in_iso);
34
2
2
2
2
8
4
4034
use base qw(Exporter);
35our $VERSION = 3.01;
36our @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>;
51
52 - 89
=head1 NAME

C4::Suggestions - Some useful functions for dealings with aqorders.

=head1 SYNOPSIS

use C4::Suggestions;

=head1 DESCRIPTION

The functions in this module deal with the aqorders in OPAC and in librarian interface

A suggestion is done in the OPAC. It has the status "ASKED"

When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED".

When the book is ordered, the suggestion status becomes "ORDERED"

When a book is ordered and arrived in the library, the status becomes "AVAILABLE"

All aqorders of a borrower can be seen by the borrower itself.
Suggestions done by other borrowers can be seen when not "AVAILABLE"

=head1 FUNCTIONS

=head2 SearchSuggestion

(\@array) = &SearchSuggestion($suggestionhashref_to_search)

searches for a suggestion

return :
C<\@array> : the aqorders found. Array of hash.
Note the status is stored twice :
* in the status field
* as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.

=cut
90
91sub SearchSuggestion {
92
0
0
    my ($suggestion)=@_;
93
0
    my $dbh = C4::Context->dbh;
94
0
    my @sql_params;
95    my @query = (
96    q{ SELECT suggestions.*,
97        U1.branchcode AS branchcodesuggestedby,
98        B1.branchname AS branchnamesuggestedby,
99        U1.surname AS surnamesuggestedby,
100        U1.firstname AS firstnamesuggestedby,
101        U1.email AS emailsuggestedby,
102        U1.borrowernumber AS borrnumsuggestedby,
103        U1.categorycode AS categorycodesuggestedby,
104        C1.description AS categorydescriptionsuggestedby,
105        U2.surname AS surnamemanagedby,
106        U2.firstname AS firstnamemanagedby,
107        B2.branchname AS branchnamesuggestedby,
108        U2.email AS emailmanagedby,
109        U2.branchcode AS branchcodemanagedby,
110        U2.borrowernumber AS borrnummanagedby
111    FROM suggestions
112    LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
113    LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode
114    LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode
115    LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
116    LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode
117    LEFT JOIN categories AS C2 ON C2.categorycode = U2.categorycode
118    WHERE 1=1
119    } , map {
120
0
0
0
        if ( my $s = $suggestion->{$_} ) {
121
0
        push @sql_params,'%'.$s.'%';
122
0
        " and suggestions.$_ like ? ";
123
0
        } else { () }
124    } qw( title author isbn publishercode collectiontitle )
125    );
126
127
0
    my $userenv = C4::Context->userenv;
128
0
0
    if (C4::Context->preference('IndependantBranches')) {
129
0
0
            if ($userenv) {
130
0
0
0
                if (($userenv->{flags} % 2) != 1 && !$suggestion->{branchcode}){
131
0
                push @sql_params,$$userenv{branch};
132
0
                push @query,q{ and (suggestions.branchcode = ? or suggestions.branchcode ='')};
133                }
134            }
135    }
136
137
0
0
    foreach my $field (grep { my $fieldname=$_;
138
0
0
0
        any {$fieldname eq $_ } qw<
139    STATUS branchcode itemtype suggestedby managedby acceptedby
140    bookfundid biblionumber
141    >} keys %$suggestion
142    ) {
143
0
0
        if ($$suggestion{$field}){
144
0
            push @sql_params,$suggestion->{$field};
145
0
            push @query, " and suggestions.$field=?";
146        }
147        else {
148
0
            push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)";
149        }
150    }
151
152
0
    my $today = C4::Dates->today('iso');
153
154
0
    foreach ( qw( suggesteddate manageddate accepteddate ) ) {
155
0
        my $from = $_ . "_from";
156
0
        my $to = $_ . "_to";
157
0
0
0
        if ($$suggestion{$from} || $$suggestion{$to}) {
158
0
0
0
            push @query, " AND suggestions.suggesteddate BETWEEN '"
159                . (format_date_in_iso($$suggestion{$from}) || 0000-00-00) . "' AND '" . (format_date_in_iso($$suggestion{$to}) || $today) . "'";
160        }
161    }
162
163
0
0
    $debug && warn "@query";
164
0
    my $sth=$dbh->prepare("@query");
165
0
    $sth->execute(@sql_params);
166
0
    my @results;
167
0
    while ( my $data=$sth->fetchrow_hashref ){
168
0
        $$data{$$data{STATUS}} = 1;
169
0
        push(@results,$data);
170    }
171
0
    return (\@results);
172}
173
174 - 183
=head2 GetSuggestion

\%sth = &GetSuggestion($ordernumber)

this function get the detail of the suggestion $ordernumber (input arg)

return :
    the result of the SQL query as a hash : $sth->fetchrow_hashref.

=cut
184
185sub GetSuggestion {
186
0
0
    my ($ordernumber) = @_;
187
0
    my $dbh = C4::Context->dbh;
188
0
    my $query = "
189        SELECT *
190        FROM suggestions
191        WHERE suggestionid=?
192    ";
193
0
    my $sth = $dbh->prepare($query);
194
0
    $sth->execute($ordernumber);
195
0
    return($sth->fetchrow_hashref);
196}
197
198 - 207
=head2 GetSuggestionFromBiblionumber

$ordernumber = &GetSuggestionFromBiblionumber($biblionumber)

Get a suggestion from it's biblionumber.

return :
the id of the suggestion which is related to the biblionumber given on input args.

=cut
208
209sub GetSuggestionFromBiblionumber {
210
0
0
    my ($biblionumber) = @_;
211
0
    my $query = q{
212        SELECT suggestionid
213        FROM suggestions
214        WHERE biblionumber=? LIMIT 1
215    };
216
0
    my $dbh=C4::Context->dbh;
217
0
    my $sth = $dbh->prepare($query);
218
0
    $sth->execute($biblionumber);
219
0
    my ($suggestionid) = $sth->fetchrow;
220
0
    return $suggestionid;
221}
222
223 - 230
=head2 GetSuggestionInfoFromBiblionumber

Get a suggestion and borrower's informations from it's biblionumber.

return :
all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.

=cut
231
232sub GetSuggestionInfoFromBiblionumber {
233
0
0
    my ($biblionumber) = @_;
234
0
    my $query = qq{
235        SELECT suggestions.*,
236        U1.surname AS surnamesuggestedby,
237        U1.firstname AS firstnamesuggestedby,
238        U1.borrowernumber AS borrnumsuggestedby
239        FROM suggestions
240        LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
241        WHERE biblionumber = ? LIMIT 1
242    };
243
0
    my $dbh = C4::Context->dbh;
244
0
    my $sth = $dbh->prepare($query);
245
0
    $sth->execute($biblionumber);
246
0
    return $sth->fetchrow_hashref;
247}
248
249 - 256
=head2 GetSuggestionInfo

Get a suggestion and borrower's informations from it's suggestionid

return :
all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.

=cut
257
258sub GetSuggestionInfo {
259
0
0
    my ($suggestionid) = @_;
260
0
    my $query = qq{
261        SELECT suggestions.*,
262        U1.surname AS surnamesuggestedby,
263        U1.firstname AS firstnamesuggestedby,
264        U1.borrowernumber AS borrnumsuggestedby
265        FROM suggestions
266        LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
267        WHERE suggestionid = ? LIMIT 1
268    };
269
0
    my $dbh = C4::Context->dbh;
270
0
    my $sth = $dbh->prepare($query);
271
0
    $sth->execute($suggestionid);
272
0
    return $sth->fetchrow_hashref;
273}
274
275 - 284
=head2 GetSuggestionByStatus

$aqorders = &GetSuggestionByStatus($status,[$branchcode])

Get a suggestion from it's status

return :
all the suggestion with C<$status>

=cut
285
286sub GetSuggestionByStatus {
287
0
0
    my $status = shift;
288
0
    my $branchcode = shift;
289
0
    my $dbh = C4::Context->dbh;
290
0
    my @sql_params=($status);
291
0
    my $query = qq(SELECT suggestions.*,
292                        U1.surname AS surnamesuggestedby,
293                        U1.firstname AS firstnamesuggestedby,
294                        U1.branchcode AS branchcodesuggestedby,
295                        B1.branchname AS branchnamesuggestedby,
296                        U1.borrowernumber AS borrnumsuggestedby,
297                        U1.categorycode AS categorycodesuggestedby,
298                        C1.description AS categorydescriptionsuggestedby,
299                        U2.surname AS surnamemanagedby,
300                        U2.firstname AS firstnamemanagedby,
301                        U2.borrowernumber AS borrnummanagedby
302                        FROM suggestions
303                        LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
304                        LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber
305                        LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode
306                        LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode
307                        WHERE status = ?);
308
0
0
0
    if (C4::Context->preference("IndependantBranches") || $branchcode) {
309
0
        my $userenv = C4::Context->userenv;
310
0
0
        if ($userenv) {
311
0
0
            unless ($userenv->{flags} % 2 == 1){
312
0
                push @sql_params,$userenv->{branch};
313
0
                $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
314            }
315        }
316
0
0
        if ($branchcode) {
317
0
            push @sql_params,$branchcode;
318
0
            $query .= " and (U1.branchcode = ? or U1.branchcode ='')";
319        }
320    }
321
322
0
    my $sth = $dbh->prepare($query);
323
0
    $sth->execute(@sql_params);
324
325
0
    my $results;
326
0
    $results= $sth->fetchall_arrayref({});
327
0
    return $results;
328}
329
330 - 352
=head2 CountSuggestion

&CountSuggestion($status)

Count the number of aqorders with the status given on input argument.
the arg status can be :

=over 2

=item * ASKED : asked by the user, not dealed by the librarian

=item * ACCEPTED : accepted by the librarian, but not yet ordered

=item * REJECTED : rejected by the librarian (definitive status)

=item * ORDERED : ordered by the librarian (acquisition module)

=back

return :
the number of suggestion with this status.

=cut
353
354sub CountSuggestion {
355
0
0
    my ($status) = @_;
356
0
    my $dbh = C4::Context->dbh;
357
0
    my $sth;
358
0
0
    if (C4::Context->preference("IndependantBranches")){
359
0
        my $userenv = C4::Context->userenv;
360
0
0
        if ($userenv->{flags} % 2 == 1){
361
0
            my $query = qq |
362                SELECT count(*)
363                FROM suggestions
364                WHERE STATUS=?
365            |;
366
0
            $sth = $dbh->prepare($query);
367
0
            $sth->execute($status);
368        }
369        else {
370
0
            my $query = qq |
371                SELECT count(*)
372                FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
373                WHERE STATUS=?
374                AND (borrowers.branchcode='' OR borrowers.branchcode =?)
375            |;
376
0
            $sth = $dbh->prepare($query);
377
0
            $sth->execute($status,$userenv->{branch});
378        }
379    }
380    else {
381
0
        my $query = qq |
382            SELECT count(*)
383            FROM suggestions
384            WHERE STATUS=?
385        |;
386
0
        $sth = $dbh->prepare($query);
387
0
        $sth->execute($status);
388    }
389
0
    my ($result) = $sth->fetchrow;
390
0
    return $result;
391}
392
393 - 400
=head2 NewSuggestion


&NewSuggestion($suggestion);

Insert a new suggestion on database with value given on input arg.

=cut
401
402sub NewSuggestion {
403
0
0
    my ($suggestion) = @_;
404
0
0
    $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS};
405
0
    return InsertInTable("suggestions",$suggestion);
406}
407
408 - 419
=head2 ModSuggestion

&ModSuggestion($suggestion)

Modify the suggestion according to the hash passed by ref.
The hash HAS to contain suggestionid
Data not defined is not updated unless it is a note or sort1 
Send a mail to notify the user that did the suggestion.

Note that there is no function to modify a suggestion. 

=cut
420
421sub ModSuggestion {
422
0
0
    my ($suggestion)=@_;
423
0
    my $status_update_table=UpdateInTable("suggestions", $suggestion);
424
425
0
0
    if ($suggestion->{STATUS}) {
426        # fetch the entire updated suggestion so that we can populate the letter
427
0
        my $full_suggestion = GetSuggestion($suggestion->{suggestionid});
428
0
        my $letter = C4::Letters::getletter('suggestions', $full_suggestion->{STATUS});
429
0
0
        if ($letter) {
430
0
            C4::Letters::parseletter($letter, 'branches', $full_suggestion->{branchcode});
431
0
            C4::Letters::parseletter($letter, 'borrowers', $full_suggestion->{suggestedby});
432
0
            C4::Letters::parseletter($letter, 'suggestions', $full_suggestion->{suggestionid});
433
0
            C4::Letters::parseletter($letter, 'biblio', $full_suggestion->{biblionumber});
434
0
            my $enqueued = C4::Letters::EnqueueLetter({
435                letter => $letter,
436                borrowernumber => $full_suggestion->{suggestedby},
437                suggestionid => $full_suggestion->{suggestionid},
438                LibraryName => C4::Context->preference("LibraryName"),
439                message_transport_type => 'email',
440            });
441
0
0
0
            if (!$enqueued){warn "can't enqueue letter $letter";}
442        }
443    }
444
0
    return $status_update_table;
445}
446
447 - 453
=head2 ConnectSuggestionAndBiblio

&ConnectSuggestionAndBiblio($ordernumber,$biblionumber)

connect a suggestion to an existing biblio

=cut
454
455sub ConnectSuggestionAndBiblio {
456
0
0
    my ($suggestionid,$biblionumber) = @_;
457
0
    my $dbh=C4::Context->dbh;
458
0
    my $query = "
459        UPDATE suggestions
460        SET biblionumber=?
461        WHERE suggestionid=?
462    ";
463
0
    my $sth = $dbh->prepare($query);
464
0
    $sth->execute($biblionumber,$suggestionid);
465}
466
467 - 473
=head2 DelSuggestion

&DelSuggestion($borrowernumber,$ordernumber)

Delete a suggestion. A borrower can delete a suggestion only if he is its owner.

=cut
474
475sub DelSuggestion {
476
0
0
    my ($borrowernumber,$suggestionid,$type) = @_;
477
0
    my $dbh = C4::Context->dbh;
478    # check that the suggestion comes from the suggestor
479
0
    my $query = "
480        SELECT suggestedby
481        FROM suggestions
482        WHERE suggestionid=?
483    ";
484
0
    my $sth = $dbh->prepare($query);
485
0
    $sth->execute($suggestionid);
486
0
    my ($suggestedby) = $sth->fetchrow;
487
0
0
0
    if ($type eq "intranet" || $suggestedby eq $borrowernumber ) {
488
0
        my $queryDelete = "
489            DELETE FROM suggestions
490            WHERE suggestionid=?
491        ";
492
0
        $sth = $dbh->prepare($queryDelete);
493
0
        my $suggestiondeleted=$sth->execute($suggestionid);
494
0
        return $suggestiondeleted;
495    }
496}
497
498 - 503
=head2 DelSuggestionsOlderThan
    &DelSuggestionsOlderThan($days)
    
    Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
    
=cut
504sub DelSuggestionsOlderThan {
505
0
0
    my ($days) = @_;
506
0
0
    return if not $days;
507
0
    my $dbh = C4::Context->dbh;
508
509
0
    my $sth = $dbh->prepare("
510        DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?);
511    ");
512
0
    $sth->execute("-$days");
513}
514
5151;