File Coverage

File:C4/Members.pm
Coverage:5.2%

linestmtbrancondsubtimecode
1package C4::Members;
2
3# Copyright 2000-2003 Katipo Communications
4# Copyright 2010 BibLibre
5# Parts Copyright 2010 Catalyst IT
6#
7# This file is part of Koha.
8#
9# Koha is free software; you can redistribute it and/or modify it under the
10# terms of the GNU General Public License as published by the Free Software
11# Foundation; either version 2 of the License, or (at your option) any later
12# version.
13#
14# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
15# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
16# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along
19# with Koha; if not, write to the Free Software Foundation, Inc.,
20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22
23
24
24
24
276
291
1155
use strict;
24#use warnings; FIXME - Bug 2505
25
24
24
24
1351
146
483
use C4::Context;
26
24
24
24
2576
133
1962
use C4::Dates qw(format_date_in_iso);
27
24
24
24
322
108
1629
use Digest::MD5 qw(md5_base64);
28
24
24
24
179
110
1844
use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
29
24
24
24
2095
94
3229
use C4::Log; # logaction
30
24
24
24
5934
923
7464
use C4::Overdues;
31
24
24
24
630
333
5175
use C4::Reserves;
32
24
24
24
788
312
4153
use C4::Accounts;
33
24
24
24
379
282
13080
use C4::Biblio;
34
24
24
24
6440
137
2346
use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
35
24
24
24
4464
258
6681
use C4::Members::Attributes qw(SearchIdMatchingAttribute);
36
37our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
38
39BEGIN {
40
24
240
        $VERSION = 3.02;
41
24
422
        $debug = $ENV{DEBUG} || 0;
42
24
293
        require Exporter;
43
24
728
        @ISA = qw(Exporter);
44        #Get data
45
24
570
        push @EXPORT, qw(
46                &Search
47                &GetMemberDetails
48        &GetMemberRelatives
49                &GetMember
50
51                &GetGuarantees
52
53                &GetMemberIssuesAndFines
54                &GetPendingIssues
55                &GetAllIssues
56
57                &get_institutions
58                &getzipnamecity
59                &getidcity
60
61                &GetFirstValidEmailAddress
62
63                &GetAge
64                &GetCities
65                &GetRoadTypes
66                &GetRoadTypeDetails
67                &GetSortDetails
68                &GetTitles
69
70    &GetPatronImage
71    &PutPatronImage
72    &RmPatronImage
73
74                &GetHideLostItemsPreference
75
76                &IsMemberBlocked
77                &GetMemberAccountRecords
78                &GetBorNotifyAcctRecord
79
80                &GetborCatFromCatType
81                &GetBorrowercategory
82    &GetBorrowercategoryList
83
84                &GetBorrowersWhoHaveNotBorrowedSince
85                &GetBorrowersWhoHaveNeverBorrowed
86                &GetBorrowersWithIssuesHistoryOlderThan
87
88                &GetExpiryDate
89
90                &AddMessage
91                &DeleteMessage
92                &GetMessages
93                &GetMessagesCount
94        );
95
96        #Modify data
97
24
238
        push @EXPORT, qw(
98                &ModMember
99                &changepassword
100         &ModPrivacy
101        );
102
103        #Delete data
104
24
236
        push @EXPORT, qw(
105                &DelMember
106        );
107
108        #Insert data
109
24
212
        push @EXPORT, qw(
110                &AddMember
111                &add_member_orgs
112                &MoveMemberToDeleted
113                &ExtendMemberSubscriptionTo
114        );
115
116        #Check data
117
24
86631
    push @EXPORT, qw(
118        &checkuniquemember
119        &checkuserpassword
120        &Check_Userid
121        &Generate_Userid
122        &fixEthnicity
123        &ethnicitycategories
124        &fixup_cardnumber
125        &checkcardnumber
126    );
127}
128
129 - 162
=head1 NAME

C4::Members - Perl Module containing convenience functions for member handling

=head1 SYNOPSIS

use C4::Members;

=head1 DESCRIPTION

This module contains routines for adding, modifying and deleting members/patrons/borrowers 

=head1 FUNCTIONS

=head2 Search

  $borrowers_result_array_ref = &Search($filter,$orderby, $limit, 
                       $columns_out, $search_on_fields,$searchtype);

Looks up patrons (borrowers) on filter. A wrapper for SearchInTable('borrowers').

For C<$filter>, C<$orderby>, C<$limit>, C<&columns_out>, C<&search_on_fields> and C<&searchtype>
refer to C4::SQLHelper:SearchInTable().

Special C<$filter> key '' is effectively expanded to search on surname firstname othernamescw
and cardnumber unless C<&search_on_fields> is defined

Examples:

  $borrowers = Search('abcd', 'cardnumber');

  $borrowers = Search({''=>'abcd', category_type=>'I'}, 'surname');

=cut
163
164sub _express_member_find {
165
0
    my ($filter) = @_;
166
167    # this is used by circulation everytime a new borrowers cardnumber is scanned
168    # so we can check an exact match first, if that works return, otherwise do the rest
169
0
    my $dbh = C4::Context->dbh;
170
0
    my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
171
0
    if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
172
0
        return( {"borrowernumber"=>$borrowernumber} );
173    }
174
175
0
    my ($search_on_fields, $searchtype);
176
0
    if ( length($filter) == 1 ) {
177
0
        $search_on_fields = [ qw(surname) ];
178
0
        $searchtype = 'start_with';
179    } else {
180
0
        $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
181
0
        $searchtype = 'contain';
182    }
183
184
0
    return (undef, $search_on_fields, $searchtype);
185}
186
187sub Search {
188
0
    my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
189
190
0
    my $search_string;
191
0
    my $found_borrower;
192
193
0
    if ( my $fr = ref $filter ) {
194
0
        if ( $fr eq "HASH" ) {
195
0
            if ( my $search_string = $filter->{''} ) {
196
0
                my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
197
0
                if ($member_filter) {
198
0
                    $filter = $member_filter;
199
0
                    $found_borrower = 1;
200                } else {
201
0
                    $search_on_fields ||= $member_search_on_fields;
202
0
                    $searchtype ||= $member_searchtype;
203                }
204            }
205        }
206        else {
207
0
            $search_string = $filter;
208        }
209    }
210    else {
211
0
        $search_string = $filter;
212
0
        my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
213
0
        if ($member_filter) {
214
0
            $filter = $member_filter;
215
0
            $found_borrower = 1;
216        } else {
217
0
            $search_on_fields ||= $member_search_on_fields;
218
0
            $searchtype ||= $member_searchtype;
219        }
220    }
221
222
0
    if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
223
0
        my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
224
0
        if(scalar(@$matching_records)>0) {
225
0
            if ( my $fr = ref $filter ) {
226
0
                if ( $fr eq "HASH" ) {
227
0
                    my %f = %$filter;
228
0
                    $filter = [ $filter ];
229
0
                    delete $f{''};
230
0
                    push @$filter, { %f, "borrowernumber"=>$$matching_records };
231                }
232                else {
233
0
                    push @$filter, {"borrowernumber"=>$matching_records};
234                }
235            }
236            else {
237
0
                $filter = [ $filter ];
238
0
                push @$filter, {"borrowernumber"=>$matching_records};
239            }
240                }
241    }
242
243    # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
244    # Mentioning for the reference
245
246
0
    if ( C4::Context->preference("IndependantBranches") ) { # && !$showallbranches){
247
0
        if ( my $userenv = C4::Context->userenv ) {
248
0
            my $branch = $userenv->{'branch'};
249
0
            if ( ($userenv->{flags} % 2 !=1) &&
250                 $branch && $branch ne "insecure" ){
251
252
0
                if (my $fr = ref $filter) {
253
0
                    if ( $fr eq "HASH" ) {
254
0
                        $filter->{branchcode} = $branch;
255                    }
256                    else {
257
0
                        foreach (@$filter) {
258
0
                            $_ = { '' => $_ } unless ref $_;
259
0
                            $_->{branchcode} = $branch;
260                        }
261                    }
262                }
263                else {
264
0
                    $filter = { '' => $filter, branchcode => $branch };
265                }
266            }
267        }
268    }
269
270
0
    if ($found_borrower) {
271
0
        $searchtype = "exact";
272    }
273
0
    $searchtype ||= "start_with";
274
275
0
        return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
276}
277
278 - 308
=head2 GetMemberDetails

($borrower) = &GetMemberDetails($borrowernumber, $cardnumber);

Looks up a patron and returns information about him or her. If
C<$borrowernumber> is true (nonzero), C<&GetMemberDetails> looks
up the borrower by number; otherwise, it looks up the borrower by card
number.

C<$borrower> is a reference-to-hash whose keys are the fields of the
borrowers table in the Koha database. In addition,
C<$borrower-E<gt>{flags}> is a hash giving more detailed information
about the patron. Its keys act as flags :

    if $borrower->{flags}->{LOST} {
        # Patron's card was reported lost
    }

If the state of a flag means that the patron should not be
allowed to borrow any more books, then it will have a C<noissues> key
with a true value.

See patronflags for more details.

