File Coverage

File:C4/Suggestions.pm
Coverage:18.3%

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
1
1
1
1
288
2
21
use strict;
23#use warnings; FIXME - Bug 2505
24
1
1
1
1
4
1
12
use CGI;
25
26
1
1
1
1
72
2
7
use C4::Context;
27
1
1
1
1
171
25
153
use C4::Output;
28
1
1
1
1
26
19
74
use C4::Dates qw(format_date format_date_in_iso);
29
1
1
1
1
22
18
131
use C4::SQLHelper qw(:all);
30
1
1
1
1
20
16
99
use C4::Debug;
31
1
1
1
1
19
14
137
use C4::Letters;
32
1
1
1
1
17
12
72
use List::MoreUtils qw<any>;
33
1
1
1
1
16
11
96
use C4::Dates qw(format_date_in_iso);
34
1
1
1
1
14
11
2048
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
0
        if ( my $letter = C4::Letters::GetPreparedLetter (
429            module => 'suggestions',
430            letter_code => $full_suggestion->{STATUS},
431            branchcode => $full_suggestion->{branchcode},
432            tables => {
433                'branches' => $full_suggestion->{branchcode},
434                'borrowers' => $full_suggestion->{suggestedby},
435                'suggestions' => $full_suggestion,
436                'biblio' => $full_suggestion->{biblionumber},
437            },
438        ) ) {
439
0
0
            C4::Letters::EnqueueLetter({
440                letter => $letter,
441                borrowernumber => $full_suggestion->{suggestedby},
442                suggestionid => $full_suggestion->{suggestionid},
443                LibraryName => C4::Context->preference("LibraryName"),
444                message_transport_type => 'email',
445            }) or warn "can't enqueue letter $letter";
446        }
447    }
448
0
    return $status_update_table;
449}
450
451 - 457
=head2 ConnectSuggestionAndBiblio

&ConnectSuggestionAndBiblio($ordernumber,$biblionumber)

connect a suggestion to an existing biblio

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

&DelSuggestion($borrowernumber,$ordernumber)

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

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