C<$borrower-E<gt>{authflags}> is a hash giving more detailed information
about the top-level permissions flags set for the borrower.  For example,
if a user has the "editcatalogue" permission,
C<$borrower-E<gt>{authflags}-E<gt>{editcatalogue}> will exist and have
the value "1".

=cut
309
310sub GetMemberDetails {
311
0
    my ( $borrowernumber, $cardnumber ) = @_;
312
0
    my $dbh = C4::Context->dbh;
313
0
    my $query;
314
0
    my $sth;
315
0
    if ($borrowernumber) {
316
0
        $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
317
0
        $sth->execute($borrowernumber);
318    }
319    elsif ($cardnumber) {
320
0
        $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
321
0
        $sth->execute($cardnumber);
322    }
323    else {
324
0
        return undef;
325    }
326
0
    my $borrower = $sth->fetchrow_hashref;
327
0
    my ($amount) = GetMemberAccountRecords( $borrowernumber);
328
0
    $borrower->{'amountoutstanding'} = $amount;
329    # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
330
0
    my $flags = patronflags( $borrower);
331
0
    my $accessflagshash;
332
333
0
    $sth = $dbh->prepare("select bit,flag from userflags");
334
0
    $sth->execute;
335
0
    while ( my ( $bit, $flag ) = $sth->fetchrow ) {
336
0
        if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
337
0
            $accessflagshash->{$flag} = 1;
338        }
339    }
340
0
    $borrower->{'flags'} = $flags;
341
0
    $borrower->{'authflags'} = $accessflagshash;
342
343    # For the purposes of making templates easier, we'll define a
344    # 'showname' which is the alternate form the user's first name if
345    # 'other name' is defined.
346
0
    if ($borrower->{category_type} eq 'I') {
347
0
        $borrower->{'showname'} = $borrower->{'othernames'};
348
0
        $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
349    } else {
350
0
        $borrower->{'showname'} = $borrower->{'firstname'};
351    }
352
353
0
    return ($borrower); #, $flags, $accessflagshash);
354}
355
356 - 415
=head2 patronflags

 $flags = &patronflags($patron);

This function is not exported.

The following will be set where applicable:
 $flags->{CHARGES}->{amount}        Amount of debt
 $flags->{CHARGES}->{noissues}      Set if debt amount >$5.00 (or syspref noissuescharge)
 $flags->{CHARGES}->{message}       Message -- deprecated

 $flags->{CREDITS}->{amount}        Amount of credit
 $flags->{CREDITS}->{message}       Message -- deprecated

 $flags->{  GNA  }                  Patron has no valid address
 $flags->{  GNA  }->{noissues}      Set for each GNA
 $flags->{  GNA  }->{message}       "Borrower has no valid address" -- deprecated

 $flags->{ LOST  }                  Patron's card reported lost
 $flags->{ LOST  }->{noissues}      Set for each LOST
 $flags->{ LOST  }->{message}       Message -- deprecated

 $flags->{DBARRED}                  Set if patron debarred, no access
 $flags->{DBARRED}->{noissues}      Set for each DBARRED
 $flags->{DBARRED}->{message}       Message -- deprecated

 $flags->{ NOTES }
 $flags->{ NOTES }->{message}       The note itself.  NOT deprecated

 $flags->{ ODUES }                  Set if patron has overdue books.
 $flags->{ ODUES }->{message}       "Yes"  -- deprecated
 $flags->{ ODUES }->{itemlist}      ref-to-array: list of overdue books
 $flags->{ ODUES }->{itemlisttext}  Text list of overdue items -- deprecated

 $flags->{WAITING}                  Set if any of patron's reserves are available
 $flags->{WAITING}->{message}       Message -- deprecated
 $flags->{WAITING}->{itemlist}      ref-to-array: list of available items

=over 

=item C<$flags-E<gt>{ODUES}-E<gt>{itemlist}> is a reference-to-array listing the
overdue items. Its elements are references-to-hash, each describing an
overdue item. The keys are selected fields from the issues, biblio,
biblioitems, and items tables of the Koha database.

=item C<$flags-E<gt>{ODUES}-E<gt>{itemlisttext}> is a string giving a text listing of
the overdue items, one per line.  Deprecated.

=item C<$flags-E<gt>{WAITING}-E<gt>{itemlist}> is a reference-to-array listing the
available items. Each element is a reference-to-hash whose keys are
fields from the reserves table of the Koha database.

=back

All the "message" fields that include language generated in this function are deprecated, 
because such strings belong properly in the display layer.

The "message" field that comes from the DB is OK.

=cut
416
417# TODO: use {anonymous => hashes} instead of a dozen %flaginfo
418# FIXME rename this function.
419sub patronflags {
420
0
    my %flags;
421
0
    my ( $patroninformation) = @_;
422
0
    my $dbh=C4::Context->dbh;
423
0
    my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
424
0
    if ( $amount > 0 ) {
425
0
        my %flaginfo;
426
0
        my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
427
0
        $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
428
0
        $flaginfo{'amount'} = sprintf "%.02f", $amount;
429
0
        if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
430
0
            $flaginfo{'noissues'} = 1;
431        }
432
0
        $flags{'CHARGES'} = \%flaginfo;
433    }
434    elsif ( $amount < 0 ) {
435
0
        my %flaginfo;
436
0
        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
437
0
        $flaginfo{'amount'} = sprintf "%.02f", $amount;
438
0
        $flags{'CREDITS'} = \%flaginfo;
439    }
440
0
    if ( $patroninformation->{'gonenoaddress'}
441        && $patroninformation->{'gonenoaddress'} == 1 )
442    {
443
0
        my %flaginfo;
444
0
        $flaginfo{'message'} = 'Borrower has no valid address.';
445
0
        $flaginfo{'noissues'} = 1;
446
0
        $flags{'GNA'} = \%flaginfo;
447    }
448
0
    if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
449
0
        my %flaginfo;
450
0
        $flaginfo{'message'} = 'Borrower\'s card reported lost.';
451
0
        $flaginfo{'noissues'} = 1;
452
0
        $flags{'LOST'} = \%flaginfo;
453    }
454
0
    if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
455
0
        if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
456
0
            my %flaginfo;
457
0
            $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
458
0
            $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
459
0
            $flaginfo{'noissues'} = 1;
460
0
            $flaginfo{'dateend'} = $patroninformation->{'debarred'};
461
0
            $flags{'DBARRED'} = \%flaginfo;
462        }
463    }
464
0
    if ( $patroninformation->{'borrowernotes'}
465        && $patroninformation->{'borrowernotes'} )
466    {
467
0
        my %flaginfo;
468
0
        $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
469
0
        $flags{'NOTES'} = \%flaginfo;
470    }
471
0
    my ( $odues, $itemsoverdue ) = checkoverdues($patroninformation->{'borrowernumber'});
472
0
    if ( $odues && $odues > 0 ) {
473
0
        my %flaginfo;
474
0
        $flaginfo{'message'} = "Yes";
475
0
        $flaginfo{'itemlist'} = $itemsoverdue;
476
0
0
        foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
477            @$itemsoverdue )
478        {
479
0
            $flaginfo{'itemlisttext'} .=
480              "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
481        }
482
0
        $flags{'ODUES'} = \%flaginfo;
483    }
484
0
    my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
485
0
    my $nowaiting = scalar @itemswaiting;
486
0
    if ( $nowaiting > 0 ) {
487
0
        my %flaginfo;
488
0
        $flaginfo{'message'} = "Reserved items available";
489
0
        $flaginfo{'itemlist'} = \@itemswaiting;
490
0
        $flags{'WAITING'} = \%flaginfo;
491    }
492
0
    return ( \%flags );
493}
494
495
496 - 513
=head2 GetMember

  $borrower = &GetMember(%information);

Retrieve the first patron record meeting on criteria listed in the
C<%information> hash, which should contain one or more
pairs of borrowers column names and values, e.g.,

   $borrower = GetMember(borrowernumber => id);

C<&GetBorrower> returns a reference-to-hash whose keys are the fields of
the C<borrowers> table in the Koha database.

FIXME: GetMember() is used throughout the code as a lookup
on a unique key such as the borrowernumber, but this meaning is not
enforced in the routine itself.

=cut
514
515#'
516sub GetMember {
517
0
    my ( %information ) = @_;
518
0
    if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
519        #passing mysql's kohaadmin?? Makes no sense as a query
520
0
        return;
521    }
522
0
    my $dbh = C4::Context->dbh;
523
0
    my $select =
524    q{SELECT borrowers.*, categories.category_type, categories.description
525    FROM borrowers
526    LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
527
0
    my $more_p = 0;
528
0
    my @values = ();
529
0
    for (keys %information ) {
530
0
        if ($more_p) {
531
0
            $select .= ' AND ';
532        }
533        else {
534
0
            $more_p++;
535        }
536
537
0
        if (defined $information{$_}) {
538
0
            $select .= "$_ = ?";
539
0
            push @values, $information{$_};
540        }
541        else {
542
0
            $select .= "$_ IS NULL";
543        }
544    }
545
0
    $debug && warn $select, " ",values %information;
546
0
    my $sth = $dbh->prepare("$select");
547
0
0
    $sth->execute(map{$information{$_}} keys %information);
548
0
    my $data = $sth->fetchall_arrayref({});
549    #FIXME interface to this routine now allows generation of a result set
550    #so whole array should be returned but bowhere in the current code expects this
551
0
0
    if (@{$data} ) {
552
0
        return $data->[0];
553    }
554
555
0
    return;
556}
557
558 - 564
=head2 GetMemberRelatives

 @borrowernumbers = GetMemberRelatives($borrowernumber);

 C<GetMemberRelatives> returns a borrowersnumber's list of guarantor/guarantees of the member given in parameter

=cut 
565sub GetMemberRelatives {
566
0
    my $borrowernumber = shift;
567
0
    my $dbh = C4::Context->dbh;
568
0
    my @glist;
569
570    # Getting guarantor
571
0
    my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
572
0
    my $sth = $dbh->prepare($query);
573
0
    $sth->execute($borrowernumber);
574
0
    my $data = $sth->fetchrow_arrayref();
575
0
    push @glist, $data->[0] if $data->[0];
576
0
    my $guarantor = $data->[0] if $data->[0];
577
578    # Getting guarantees
579
0
    $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
580
0
    $sth = $dbh->prepare($query);
581
0
    $sth->execute($borrowernumber);
582
0
    while ($data = $sth->fetchrow_arrayref()) {
583
0
       push @glist, $data->[0];
584    }
585
586    # Getting sibling guarantees
587
0
    if ($guarantor) {
588
0
        $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
589
0
        $sth = $dbh->prepare($query);
590
0
        $sth->execute($guarantor);
591
0
        while ($data = $sth->fetchrow_arrayref()) {
592
0
           push @glist, $data->[0] if ($data->[0] != $borrowernumber);
593        }
594    }
595
596
0
    return @glist;
597}
598
599 - 622
=head2 IsMemberBlocked

  my ($block_status, $count) = IsMemberBlocked( $borrowernumber );

Returns whether a patron has overdue items that may result
in a block or whether the patron has active fine days
that would block circulation privileges.

C<$block_status> can have the following values:

1 if the patron has outstanding fine days, in which case C<$count> is the number of them

-1 if the patron has overdue items, in which case C<$count> is the number of them

0 if the patron has no overdue items or outstanding fine days, in which case C<$count> is 0

Outstanding fine days are checked before current overdue items
are.

FIXME: this needs to be split into two functions; a potential block
based on the number of current overdue items could be orthogonal
to a block based on whether the patron has any fine days accrued.

=cut
623
624sub IsMemberBlocked {
625
0
    my $borrowernumber = shift;
626
0
    my $dbh = C4::Context->dbh;
627
628
0
    my $blockeddate = CheckBorrowerDebarred($borrowernumber);
629
630
0
    return ( 1, $blockeddate ) if $blockeddate;
631
632    # if he have late issues
633
0
    my $sth = $dbh->prepare(
634        "SELECT COUNT(*) as latedocs
635         FROM issues
636         WHERE borrowernumber = ?
637         AND date_due < curdate()"
638    );
639
0
    $sth->execute($borrowernumber);
640
0
    my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
641
642
0
    return ( -1, $latedocs ) if $latedocs > 0;
643
644
0
    return ( 0, 0 );
645}
646
647 - 659
=head2 GetMemberIssuesAndFines

  ($overdue_count, $issue_count, $total_fines) = &GetMemberIssuesAndFines($borrowernumber);

Returns aggregate data about items borrowed by the patron with the
given borrowernumber.

C<&GetMemberIssuesAndFines> returns a three-element array.  C<$overdue_count> is the
number of overdue items the patron currently has borrowed. C<$issue_count> is the
number of books the patron currently has borrowed.  C<$total_fines> is
the total fine currently due by the borrower.

=cut
660
661#'
662sub GetMemberIssuesAndFines {
663
0
    my ( $borrowernumber ) = @_;
664
0
    my $dbh = C4::Context->dbh;
665
0
    my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
666
667
0
    $debug and warn $query."\n";
668
0
    my $sth = $dbh->prepare($query);
669
0
    $sth->execute($borrowernumber);
670
0
    my $issue_count = $sth->fetchrow_arrayref->[0];
671
672
0
    $sth = $dbh->prepare(
673        "SELECT COUNT(*) FROM issues
674         WHERE borrowernumber = ?
675         AND date_due < curdate()"
676    );
677
0
    $sth->execute($borrowernumber);
678
0
    my $overdue_count = $sth->fetchrow_arrayref->[0];
679
680
0
    $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
681
0
    $sth->execute($borrowernumber);
682
0
    my $total_fines = $sth->fetchrow_arrayref->[0];
683
684
0
    return ($overdue_count, $issue_count, $total_fines);
685}
686
687sub columns(;$) {
688
0
0
    return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
689}
690
691 - 701
=head2 ModMember

  my $success = ModMember(borrowernumber => $borrowernumber,
                                            [ field => value ]... );

Modify borrower's data.  All date fields should ALREADY be in ISO format.

return :
true on success, or false on failure

=cut
702
703sub ModMember {
704
0
    my (%data) = @_;
705    # test to know if you must update or not the borrower password
706
0
    if (exists $data{password}) {
707
0
        if ($data{password} eq '****' or $data{password} eq '') {
708
0
            delete $data{password};
709        } else {
710
0
            $data{password} = md5_base64($data{password});
711        }
712    }
713
0
        my $execute_success=UpdateInTable("borrowers",\%data);
714
0
    if ($execute_success) { # only proceed if the update was a success
715        # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
716        # so when we update information for an adult we should check for guarantees and update the relevant part
717        # of their records, ie addresses and phone numbers
718
0
        my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
719
0
        if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
720            # is adult check guarantees;
721
0
            UpdateGuarantees(%data);
722        }
723
0
        logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
724    }
725
0
    return $execute_success;
726}
727
728
729 - 738
=head2 AddMember

  $borrowernumber = &AddMember(%borrower);

insert new borrower into table
Returns the borrowernumber upon success

Returns as undef upon any db error without further processing

=cut
739
740#'
741sub AddMember {
742
0
    my (%data) = @_;
743
0
    my $dbh = C4::Context->dbh;
744        # generate a proper login if none provided
745
0
        $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
746        # create a disabled account if no password provided
747
0
        $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
748
0
        $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
749    # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
750
0
    logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
751
752    # check for enrollment fee & add it if needed
753
0
    my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
754
0
    $sth->execute($data{'categorycode'});
755
0
    my ($enrolmentfee) = $sth->fetchrow;
756
0
    if ($sth->err) {
757
0
        warn sprintf('Database returned the following error: %s', $sth->errstr);
758
0
        return;
759    }
760
0
    if ($enrolmentfee && $enrolmentfee > 0) {
761        # insert fee in patron debts
762
0
        manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
763    }
764
765
0
    return $data{'borrowernumber'};
766}
767
768
769sub Check_Userid {
770
0
    my ($uid,$member) = @_;
771
0
    my $dbh = C4::Context->dbh;
772    # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
773    # Then we need to tell the user and have them create a new one.
774
0
    my $sth =
775      $dbh->prepare(
776        "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
777
0
    $sth->execute( $uid, $member );
778
0
    if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
779
0
        return 0;
780    }
781    else {
782
0
        return 1;
783    }
784}
785
786sub Generate_Userid {
787
0
  my ($borrowernumber, $firstname, $surname) = @_;
788
0
  my $newuid;
789
0
  my $offset = 0;
790
0
  do {
791
0
    $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
792
0
    $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
793
0
    $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
794
0
    $newuid .= $offset unless $offset == 0;
795
0
    $offset++;
796
797   } while (!Check_Userid($newuid,$borrowernumber));
798
799
0
   return $newuid;
800}
801
802sub changepassword {
803
0
    my ( $uid, $member, $digest ) = @_;
804
0
    my $dbh = C4::Context->dbh;
805
806#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
807#Then we need to tell the user and have them create a new one.
808
0
    my $resultcode;
809
0
    my $sth =
810      $dbh->prepare(
811        "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
812
0
    $sth->execute( $uid, $member );
813
0
    if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
814
0
        $resultcode=0;
815    }
816    else {
817        #Everything is good so we can update the information.
818
0
        $sth =
819          $dbh->prepare(
820            "update borrowers set userid=?, password=? where borrowernumber=?");
821
0
        $sth->execute( $uid, $digest, $member );
822
0
        $resultcode=1;
823    }
824
825
0
    logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
826
0
    return $resultcode;
827}
828
829
830
831 - 836
=head2 fixup_cardnumber

Warning: The caller is responsible for locking the members table in write
mode, to avoid database corruption.

=cut
837
838
24
24
24
1269
311
156658
use vars qw( @weightings );
839my @weightings = ( 8, 4, 6, 3, 5, 2, 1 );
840
841sub fixup_cardnumber ($) {
842
0
    my ($cardnumber) = @_;
843
0
    my $autonumber_members = C4::Context->boolean_preference('autoMemberNum') || 0;
844
845    # Find out whether member numbers should be generated
846    # automatically. Should be either "1" or something else.
847    # Defaults to "0", which is interpreted as "no".
848
849    # if ($cardnumber !~ /\S/ && $autonumber_members) {
850
0
    ($autonumber_members) or return $cardnumber;
851
0
    my $checkdigit = C4::Context->preference('checkdigit');
852
0
    my $dbh = C4::Context->dbh;
853
0
    if ( $checkdigit and $checkdigit eq 'katipo' ) {
854
855        # if checkdigit is selected, calculate katipo-style cardnumber.
856        # otherwise, just use the max()
857        # purpose: generate checksum'd member numbers.
858        # We'll assume we just got the max value of digits 2-8 of member #'s
859        # from the database and our job is to increment that by one,
860        # determine the 1st and 9th digits and return the full string.
861
0
        my $sth = $dbh->prepare(
862            "select max(substring(borrowers.cardnumber,2,7)) as new_num from borrowers"
863        );
864
0
        $sth->execute;
865
0
        my $data = $sth->fetchrow_hashref;
866
0
        $cardnumber = $data->{new_num};
867
0
        if ( !$cardnumber ) { # If DB has no values,
868
0
            $cardnumber = 1000000; # start at 1000000
869        } else {
870
0
            $cardnumber += 1;
871        }
872
873
0
        my $sum = 0;
874        for ( my $i = 0 ; $i < 8 ; $i += 1 ) {
875            # read weightings, left to right, 1 char at a time
876
0
            my $temp1 = $weightings[$i];
877
878            # sequence left to right, 1 char at a time
879
0
            my $temp2 = substr( $cardnumber, $i, 1 );
880
881            # mult each char 1-7 by its corresponding weighting
882
0
            $sum += $temp1 * $temp2;
883
0
        }
884
885
0
        my $rem = ( $sum % 11 );
886
0
        $rem = 'X' if $rem == 10;
887
888
0
        return "V$cardnumber$rem";
889     } else {
890
891     # MODIFIED BY JF: mysql4.1 allows casting as an integer, which is probably
892     # better. I'll leave the original in in case it needs to be changed for you
893     # my $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers");
894
0
        my $sth = $dbh->prepare(
895            "select max(cast(cardnumber as signed)) from borrowers"
896        );
897
0
        $sth->execute;
898
0
        my ($result) = $sth->fetchrow;
899
0
        return $result + 1;
900    }
901
0
    return $cardnumber; # just here as a fallback/reminder
902}
903
904 - 918
=head2 GetGuarantees

  ($num_children, $children_arrayref) = &GetGuarantees($parent_borrno);
  $child0_cardno = $children_arrayref->[0]{"cardnumber"};
  $child0_borrno = $children_arrayref->[0]{"borrowernumber"};

C<&GetGuarantees> takes a borrower number (e.g., that of a patron
with children) and looks up the borrowers who are guaranteed by that
borrower (i.e., the patron's children).

C<&GetGuarantees> returns two values: an integer giving the number of
borrowers guaranteed by C<$parent_borrno>, and a reference to an array
of references to hash, which gives the actual results.

=cut
919
920#'
921sub GetGuarantees {
922
0
    my ($borrowernumber) = @_;
923
0
    my $dbh = C4::Context->dbh;
924
0
    my $sth =
925      $dbh->prepare(
926"select cardnumber,borrowernumber, firstname, surname from borrowers where guarantorid=?"
927      );
928
0
    $sth->execute($borrowernumber);
929
930
0
    my @dat;
931
0
    my $data = $sth->fetchall_arrayref({});
932
0
    return ( scalar(@$data), $data );
933}
934
935 - 943
=head2 UpdateGuarantees

  &UpdateGuarantees($parent_borrno);
  

C<&UpdateGuarantees> borrower data for an adult and updates all the guarantees
with the modified information

=cut
944
945#'
946sub UpdateGuarantees {
947
0
    my %data = shift;
948
0
    my $dbh = C4::Context->dbh;
949
0
    my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
950
0
    foreach my $guarantee (@$guarantees){
951
0
        my $guaquery = qq|UPDATE borrowers
952              SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
953              WHERE borrowernumber=?
954        |;
955
0
        my $sth = $dbh->prepare($guaquery);
956
0
        $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
957    }
958}
959 - 970
=head2 GetPendingIssues

  my $issues = &GetPendingIssues(@borrowernumber);

Looks up what the patron with the given borrowernumber has borrowed.

C<&GetPendingIssues> returns a
reference-to-array where each element is a reference-to-hash; the
keys are the fields from the C<issues>, C<biblio>, and C<items> tables.
The keys include C<biblioitems> fields except marc and marcxml.

=cut
971
972#'
973sub GetPendingIssues {
974
0
    my @borrowernumbers = @_;
975
976
0
    unless (@borrowernumbers ) { # return a ref_to_array
977
0
        return \@borrowernumbers; # to not cause surprise to caller
978    }
979
980    # Borrowers part of the query
981
0
    my $bquery = '';
982    for (my $i = 0; $i < @borrowernumbers; $i++) {
983
0
        $bquery .= ' issues.borrowernumber = ?';
984
0
        if ($i < $#borrowernumbers ) {
985
0
            $bquery .= ' OR';
986        }
987
0
    }
988
989    # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
990    # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
991    # FIXME: circ/ciculation.pl tries to sort by timestamp!
992    # FIXME: C4::Print::printslip tries to sort by timestamp!
993    # FIXME: namespace collision: other collisions possible.
994    # FIXME: most of this data isn't really being used by callers.
995
0
    my $query =
996   "SELECT issues.*,
997            items.*,
998           biblio.*,
999           biblioitems.volume,
1000           biblioitems.number,
1001           biblioitems.itemtype,
1002           biblioitems.isbn,
1003           biblioitems.issn,
1004           biblioitems.publicationyear,
1005           biblioitems.publishercode,
1006           biblioitems.volumedate,
1007           biblioitems.volumedesc,
1008           biblioitems.lccn,
1009           biblioitems.url,
1010           borrowers.firstname,
1011           borrowers.surname,
1012           borrowers.cardnumber,
1013           issues.timestamp AS timestamp,
1014           issues.renewals AS renewals,
1015           issues.borrowernumber AS borrowernumber,
1016            items.renewals AS totalrenewals
1017    FROM issues
1018    LEFT JOIN items ON items.itemnumber = issues.itemnumber
1019    LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1020    LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1021    LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1022    WHERE
1023      $bquery
1024    ORDER BY issues.issuedate"
1025    ;
1026
1027
0
    my $sth = C4::Context->dbh->prepare($query);
1028
0
    $sth->execute(@borrowernumbers);
1029
0
    my $data = $sth->fetchall_arrayref({});
1030
0
    my $today = C4::Dates->new->output('iso');
1031
0
0
    foreach (@{$data}) {
1032
0
        if ($_->{date_due} and $_->{date_due} lt $today) {
1033
0
            $_->{overdue} = 1;
1034        }
1035    }
1036
0
    return $data;
1037}
1038
1039 - 1056
=head2 GetAllIssues

  $issues = &GetAllIssues($borrowernumber, $sortkey, $limit);

Looks up what the patron with the given borrowernumber has borrowed,
and sorts the results.

C<$sortkey> is the name of a field on which to sort the results. This
should be the name of a field in the C<issues>, C<biblio>,
C<biblioitems>, or C<items> table in the Koha database.

C<$limit> is the maximum number of results to return.

C<&GetAllIssues> an arrayref, C<$issues>, of hashrefs, the keys of which
are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
C<items> tables of the Koha database.

=cut
1057
1058#'
1059sub GetAllIssues {
1060
0
    my ( $borrowernumber, $order, $limit ) = @_;
1061
1062    #FIXME: sanity-check order and limit
1063
0
    my $dbh = C4::Context->dbh;
1064
0
    my $query =
1065  "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1066  FROM issues
1067  LEFT JOIN items on items.itemnumber=issues.itemnumber
1068  LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1069  LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1070  WHERE borrowernumber=?
1071  UNION ALL
1072  SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1073  FROM old_issues
1074  LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1075  LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1076  LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1077  WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1078  order by $order";
1079
0
    if ( $limit != 0 ) {
1080
0
        $query .= " limit $limit";
1081    }
1082
1083
0
    my $sth = $dbh->prepare($query);
1084
0
    $sth->execute($borrowernumber, $borrowernumber);
1085
0
    my @result;
1086
0
    my $i = 0;
1087
0
    while ( my $data = $sth->fetchrow_hashref ) {
1088
0
        push @result, $data;
1089    }
1090
1091
0
    return \@result;
1092}
1093
1094
1095 - 1107
=head2 GetMemberAccountRecords

  ($total, $acctlines, $count) = &GetMemberAccountRecords($borrowernumber);

Looks up accounting data for the patron with the given borrowernumber.

C<&GetMemberAccountRecords> returns a three-element array. C<$acctlines> is a
reference-to-array, where each element is a reference-to-hash; the
keys are the fields of the C<accountlines> table in the Koha database.
C<$count> is the number of elements in C<$acctlines>. C<$total> is the
total amount outstanding for all of the account lines.

=cut
1108
1109#'
1110sub GetMemberAccountRecords {
1111
0
    my ($borrowernumber,$date) = @_;
1112
0
    my $dbh = C4::Context->dbh;
1113
0
    my @acctlines;
1114
0
    my $numlines = 0;
1115
0
    my $strsth = qq(
1116                        SELECT *
1117                        FROM accountlines
1118                        WHERE borrowernumber=?);
1119
0
    my @bind = ($borrowernumber);
1120
0
    if ($date && $date ne ''){
1121
0
            $strsth.=" AND date < ? ";
1122
0
            push(@bind,$date);
1123    }
1124
0
    $strsth.=" ORDER BY date desc,timestamp DESC";
1125
0
    my $sth= $dbh->prepare( $strsth );
1126
0
    $sth->execute( @bind );
1127
0
    my $total = 0;
1128
0
    while ( my $data = $sth->fetchrow_hashref ) {
1129
0
        if ( $data->{itemnumber} ) {
1130
0
            my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1131
0
            $data->{biblionumber} = $biblio->{biblionumber};
1132
0
            $data->{title} = $biblio->{title};
1133        }
1134
0
        $acctlines[$numlines] = $data;
1135
0
        $numlines++;
1136
0
        $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1137    }
1138
0
    $total /= 1000;
1139
0
    return ( $total, \@acctlines,$numlines);
1140}
1141
1142 - 1154
=head2 GetBorNotifyAcctRecord

  ($total, $acctlines, $count) = &GetBorNotifyAcctRecord($params,$notifyid);

Looks up accounting data for the patron with the given borrowernumber per file number.

C<&GetBorNotifyAcctRecord> returns a three-element array. C<$acctlines> is a
reference-to-array, where each element is a reference-to-hash; the
keys are the fields of the C<accountlines> table in the Koha database.
C<$count> is the number of elements in C<$acctlines>. C<$total> is the
total amount outstanding for all of the account lines.

=cut
1155
1156sub GetBorNotifyAcctRecord {
1157
0
    my ( $borrowernumber, $notifyid ) = @_;
1158
0
    my $dbh = C4::Context->dbh;
1159
0
    my @acctlines;
1160
0
    my $numlines = 0;
1161
0
    my $sth = $dbh->prepare(
1162            "SELECT *
1163                FROM accountlines
1164                WHERE borrowernumber=?
1165                    AND notify_id=?
1166                    AND amountoutstanding != '0'
1167                ORDER BY notify_id,accounttype
1168                ");
1169
1170
0
    $sth->execute( $borrowernumber, $notifyid );
1171
0
    my $total = 0;
1172
0
    while ( my $data = $sth->fetchrow_hashref ) {
1173
0
        $acctlines[$numlines] = $data;
1174
0
        $numlines++;
1175
0
        $total += int(100 * $data->{'amountoutstanding'});
1176    }
1177
0
    $total /= 100;
1178
0
    return ( $total, \@acctlines, $numlines );
1179}
1180
1181 - 1194
=head2 checkuniquemember (OUEST-PROVENCE)

  ($result,$categorycode)  = &checkuniquemember($collectivity,$surname,$firstname,$dateofbirth);

Checks that a member exists or not in the database.

C<&result> is nonzero (=exist) or 0 (=does not exist)
C<&categorycode> is from categorycode table
C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
C<&surname> is the surname
C<&firstname> is the firstname (only if collectivity=0)
C<&dateofbirth> is the date of birth in ISO format (only if collectivity=0)

=cut
1195
1196# FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1197# This is especially true since first name is not even a required field.
1198
1199sub checkuniquemember {
1200
0
    my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1201
0
    my $dbh = C4::Context->dbh;
1202
0
    my $request = ($collectivity) ?
1203        "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1204            ($dateofbirth) ?
1205            "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1206            "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1207
0
    my $sth = $dbh->prepare($request);
1208
0
    if ($collectivity) {
1209
0
        $sth->execute( uc($surname) );
1210    } elsif($dateofbirth){
1211
0
        $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1212    }else{
1213
0
        $sth->execute( uc($surname), ucfirst($firstname));
1214    }
1215
0
    my @data = $sth->fetchrow;
1216
0
    ( $data[0] ) and return $data[0], $data[1];
1217
0
    return 0;
1218}
1219
1220sub checkcardnumber {
1221
0
    my ($cardnumber,$borrowernumber) = @_;
1222    # If cardnumber is null, we assume they're allowed.
1223
0
    return 0 if !defined($cardnumber);
1224
0
    my $dbh = C4::Context->dbh;
1225
0
    my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1226
0
    $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1227
0
  my $sth = $dbh->prepare($query);
1228
0
  if ($borrowernumber) {
1229
0
   $sth->execute($cardnumber,$borrowernumber);
1230  } else {
1231
0
     $sth->execute($cardnumber);
1232  }
1233
0
    if (my $data= $sth->fetchrow_hashref()){
1234
0
        return 1;
1235    }
1236    else {
1237
0
        return 0;
1238    }
1239}
1240
1241
1242 - 1247
=head2 getzipnamecity (OUEST-PROVENCE)

take all info from table city for the fields city and  zip
check for the name and the zip code of the city selected

=cut
1248
1249sub getzipnamecity {
1250
0
    my ($cityid) = @_;
1251
0
    my $dbh = C4::Context->dbh;
1252
0
    my $sth =
1253      $dbh->prepare(
1254        "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1255
0
    $sth->execute($cityid);
1256
0
    my @data = $sth->fetchrow;
1257
0
    return $data[0], $data[1], $data[2], $data[3];
1258}
1259
1260
1261 - 1265
=head2 getdcity (OUEST-PROVENCE)

recover cityid  with city_name condition

=cut
1266
1267sub getidcity {
1268
0
    my ($city_name) = @_;
1269
0
    my $dbh = C4::Context->dbh;
1270
0
    my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1271
0
    $sth->execute($city_name);
1272
0
    my $data = $sth->fetchrow;
1273
0
    return $data;
1274}
1275
1276 - 1284
=head2 GetFirstValidEmailAddress

  $email = GetFirstValidEmailAddress($borrowernumber);

Return the first valid email address for a borrower, given the borrowernumber.  For now, the order 
is defined as email, emailpro, B_email.  Returns the empty string if the borrower has no email 
addresses.

=cut
1285
1286sub GetFirstValidEmailAddress {
1287
0
    my $borrowernumber = shift;
1288
0
    my $dbh = C4::Context->dbh;
1289
0
    my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1290
0
    $sth->execute( $borrowernumber );
1291
0
    my $data = $sth->fetchrow_hashref;
1292
1293
0
    if ($data->{'email'}) {
1294
0
       return $data->{'email'};
1295    } elsif ($data->{'emailpro'}) {
1296
0
       return $data->{'emailpro'};
1297    } elsif ($data->{'B_email'}) {
1298
0
       return $data->{'B_email'};
1299    } else {
1300
0
       return '';
1301    }
1302}
1303
1304 - 1311
=head2 GetExpiryDate 

  $expirydate = GetExpiryDate($categorycode, $dateenrolled);

Calculate expiry date given a categorycode and starting date.  Date argument must be in ISO format.
Return date is also in ISO format.

=cut
1312
1313sub GetExpiryDate {
1314
0
    my ( $categorycode, $dateenrolled ) = @_;
1315
0
    my $enrolments;
1316
0
    if ($categorycode) {
1317
0
        my $dbh = C4::Context->dbh;
1318
0
        my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1319
0
        $sth->execute($categorycode);
1320
0
        $enrolments = $sth->fetchrow_hashref;
1321    }
1322    # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1323
0
    my @date = split (/-/,$dateenrolled);
1324
0
    if($enrolments->{enrolmentperiod}){
1325
0
        return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1326    }else{
1327
0
        return $enrolments->{enrolmentperioddate};
1328    }
1329}
1330
1331 - 1337
=head2 checkuserpassword (OUEST-PROVENCE)

check for the password and login are not used
return the number of record 
0=> NOT USED 1=> USED

=cut
1338
1339sub checkuserpassword {
1340
0
    my ( $borrowernumber, $userid, $password ) = @_;
1341
0
    $password = md5_base64($password);
1342
0
    my $dbh = C4::Context->dbh;
1343
0
    my $sth =
1344      $dbh->prepare(
1345"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1346      );
1347
0
    $sth->execute( $borrowernumber, $userid, $password );
1348
0
    my $number_rows = $sth->fetchrow;
1349
0
    return $number_rows;
1350
1351}
1352
1353 - 1362
=head2 GetborCatFromCatType

  ($codes_arrayref, $labels_hashref) = &GetborCatFromCatType();

Looks up the different types of borrowers in the database. Returns two
elements: a reference-to-array, which lists the borrower category
codes, and a reference-to-hash, which maps the borrower category codes
to category descriptions.

=cut
1363
1364#'
1365sub GetborCatFromCatType {
1366
0
    my ( $category_type, $action ) = @_;
1367        # FIXME - This API seems both limited and dangerous.
1368
0
    my $dbh = C4::Context->dbh;
1369
0
    my $request = qq| SELECT categorycode,description
1370            FROM categories
1371            $action
1372            ORDER BY categorycode|;
1373
0
    my $sth = $dbh->prepare($request);
1374
0
        if ($action) {
1375
0
        $sth->execute($category_type);
1376    }
1377    else {
1378
0
        $sth->execute();
1379    }
1380
1381
0
    my %labels;
1382
0
    my @codes;
1383
1384
0
    while ( my $data = $sth->fetchrow_hashref ) {
1385
0
        push @codes, $data->{'categorycode'};
1386
0
        $labels{ $data->{'categorycode'} } = $data->{'description'};
1387    }
1388
0
    return ( \@codes, \%labels );
1389}
1390
1391 - 1402
=head2 GetBorrowercategory

  $hashref = &GetBorrowercategory($categorycode);

Given the borrower's category code, the function returns the corresponding
data hashref for a comprehensive information display.

  $arrayref_hashref = &GetBorrowercategory;

If no category code provided, the function returns all the categories.

=cut
1403
1404sub GetBorrowercategory {
1405
0
    my ($catcode) = @_;
1406
0
    my $dbh = C4::Context->dbh;
1407
0
    if ($catcode){
1408
0
        my $sth =
1409        $dbh->prepare(
1410    "SELECT description,dateofbirthrequired,upperagelimit,category_type
1411    FROM categories
1412    WHERE categorycode = ?"
1413        );
1414
0
        $sth->execute($catcode);
1415
0
        my $data =
1416        $sth->fetchrow_hashref;
1417
0
        return $data;
1418    }
1419
0
    return;
1420} # sub getborrowercategory
1421
1422 - 1427
=head2 GetBorrowercategoryList

  $arrayref_hashref = &GetBorrowercategoryList;
If no category code provided, the function returns all the categories.

=cut
1428
1429sub GetBorrowercategoryList {
1430
0
    my $dbh = C4::Context->dbh;
1431
0
    my $sth =
1432    $dbh->prepare(
1433    "SELECT *
1434    FROM categories
1435    ORDER BY description"
1436        );
1437
0
    $sth->execute;
1438
0
    my $data =
1439    $sth->fetchall_arrayref({});
1440
0
    return $data;
1441} # sub getborrowercategory
1442
1443 - 1452
=head2 ethnicitycategories

  ($codes_arrayref, $labels_hashref) = &ethnicitycategories();

Looks up the different ethnic types in the database. Returns two
elements: a reference-to-array, which lists the ethnicity codes, and a
reference-to-hash, which maps the ethnicity codes to ethnicity
descriptions.

=cut
1453
1454#'
1455
1456sub ethnicitycategories {
1457
0
    my $dbh = C4::Context->dbh;
1458
0
    my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1459
0
    $sth->execute;
1460
0
    my %labels;
1461
0
    my @codes;
1462
0
    while ( my $data = $sth->fetchrow_hashref ) {
1463
0
        push @codes, $data->{'code'};
1464
0
        $labels{ $data->{'code'} } = $data->{'name'};
1465    }
1466
0
    return ( \@codes, \%labels );
1467}
1468
1469 - 1477
=head2 fixEthnicity

  $ethn_name = &fixEthnicity($ethn_code);

Takes an ethnicity code (e.g., "european" or "pi") and returns the
corresponding descriptive name from the C<ethnicity> table in the
Koha database ("European" or "Pacific Islander").

=cut
1478
1479#'
1480
1481sub fixEthnicity {
1482
0
    my $ethnicity = shift;
1483
0
    return unless $ethnicity;
1484
0
    my $dbh = C4::Context->dbh;
1485
0
    my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1486
0
    $sth->execute($ethnicity);
1487
0
    my $data = $sth->fetchrow_hashref;
1488
0
    return $data->{'name'};
1489} # sub fixEthnicity
1490
1491 - 1497
=head2 GetAge

  $dateofbirth,$date = &GetAge($date);

this function return the borrowers age with the value of dateofbirth

=cut
1498
1499#'
1500sub GetAge{
1501
0
    my ( $date, $date_ref ) = @_;
1502
1503
0
    if ( not defined $date_ref ) {
1504
0
        $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1505    }
1506
1507
0
    my ( $year1, $month1, $day1 ) = split /-/, $date;
1508
0
    my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1509
1510
0
    my $age = $year2 - $year1;
1511
0
    if ( $month1 . $day1 > $month2 . $day2 ) {
1512
0
        $age--;
1513    }
1514
1515
0
    return $age;
1516} # sub get_age
1517
1518 - 1524
=head2 get_institutions

  $insitutions = get_institutions();

Just returns a list of all the borrowers of type I, borrownumber and name

=cut
1525
1526#'
1527sub get_institutions {
1528
0
    my $dbh = C4::Context->dbh();
1529
0
    my $sth =
1530      $dbh->prepare(
1531"SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1532      );
1533
0
    $sth->execute('I');
1534
0
    my %orgs;
1535
0
    while ( my $data = $sth->fetchrow_hashref() ) {
1536
0
        $orgs{ $data->{'borrowernumber'} } = $data;
1537    }
1538
0
    return ( \%orgs );
1539
1540} # sub get_institutions
1541
1542 - 1548
=head2 add_member_orgs

  add_member_orgs($borrowernumber,$borrowernumbers);

Takes a borrowernumber and a list of other borrowernumbers and inserts them into the borrowers_to_borrowers table

=cut
1549
1550#'
1551sub add_member_orgs {
1552
0
    my ( $borrowernumber, $otherborrowers ) = @_;
1553
0
    my $dbh = C4::Context->dbh();
1554
0
    my $query =
1555      "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1556
0
    my $sth = $dbh->prepare($query);
1557
0
    foreach my $otherborrowernumber (@$otherborrowers) {
1558
0
        $sth->execute( $borrowernumber, $otherborrowernumber );
1559    }
1560
1561} # sub add_member_orgs
1562
1563 - 1571
=head2 GetCities

  $cityarrayref = GetCities();

  Returns an array_ref of the entries in the cities table
  If there are entries in the table an empty row is returned
  This is currently only used to populate a popup in memberentry

=cut
1572
1573sub GetCities {
1574
1575
0
    my $dbh = C4::Context->dbh;
1576
0
    my $city_arr = $dbh->selectall_arrayref(
1577        q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1578        { Slice => {} });
1579
0
0
    if ( @{$city_arr} ) {
1580
0
0
        unshift @{$city_arr}, {
1581            city_zipcode => q{},
1582            city_name => q{},
1583            cityid => q{},
1584            city_state => q{},
1585            city_country => q{},
1586        };
1587    }
1588
1589
0
    return $city_arr;
1590}
1591
1592 - 1601
=head2 GetSortDetails (OUEST-PROVENCE)

  ($lib) = &GetSortDetails($category,$sortvalue);

Returns the authorized value  details
C<&$lib>return value of authorized value details
C<&$sortvalue>this is the value of authorized value 
C<&$category>this is the value of authorized value category

=cut
1602
1603sub GetSortDetails {
1604
0
    my ( $category, $sortvalue ) = @_;
1605
0
    my $dbh = C4::Context->dbh;
1606
0
    my $query = qq|SELECT lib
1607        FROM authorised_values
1608        WHERE category=?
1609        AND authorised_value=? |;
1610
0
    my $sth = $dbh->prepare($query);
1611
0
    $sth->execute( $category, $sortvalue );
1612
0
    my $lib = $sth->fetchrow;
1613
0
    return ($lib) if ($lib);
1614
0
    return ($sortvalue) unless ($lib);
1615}
1616
1617 - 1623
=head2 MoveMemberToDeleted

  $result = &MoveMemberToDeleted($borrowernumber);

Copy the record from borrowers to deletedborrowers table.

=cut
1624
1625# FIXME: should do it in one SQL statement w/ subquery
1626# Otherwise, we should return the @data on success
1627
1628sub MoveMemberToDeleted {
1629
0
    my ($member) = shift or return;
1630
0
    my $dbh = C4::Context->dbh;
1631
0
    my $query = qq|SELECT *
1632          FROM borrowers
1633          WHERE borrowernumber=?|;
1634
0
    my $sth = $dbh->prepare($query);
1635
0
    $sth->execute($member);
1636
0
    my @data = $sth->fetchrow_array;
1637
0
    (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1638
0
    $sth =
1639      $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1640          . ( "?," x ( scalar(@data) - 1 ) )
1641          . "?)" );
1642
0
    $sth->execute(@data);
1643}
1644
1645 - 1652
=head2 DelMember

    DelMember($borrowernumber);

This function remove directly a borrower whitout writing it on deleteborrower.
+ Deletes reserves for the borrower

=cut
1653
1654sub DelMember {
1655
0
    my $dbh = C4::Context->dbh;
1656
0
    my $borrowernumber = shift;
1657    #warn "in delmember with $borrowernumber";
1658
0
    return unless $borrowernumber; # borrowernumber is mandatory.
1659
1660
0
    my $query = qq|DELETE
1661          FROM reserves
1662          WHERE borrowernumber=?|;
1663
0
    my $sth = $dbh->prepare($query);
1664
0
    $sth->execute($borrowernumber);
1665
0
    $query = "
1666       DELETE
1667       FROM borrowers
1668       WHERE borrowernumber = ?
1669   ";
1670
0
    $sth = $dbh->prepare($query);
1671
0
    $sth->execute($borrowernumber);
1672
0
    logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1673
0
    return $sth->rows;
1674}
1675
1676 - 1683
=head2 ExtendMemberSubscriptionTo (OUEST-PROVENCE)

    $date = ExtendMemberSubscriptionTo($borrowerid, $date);

Extending the subscription to a given date or to the expiry date calculated on ISO date.
Returns ISO date.

=cut
1684
1685sub ExtendMemberSubscriptionTo {
1686
0
    my ( $borrowerid,$date) = @_;
1687
0
    my $dbh = C4::Context->dbh;
1688
0
    my $borrower = GetMember('borrowernumber'=>$borrowerid);
1689
0
    unless ($date){
1690
0
      $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1691                                        C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1692                                        C4::Dates->new()->output("iso");
1693
0
      $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1694    }
1695
0
    my $sth = $dbh->do(<<EOF);
1696UPDATE borrowers
1697SET dateexpiry='$date'
1698WHERE borrowernumber='$borrowerid'
1699EOF
1700    # add enrolmentfee if needed
1701
0
    $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1702
0
    $sth->execute($borrower->{'categorycode'});
1703
0
    my ($enrolmentfee) = $sth->fetchrow;
1704
0
    if ($enrolmentfee && $enrolmentfee > 0) {
1705        # insert fee in patron debts
1706
0
        manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1707    }
1708
0
     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1709
0
    return $date if ($sth);
1710
0
    return 0;
1711}
1712
1713 - 1721
=head2 GetRoadTypes (OUEST-PROVENCE)

  ($idroadtypearrayref, $roadttype_hashref) = &GetRoadTypes();

Looks up the different road type . Returns two
elements: a reference-to-array, which lists the id_roadtype
codes, and a reference-to-hash, which maps the road type of the road .

=cut
1722
1723sub GetRoadTypes {
1724
0
    my $dbh = C4::Context->dbh;
1725
0
    my $query = qq|
1726SELECT roadtypeid,road_type
1727FROM roadtype
1728ORDER BY road_type|;
1729
0
    my $sth = $dbh->prepare($query);
1730
0
    $sth->execute();
1731
0
    my %roadtype;
1732
0
    my @id;
1733
1734    # insert empty value to create a empty choice in cgi popup
1735
1736
0
    while ( my $data = $sth->fetchrow_hashref ) {
1737
1738
0
        push @id, $data->{'roadtypeid'};
1739
0
        $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1740    }
1741
1742#test to know if the table contain some records if no the function return nothing
1743
0
    my $id = @id;
1744
0
    if ( $id eq 0 ) {
1745
0
        return ();
1746    }
1747    else {
1748
0
        unshift( @id, "" );
1749
0
        return ( \@id, \%roadtype );
1750    }
1751}
1752
1753
1754
1755 - 1761
=head2 GetTitles (OUEST-PROVENCE)

  ($borrowertitle)= &GetTitles();

Looks up the different title . Returns array  with all borrowers title

=cut
1762
1763sub GetTitles {
1764
0
    my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1765
0
    unshift( @borrowerTitle, "" );
1766
0
    my $count=@borrowerTitle;
1767
0
    if ($count == 1){
1768
0
        return ();
1769    }
1770    else {
1771
0
        return ( \@borrowerTitle);
1772    }
1773}
1774
1775 - 1781
=head2 GetPatronImage

    my ($imagedata, $dberror) = GetPatronImage($cardnumber);

Returns the mimetype and binary image data of the image for the patron with the supplied cardnumber.

=cut
1782
1783sub GetPatronImage {
1784
0
    my ($cardnumber) = @_;
1785
0
    warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1786
0
    my $dbh = C4::Context->dbh;
1787
0
    my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1788
0
    my $sth = $dbh->prepare($query);
1789
0
    $sth->execute($cardnumber);
1790
0
    my $imagedata = $sth->fetchrow_hashref;
1791
0
    warn "Database error!" if $sth->errstr;
1792
0
    return $imagedata, $sth->errstr;
1793}
1794
1795 - 1802
=head2 PutPatronImage

    PutPatronImage($cardnumber, $mimetype, $imgfile);

Stores patron binary image data and mimetype in database.
NOTE: This function is good for updating images as well as inserting new images in the database.

=cut
1803
1804sub PutPatronImage {
1805
0
    my ($cardnumber, $mimetype, $imgfile) = @_;
1806
0
    warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1807
0
    my $dbh = C4::Context->dbh;
1808
0
    my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1809
0
    my $sth = $dbh->prepare($query);
1810
0
    $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1811
0
    warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1812
0
    return $sth->errstr;
1813}
1814
1815 - 1821
=head2 RmPatronImage

    my ($dberror) = RmPatronImage($cardnumber);

Removes the image for the patron with the supplied cardnumber.

=cut
1822
1823sub RmPatronImage {
1824
0
    my ($cardnumber) = @_;
1825
0
    warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1826
0
    my $dbh = C4::Context->dbh;
1827
0
    my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1828
0
    my $sth = $dbh->prepare($query);
1829
0
    $sth->execute($cardnumber);
1830
0
    my $dberror = $sth->errstr;
1831
0
    warn "Database error!" if $sth->errstr;
1832
0
    return $dberror;
1833}
1834
1835 - 1842
=head2 GetHideLostItemsPreference

  $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);

Returns the HideLostItems preference for the patron category of the supplied borrowernumber
C<&$hidelostitemspref>return value of function, 0 or 1

=cut
1843
1844sub GetHideLostItemsPreference {
1845
0
    my ($borrowernumber) = @_;
1846
0
    my $dbh = C4::Context->dbh;
1847
0
    my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1848
0
    my $sth = $dbh->prepare($query);
1849
0
    $sth->execute($borrowernumber);
1850
0
    my $hidelostitems = $sth->fetchrow;
1851
0
    return $hidelostitems;
1852}
1853
1854 - 1862
=head2 GetRoadTypeDetails (OUEST-PROVENCE)

  ($roadtype) = &GetRoadTypeDetails($roadtypeid);

Returns the description of roadtype
C<&$roadtype>return description of road type
C<&$roadtypeid>this is the value of roadtype s

=cut
1863
1864sub GetRoadTypeDetails {
1865
0
    my ($roadtypeid) = @_;
1866
0
    my $dbh = C4::Context->dbh;
1867
0
    my $query = qq|
1868SELECT road_type
1869FROM roadtype
1870WHERE roadtypeid=?|;
1871
0
    my $sth = $dbh->prepare($query);
1872
0
    $sth->execute($roadtypeid);
1873
0
    my $roadtype = $sth->fetchrow;
1874
0
    return ($roadtype);
1875}
1876
1877 - 1883
=head2 GetBorrowersWhoHaveNotBorrowedSince

  &GetBorrowersWhoHaveNotBorrowedSince($date)

this function get all borrowers who haven't borrowed since the date given on input arg.

=cut
1884
1885sub GetBorrowersWhoHaveNotBorrowedSince {
1886
0
    my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1887
0
    my $filterexpiry = shift;
1888
0
    my $filterbranch = shift ||
1889                        ((C4::Context->preference('IndependantBranches')
1890                             && C4::Context->userenv
1891                             && C4::Context->userenv->{flags} % 2 !=1
1892                             && C4::Context->userenv->{branch})
1893                         ? C4::Context->userenv->{branch}
1894                         : "");
1895
0
    my $dbh = C4::Context->dbh;
1896
0
    my $query = "
1897        SELECT borrowers.borrowernumber,
1898               max(old_issues.timestamp) as latestissue,
1899               max(issues.timestamp) as currentissue
1900        FROM borrowers
1901        JOIN categories USING (categorycode)
1902        LEFT JOIN old_issues USING (borrowernumber)
1903        LEFT JOIN issues USING (borrowernumber)
1904        WHERE category_type <> 'S'
1905        AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1906   ";
1907
0
    my @query_params;
1908
0
    if ($filterbranch && $filterbranch ne ""){
1909
0
        $query.=" AND borrowers.branchcode= ?";
1910
0
        push @query_params,$filterbranch;
1911    }
1912
0
    if($filterexpiry){
1913
0
        $query .= " AND dateexpiry < ? ";
1914
0
        push @query_params,$filterdate;
1915    }
1916
0
    $query.=" GROUP BY borrowers.borrowernumber";
1917
0
    if ($filterdate){
1918
0
        $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1919                  AND currentissue IS NULL";
1920
0
        push @query_params,$filterdate;
1921    }
1922
0
    warn $query if $debug;
1923
0
    my $sth = $dbh->prepare($query);
1924
0
    if (scalar(@query_params)>0){
1925
0
        $sth->execute(@query_params);
1926    }
1927    else {
1928
0
        $sth->execute;
1929    }
1930
1931
0
    my @results;
1932
0
    while ( my $data = $sth->fetchrow_hashref ) {
1933
0
        push @results, $data;
1934    }
1935
0
    return \@results;
1936}
1937
1938 - 1946
=head2 GetBorrowersWhoHaveNeverBorrowed

  $results = &GetBorrowersWhoHaveNeverBorrowed

This function get all borrowers who have never borrowed.

I<$result> is a ref to an array which all elements are a hasref.

=cut
1947
1948sub GetBorrowersWhoHaveNeverBorrowed {
1949
0
    my $filterbranch = shift ||
1950                        ((C4::Context->preference('IndependantBranches')
1951                             && C4::Context->userenv
1952                             && C4::Context->userenv->{flags} % 2 !=1
1953                             && C4::Context->userenv->{branch})
1954                         ? C4::Context->userenv->{branch}
1955                         : "");
1956
0
    my $dbh = C4::Context->dbh;
1957
0
    my $query = "
1958        SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1959        FROM borrowers
1960          LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1961        WHERE issues.borrowernumber IS NULL
1962   ";
1963
0
    my @query_params;
1964
0
    if ($filterbranch && $filterbranch ne ""){
1965
0
        $query.=" AND borrowers.branchcode= ?";
1966
0
        push @query_params,$filterbranch;
1967    }
1968
0
    warn $query if $debug;
1969
1970
0
    my $sth = $dbh->prepare($query);
1971
0
    if (scalar(@query_params)>0){
1972
0
        $sth->execute(@query_params);
1973    }
1974    else {
1975
0
        $sth->execute;
1976    }
1977
1978
0
    my @results;
1979
0
    while ( my $data = $sth->fetchrow_hashref ) {
1980
0
        push @results, $data;
1981    }
1982
0
    return \@results;
1983}
1984
1985 - 1994
=head2 GetBorrowersWithIssuesHistoryOlderThan

  $results = &GetBorrowersWithIssuesHistoryOlderThan($date)

this function get all borrowers who has an issue history older than I<$date> given on input arg.

I<$result> is a ref to an array which all elements are a hashref.
This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.

=cut
1995
1996sub GetBorrowersWithIssuesHistoryOlderThan {
1997
0
    my $dbh = C4::Context->dbh;
1998
0
    my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
1999
0
    my $filterbranch = shift ||
2000                        ((C4::Context->preference('IndependantBranches')
2001                             && C4::Context->userenv
2002                             && C4::Context->userenv->{flags} % 2 !=1
2003                             && C4::Context->userenv->{branch})
2004                         ? C4::Context->userenv->{branch}
2005                         : "");
2006
0
    my $query = "
2007       SELECT count(borrowernumber) as n,borrowernumber
2008       FROM old_issues
2009       WHERE returndate < ?
2010         AND borrowernumber IS NOT NULL
2011    ";
2012
0
    my @query_params;
2013
0
    push @query_params, $date;
2014
0
    if ($filterbranch){
2015
0
        $query.=" AND branchcode = ?";
2016
0
        push @query_params, $filterbranch;
2017    }
2018
0
    $query.=" GROUP BY borrowernumber ";
2019
0
    warn $query if $debug;
2020
0
    my $sth = $dbh->prepare($query);
2021
0
    $sth->execute(@query_params);
2022
0
    my @results;
2023
2024
0
    while ( my $data = $sth->fetchrow_hashref ) {
2025
0
        push @results, $data;
2026    }
2027
0
    return \@results;
2028}
2029
2030 - 2039
=head2 GetBorrowersNamesAndLatestIssue

  $results = &GetBorrowersNamesAndLatestIssueList(@borrowernumbers)

this function get borrowers Names and surnames and Issue information.

I<@borrowernumbers> is an array which all elements are borrowernumbers.
This hashref is containt the number of time this borrowers has borrowed before I<$date> and the borrowernumber.

=cut
2040
2041sub GetBorrowersNamesAndLatestIssue {
2042
0
    my $dbh = C4::Context->dbh;
2043
0
    my @borrowernumbers=@_;
2044
0
    my $query = "
2045       SELECT surname,lastname, phone, email,max(timestamp)
2046       FROM borrowers
2047         LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2048       GROUP BY borrowernumber
2049   ";
2050
0
    my $sth = $dbh->prepare($query);
2051
0
    $sth->execute;
2052
0
    my $results = $sth->fetchall_arrayref({});
2053
0
    return $results;
2054}
2055
2056 - 2066
=head2 DebarMember

my $success = DebarMember( $borrowernumber, $todate );

marks a Member as debarred, and therefore unable to checkout any more
items.

return :
true on success, false on failure

=cut
2067
2068sub DebarMember {
2069
0
    my $borrowernumber = shift;
2070
0
    my $todate = shift;
2071
2072
0
    return unless defined $borrowernumber;
2073
0
    return unless $borrowernumber =~ /^\d+$/;
2074
2075
0
    return ModMember(
2076        borrowernumber => $borrowernumber,
2077        debarred => $todate
2078    );
2079
2080}
2081
2082 - 2095
=head2 ModPrivacy

=over 4

my $success = ModPrivacy( $borrowernumber, $privacy );

Update the privacy of a patron.

return :
true on success, false on failure

=back

=cut
2096
2097sub ModPrivacy {
2098
0
    my $borrowernumber = shift;
2099
0
    my $privacy = shift;
2100
0
    return unless defined $borrowernumber;
2101
0
    return unless $borrowernumber =~ /^\d+$/;
2102
2103
0
    return ModMember( borrowernumber => $borrowernumber,
2104                      privacy => $privacy );
2105}
2106
2107 - 2117
=head2 AddMessage

  AddMessage( $borrowernumber, $message_type, $message, $branchcode );

Adds a message to the messages table for the given borrower.

Returns:
  True on success
  False on failure

=cut
2118
2119sub AddMessage {
2120
0
    my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2121
2122
0
    my $dbh = C4::Context->dbh;
2123
2124
0
    if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2125
0
      return;
2126    }
2127
2128
0
    my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2129
0
    my $sth = $dbh->prepare($query);
2130
0
    $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2131
0
    logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2132
0
    return 1;
2133}
2134
2135 - 2144
=head2 GetMessages

  GetMessages( $borrowernumber, $type );

$type is message type, B for borrower, or L for Librarian.
Empty type returns all messages of any type.

Returns all messages for the given borrowernumber

=cut
2145
2146sub GetMessages {
2147
0
    my ( $borrowernumber, $type, $branchcode ) = @_;
2148
2149
0
    if ( ! $type ) {
2150
0
      $type = '%';
2151    }
2152
2153
0
    my $dbh = C4::Context->dbh;
2154
2155
0
    my $query = "SELECT
2156                  branches.branchname,
2157                  messages.*,
2158                  message_date,
2159                  messages.branchcode LIKE '$branchcode' AS can_delete
2160                  FROM messages, branches
2161                  WHERE borrowernumber = ?
2162                  AND message_type LIKE ?
2163                  AND messages.branchcode = branches.branchcode
2164                  ORDER BY message_date DESC";
2165
0
    my $sth = $dbh->prepare($query);
2166
0
    $sth->execute( $borrowernumber, $type ) ;
2167
0
    my @results;
2168
2169
0
    while ( my $data = $sth->fetchrow_hashref ) {
2170
0
        my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2171
0
        $data->{message_date_formatted} = $d->output;
2172
0
        push @results, $data;
2173    }
2174
0
    return \@results;
2175
2176}
2177
2178 - 2187
=head2 GetMessages

  GetMessagesCount( $borrowernumber, $type );

$type is message type, B for borrower, or L for Librarian.
Empty type returns all messages of any type.

Returns the number of messages for the given borrowernumber

=cut
2188
2189sub GetMessagesCount {
2190
0
    my ( $borrowernumber, $type, $branchcode ) = @_;
2191
2192
0
    if ( ! $type ) {
2193
0
      $type = '%';
2194    }
2195
2196
0
    my $dbh = C4::Context->dbh;
2197
2198
0
    my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2199
0
    my $sth = $dbh->prepare($query);
2200
0
    $sth->execute( $borrowernumber, $type ) ;
2201
0
    my @results;
2202
2203
0
    my $data = $sth->fetchrow_hashref;
2204
0
    my $count = $data->{'MsgCount'};
2205
2206
0
    return $count;
2207}
2208
2209
2210
2211 - 2215
=head2 DeleteMessage

  DeleteMessage( $message_id );

=cut
2216
2217sub DeleteMessage {
2218
0
    my ( $message_id ) = @_;
2219
2220
0
    my $dbh = C4::Context->dbh;
2221
0
    my $query = "SELECT * FROM messages WHERE message_id = ?";
2222
0
    my $sth = $dbh->prepare($query);
2223
0
    $sth->execute( $message_id );
2224
0
    my $message = $sth->fetchrow_hashref();
2225
2226
0
    $query = "DELETE FROM messages WHERE message_id = ?";
2227
0
    $sth = $dbh->prepare($query);
2228
0
    $sth->execute( $message_id );
2229
0
    logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2230}
2231
2232
24
9719338
END { } # module clean-up code here (global destructor)
2233
22341;
2235