File Coverage

File:C4/Members.pm
Coverage:6.4%

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
14
14
14
148
92
495
use strict;
24#use warnings; FIXME - Bug 2505
25
14
14
14
660
85
259
use C4::Context;
26
14
14
14
740
104
1076
use C4::Dates qw(format_date_in_iso format_date);
27
14
14
14
123
124
1006
use Digest::MD5 qw(md5_base64);
28
14
14
14
129
89
971
use Date::Calc qw/Today Add_Delta_YM check_date Date_to_Days/;
29
14
14
14
829
67
1668
use C4::Log; # logaction
30
14
14
14
2625
164
4134
use C4::Overdues;
31
14
14
14
228
147
3067
use C4::Reserves;
32
14
14
14
373
101
2369
use C4::Accounts;
33
14
14
14
123
68
7741
use C4::Biblio;
34
14
14
14
691
60
1821
use C4::Letters;
35
14
14
14
4515
85
1483
use C4::SQLHelper qw(InsertInTable UpdateInTable SearchInTable);
36
14
14
14
428
74
900
use C4::Members::Attributes qw(SearchIdMatchingAttribute);
37
14
14
14
2827
36
2517
use C4::NewsChannels; #get slip news
38
14
14
14
156
76
335
use DateTime;
39
14
14
14
602
18075
414
use DateTime::Format::DateParse;
40
14
14
14
613
99
3902
use Koha::DateUtils;
41
42our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,$debug);
43
44BEGIN {
45
14
102
        $VERSION = 3.02;
46
14
259
        $debug = $ENV{DEBUG} || 0;
47
14
154
        require Exporter;
48
14
248
        @ISA = qw(Exporter);
49        #Get data
50
14
371
        push @EXPORT, qw(
51                &Search
52                &GetMemberDetails
53        &GetMemberRelatives
54                &GetMember
55
56                &GetGuarantees
57
58                &GetMemberIssuesAndFines
59                &GetPendingIssues
60                &GetAllIssues
61
62                &get_institutions
63                &getzipnamecity
64                &getidcity
65
66                &GetFirstValidEmailAddress
67
68                &GetAge
69                &GetCities
70                &GetRoadTypes
71                &GetRoadTypeDetails
72                &GetSortDetails
73                &GetTitles
74
75    &GetPatronImage
76    &PutPatronImage
77    &RmPatronImage
78
79                &GetHideLostItemsPreference
80
81                &IsMemberBlocked
82                &GetMemberAccountRecords
83                &GetBorNotifyAcctRecord
84
85                &GetborCatFromCatType
86                &GetBorrowercategory
87    &GetBorrowercategoryList
88
89                &GetBorrowersWhoHaveNotBorrowedSince
90                &GetBorrowersWhoHaveNeverBorrowed
91                &GetBorrowersWithIssuesHistoryOlderThan
92
93                &GetExpiryDate
94
95                &AddMessage
96                &DeleteMessage
97                &GetMessages
98                &GetMessagesCount
99
100        &IssueSlip
101                GetBorrowersWithEmail
102        );
103
104        #Modify data
105
14
90
        push @EXPORT, qw(
106                &ModMember
107                &changepassword
108         &ModPrivacy
109        );
110
111        #Delete data
112
14
129
        push @EXPORT, qw(
113                &DelMember
114        );
115
116        #Insert data
117
14
128
        push @EXPORT, qw(
118                &AddMember
119                &add_member_orgs
120                &MoveMemberToDeleted
121                &ExtendMemberSubscriptionTo
122        );
123
124        #Check data
125
14
54635
    push @EXPORT, qw(
126        &checkuniquemember
127        &checkuserpassword
128        &Check_Userid
129        &Generate_Userid
130        &fixEthnicity
131        &ethnicitycategories
132        &fixup_cardnumber
133        &checkcardnumber
134    );
135}
136
137 - 170
=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
171
172sub _express_member_find {
173
0
    my ($filter) = @_;
174
175    # this is used by circulation everytime a new borrowers cardnumber is scanned
176    # so we can check an exact match first, if that works return, otherwise do the rest
177
0
    my $dbh = C4::Context->dbh;
178
0
    my $query = "SELECT borrowernumber FROM borrowers WHERE cardnumber = ?";
179
0
    if ( my $borrowernumber = $dbh->selectrow_array($query, undef, $filter) ) {
180
0
        return( {"borrowernumber"=>$borrowernumber} );
181    }
182
183
0
    my ($search_on_fields, $searchtype);
184
0
    if ( length($filter) == 1 ) {
185
0
        $search_on_fields = [ qw(surname) ];
186
0
        $searchtype = 'start_with';
187    } else {
188
0
        $search_on_fields = [ qw(surname firstname othernames cardnumber) ];
189
0
        $searchtype = 'contain';
190    }
191
192
0
    return (undef, $search_on_fields, $searchtype);
193}
194
195sub Search {
196
0
    my ( $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype ) = @_;
197
198
0
    my $search_string;
199
0
    my $found_borrower;
200
201
0
    if ( my $fr = ref $filter ) {
202
0
        if ( $fr eq "HASH" ) {
203
0
            if ( my $search_string = $filter->{''} ) {
204
0
                my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
205
0
                if ($member_filter) {
206
0
                    $filter = $member_filter;
207
0
                    $found_borrower = 1;
208                } else {
209
0
                    $search_on_fields ||= $member_search_on_fields;
210
0
                    $searchtype ||= $member_searchtype;
211                }
212            }
213        }
214        else {
215
0
            $search_string = $filter;
216        }
217    }
218    else {
219
0
        $search_string = $filter;
220
0
        my ($member_filter, $member_search_on_fields, $member_searchtype) = _express_member_find($search_string);
221
0
        if ($member_filter) {
222
0
            $filter = $member_filter;
223
0
            $found_borrower = 1;
224        } else {
225
0
            $search_on_fields ||= $member_search_on_fields;
226
0
            $searchtype ||= $member_searchtype;
227        }
228    }
229
230
0
    if ( !$found_borrower && C4::Context->preference('ExtendedPatronAttributes') && $search_string ) {
231
0
        my $matching_records = C4::Members::Attributes::SearchIdMatchingAttribute($search_string);
232
0
        if(scalar(@$matching_records)>0) {
233
0
            if ( my $fr = ref $filter ) {
234
0
                if ( $fr eq "HASH" ) {
235
0
                    my %f = %$filter;
236
0
                    $filter = [ $filter ];
237
0
                    delete $f{''};
238
0
                    push @$filter, { %f, "borrowernumber"=>$$matching_records };
239                }
240                else {
241
0
                    push @$filter, {"borrowernumber"=>$matching_records};
242                }
243            }
244            else {
245
0
                $filter = [ $filter ];
246
0
                push @$filter, {"borrowernumber"=>$matching_records};
247            }
248                }
249    }
250
251    # $showallbranches was not used at the time SearchMember() was mainstreamed into Search().
252    # Mentioning for the reference
253
254
0
    if ( C4::Context->preference("IndependantBranches") ) { # && !$showallbranches){
255
0
        if ( my $userenv = C4::Context->userenv ) {
256
0
            my $branch = $userenv->{'branch'};
257
0
            if ( ($userenv->{flags} % 2 !=1) &&
258                 $branch && $branch ne "insecure" ){
259
260
0
                if (my $fr = ref $filter) {
261
0
                    if ( $fr eq "HASH" ) {
262
0
                        $filter->{branchcode} = $branch;
263                    }
264                    else {
265
0
                        foreach (@$filter) {
266
0
                            $_ = { '' => $_ } unless ref $_;
267
0
                            $_->{branchcode} = $branch;
268                        }
269                    }
270                }
271                else {
272
0
                    $filter = { '' => $filter, branchcode => $branch };
273                }
274            }
275        }
276    }
277
278
0
    if ($found_borrower) {
279
0
        $searchtype = "exact";
280    }
281
0
    $searchtype ||= "start_with";
282
283
0
        return SearchInTable( "borrowers", $filter, $orderby, $limit, $columns_out, $search_on_fields, $searchtype );
284}
285
286 - 316
=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
317
318sub GetMemberDetails {
319
0
    my ( $borrowernumber, $cardnumber ) = @_;
320
0
    my $dbh = C4::Context->dbh;
321
0
    my $query;
322
0
    my $sth;
323
0
    if ($borrowernumber) {
324
0
        $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE borrowernumber=?");
325
0
        $sth->execute($borrowernumber);
326    }
327    elsif ($cardnumber) {
328
0
        $sth = $dbh->prepare("SELECT borrowers.*,category_type,categories.description,reservefee,enrolmentperiod FROM borrowers LEFT JOIN categories ON borrowers.categorycode=categories.categorycode WHERE cardnumber=?");
329
0
        $sth->execute($cardnumber);
330    }
331    else {
332
0
        return undef;
333    }
334
0
    my $borrower = $sth->fetchrow_hashref;
335
0
    my ($amount) = GetMemberAccountRecords( $borrowernumber);
336
0
    $borrower->{'amountoutstanding'} = $amount;
337    # FIXME - patronflags calls GetMemberAccountRecords... just have patronflags return $amount
338
0
    my $flags = patronflags( $borrower);
339
0
    my $accessflagshash;
340
341
0
    $sth = $dbh->prepare("select bit,flag from userflags");
342
0
    $sth->execute;
343
0
    while ( my ( $bit, $flag ) = $sth->fetchrow ) {
344
0
        if ( $borrower->{'flags'} && $borrower->{'flags'} & 2**$bit ) {
345
0
            $accessflagshash->{$flag} = 1;
346        }
347    }
348
0
    $borrower->{'flags'} = $flags;
349
0
    $borrower->{'authflags'} = $accessflagshash;
350
351    # For the purposes of making templates easier, we'll define a
352    # 'showname' which is the alternate form the user's first name if
353    # 'other name' is defined.
354
0
    if ($borrower->{category_type} eq 'I') {
355
0
        $borrower->{'showname'} = $borrower->{'othernames'};
356
0
        $borrower->{'showname'} .= " $borrower->{'firstname'}" if $borrower->{'firstname'};
357    } else {
358
0
        $borrower->{'showname'} = $borrower->{'firstname'};
359    }
360
361
0
    return ($borrower); #, $flags, $accessflagshash);
362}
363
364 - 423
=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
424
425# TODO: use {anonymous => hashes} instead of a dozen %flaginfo
426# FIXME rename this function.
427sub patronflags {
428
0
    my %flags;
429
0
    my ( $patroninformation) = @_;
430
0
    my $dbh=C4::Context->dbh;
431
0
    my ($amount) = GetMemberAccountRecords( $patroninformation->{'borrowernumber'});
432
0
    if ( $amount > 0 ) {
433
0
        my %flaginfo;
434
0
        my $noissuescharge = C4::Context->preference("noissuescharge") || 5;
435
0
        $flaginfo{'message'} = sprintf "Patron owes \$%.02f", $amount;
436
0
        $flaginfo{'amount'} = sprintf "%.02f", $amount;
437
0
        if ( $amount > $noissuescharge && !C4::Context->preference("AllowFineOverride") ) {
438
0
            $flaginfo{'noissues'} = 1;
439        }
440
0
        $flags{'CHARGES'} = \%flaginfo;
441    }
442    elsif ( $amount < 0 ) {
443
0
        my %flaginfo;
444
0
        $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
445
0
        $flaginfo{'amount'} = sprintf "%.02f", $amount;
446
0
        $flags{'CREDITS'} = \%flaginfo;
447    }
448
0
    if ( $patroninformation->{'gonenoaddress'}
449        && $patroninformation->{'gonenoaddress'} == 1 )
450    {
451
0
        my %flaginfo;
452
0
        $flaginfo{'message'} = 'Borrower has no valid address.';
453
0
        $flaginfo{'noissues'} = 1;
454
0
        $flags{'GNA'} = \%flaginfo;
455    }
456
0
    if ( $patroninformation->{'lost'} && $patroninformation->{'lost'} == 1 ) {
457
0
        my %flaginfo;
458
0
        $flaginfo{'message'} = 'Borrower\'s card reported lost.';
459
0
        $flaginfo{'noissues'} = 1;
460
0
        $flags{'LOST'} = \%flaginfo;
461    }
462
0
    if ( $patroninformation->{'debarred'} && check_date( split( /-/, $patroninformation->{'debarred'} ) ) ) {
463
0
        if ( Date_to_Days(Date::Calc::Today) < Date_to_Days( split( /-/, $patroninformation->{'debarred'} ) ) ) {
464
0
            my %flaginfo;
465
0
            $flaginfo{'debarredcomment'} = $patroninformation->{'debarredcomment'};
466
0
            $flaginfo{'message'} = $patroninformation->{'debarredcomment'};
467
0
            $flaginfo{'noissues'} = 1;
468
0
            $flaginfo{'dateend'} = $patroninformation->{'debarred'};
469
0
            $flags{'DBARRED'} = \%flaginfo;
470        }
471    }
472
0
    if ( $patroninformation->{'borrowernotes'}
473        && $patroninformation->{'borrowernotes'} )
474    {
475
0
        my %flaginfo;
476
0
        $flaginfo{'message'} = $patroninformation->{'borrowernotes'};
477
0
        $flags{'NOTES'} = \%flaginfo;
478    }
479
0
    my ( $odues, $itemsoverdue ) = C4::Overdues::checkoverdues($patroninformation->{'borrowernumber'});
480
0
    if ( $odues && $odues > 0 ) {
481
0
        my %flaginfo;
482
0
        $flaginfo{'message'} = "Yes";
483
0
        $flaginfo{'itemlist'} = $itemsoverdue;
484
0
0
        foreach ( sort { $a->{'date_due'} cmp $b->{'date_due'} }
485            @$itemsoverdue )
486        {
487
0
            $flaginfo{'itemlisttext'} .=
488              "$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; # newline is display layer
489        }
490
0
        $flags{'ODUES'} = \%flaginfo;
491    }
492
0
    my @itemswaiting = C4::Reserves::GetReservesFromBorrowernumber( $patroninformation->{'borrowernumber'},'W' );
493
0
    my $nowaiting = scalar @itemswaiting;
494
0
    if ( $nowaiting > 0 ) {
495
0
        my %flaginfo;
496
0
        $flaginfo{'message'} = "Reserved items available";
497
0
        $flaginfo{'itemlist'} = \@itemswaiting;
498
0
        $flags{'WAITING'} = \%flaginfo;
499    }
500
0
    return ( \%flags );
501}
502
503
504 - 521
=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
522
523#'
524sub GetMember {
525
0
    my ( %information ) = @_;
526
0
    if (exists $information{borrowernumber} && !defined $information{borrowernumber}) {
527        #passing mysql's kohaadmin?? Makes no sense as a query
528
0
        return;
529    }
530
0
    my $dbh = C4::Context->dbh;
531
0
    my $select =
532    q{SELECT borrowers.*, categories.category_type, categories.description
533    FROM borrowers
534    LEFT JOIN categories on borrowers.categorycode=categories.categorycode WHERE };
535
0
    my $more_p = 0;
536
0
    my @values = ();
537
0
    for (keys %information ) {
538
0
        if ($more_p) {
539
0
            $select .= ' AND ';
540        }
541        else {
542
0
            $more_p++;
543        }
544
545
0
        if (defined $information{$_}) {
546
0
            $select .= "$_ = ?";
547
0
            push @values, $information{$_};
548        }
549        else {
550
0
            $select .= "$_ IS NULL";
551        }
552    }
553
0
    $debug && warn $select, " ",values %information;
554
0
    my $sth = $dbh->prepare("$select");
555
0
0
    $sth->execute(map{$information{$_}} keys %information);
556
0
    my $data = $sth->fetchall_arrayref({});
557    #FIXME interface to this routine now allows generation of a result set
558    #so whole array should be returned but bowhere in the current code expects this
559
0
0
    if (@{$data} ) {
560
0
        return $data->[0];
561    }
562
563
0
    return;
564}
565
566 - 572
=head2 GetMemberRelatives

 @borrowernumbers = GetMemberRelatives($borrowernumber);

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

=cut 
573sub GetMemberRelatives {
574
0
    my $borrowernumber = shift;
575
0
    my $dbh = C4::Context->dbh;
576
0
    my @glist;
577
578    # Getting guarantor
579
0
    my $query = "SELECT guarantorid FROM borrowers WHERE borrowernumber=?";
580
0
    my $sth = $dbh->prepare($query);
581
0
    $sth->execute($borrowernumber);
582
0
    my $data = $sth->fetchrow_arrayref();
583
0
    push @glist, $data->[0] if $data->[0];
584
0
    my $guarantor = $data->[0] if $data->[0];
585
586    # Getting guarantees
587
0
    $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
588
0
    $sth = $dbh->prepare($query);
589
0
    $sth->execute($borrowernumber);
590
0
    while ($data = $sth->fetchrow_arrayref()) {
591
0
       push @glist, $data->[0];
592    }
593
594    # Getting sibling guarantees
595
0
    if ($guarantor) {
596
0
        $query = "SELECT borrowernumber FROM borrowers WHERE guarantorid=?";
597
0
        $sth = $dbh->prepare($query);
598
0
        $sth->execute($guarantor);
599
0
        while ($data = $sth->fetchrow_arrayref()) {
600
0
           push @glist, $data->[0] if ($data->[0] != $borrowernumber);
601        }
602    }
603
604
0
    return @glist;
605}
606
607 - 630
=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
631
632sub IsMemberBlocked {
633
0
    my $borrowernumber = shift;
634
0
    my $dbh = C4::Context->dbh;
635
636
0
    my $blockeddate = CheckBorrowerDebarred($borrowernumber);
637
638
0
    return ( 1, $blockeddate ) if $blockeddate;
639
640    # if he have late issues
641
0
    my $sth = $dbh->prepare(
642        "SELECT COUNT(*) as latedocs
643         FROM issues
644         WHERE borrowernumber = ?
645         AND date_due < now()"
646    );
647
0
    $sth->execute($borrowernumber);
648
0
    my $latedocs = $sth->fetchrow_hashref->{'latedocs'};
649
650
0
    return ( -1, $latedocs ) if $latedocs > 0;
651
652
0
    return ( 0, 0 );
653}
654
655 - 667
=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
668
669#'
670sub GetMemberIssuesAndFines {
671
0
    my ( $borrowernumber ) = @_;
672
0
    my $dbh = C4::Context->dbh;
673
0
    my $query = "SELECT COUNT(*) FROM issues WHERE borrowernumber = ?";
674
675
0
    $debug and warn $query."\n";
676
0
    my $sth = $dbh->prepare($query);
677
0
    $sth->execute($borrowernumber);
678
0
    my $issue_count = $sth->fetchrow_arrayref->[0];
679
680
0
    $sth = $dbh->prepare(
681        "SELECT COUNT(*) FROM issues
682         WHERE borrowernumber = ?
683         AND date_due < now()"
684    );
685
0
    $sth->execute($borrowernumber);
686
0
    my $overdue_count = $sth->fetchrow_arrayref->[0];
687
688
0
    $sth = $dbh->prepare("SELECT SUM(amountoutstanding) FROM accountlines WHERE borrowernumber = ?");
689
0
    $sth->execute($borrowernumber);
690
0
    my $total_fines = $sth->fetchrow_arrayref->[0];
691
692
0
    return ($overdue_count, $issue_count, $total_fines);
693}
694
695sub columns(;$) {
696
0
0
    return @{C4::Context->dbh->selectcol_arrayref("SHOW columns from borrowers")};
697}
698
699 - 709
=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
710
711sub ModMember {
712
0
    my (%data) = @_;
713    # test to know if you must update or not the borrower password
714
0
    if (exists $data{password}) {
715
0
        if ($data{password} eq '****' or $data{password} eq '') {
716
0
            delete $data{password};
717        } else {
718
0
            $data{password} = md5_base64($data{password});
719        }
720    }
721
0
        my $execute_success=UpdateInTable("borrowers",\%data);
722
0
    if ($execute_success) { # only proceed if the update was a success
723        # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
724        # so when we update information for an adult we should check for guarantees and update the relevant part
725        # of their records, ie addresses and phone numbers
726
0
        my $borrowercategory= GetBorrowercategory( $data{'category_type'} );
727
0
        if ( exists $borrowercategory->{'category_type'} && $borrowercategory->{'category_type'} eq ('A' || 'S') ) {
728            # is adult check guarantees;
729
0
            UpdateGuarantees(%data);
730        }
731
0
        logaction("MEMBERS", "MODIFY", $data{'borrowernumber'}, "UPDATE (executed w/ arg: $data{'borrowernumber'})") if C4::Context->preference("BorrowersLog");
732    }
733
0
    return $execute_success;
734}
735
736
737 - 746
=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
747
748#'
749sub AddMember {
750
0
    my (%data) = @_;
751
0
    my $dbh = C4::Context->dbh;
752        # generate a proper login if none provided
753
0
        $data{'userid'} = Generate_Userid($data{'borrowernumber'}, $data{'firstname'}, $data{'surname'}) if $data{'userid'} eq '';
754        # create a disabled account if no password provided
755
0
        $data{'password'} = ($data{'password'})? md5_base64($data{'password'}) : '!';
756
0
        $data{'borrowernumber'}=InsertInTable("borrowers",\%data);
757    # mysql_insertid is probably bad. not necessarily accurate and mysql-specific at best.
758
0
    logaction("MEMBERS", "CREATE", $data{'borrowernumber'}, "") if C4::Context->preference("BorrowersLog");
759
760    # check for enrollment fee & add it if needed
761
0
    my $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
762
0
    $sth->execute($data{'categorycode'});
763
0
    my ($enrolmentfee) = $sth->fetchrow;
764
0
    if ($sth->err) {
765
0
        warn sprintf('Database returned the following error: %s', $sth->errstr);
766
0
        return;
767    }
768
0
    if ($enrolmentfee && $enrolmentfee > 0) {
769        # insert fee in patron debts
770
0
        manualinvoice($data{'borrowernumber'}, '', '', 'A', $enrolmentfee);
771    }
772
773
0
    return $data{'borrowernumber'};
774}
775
776
777sub Check_Userid {
778
0
    my ($uid,$member) = @_;
779
0
    my $dbh = C4::Context->dbh;
780    # Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
781    # Then we need to tell the user and have them create a new one.
782
0
    my $sth =
783      $dbh->prepare(
784        "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
785
0
    $sth->execute( $uid, $member );
786
0
    if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
787
0
        return 0;
788    }
789    else {
790
0
        return 1;
791    }
792}
793
794sub Generate_Userid {
795
0
  my ($borrowernumber, $firstname, $surname) = @_;
796
0
  my $newuid;
797
0
  my $offset = 0;
798
0
  do {
799
0
    $firstname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
800
0
    $surname =~ s/[[:digit:][:space:][:blank:][:punct:][:cntrl:]]//g;
801
0
    $newuid = lc(($firstname)? "$firstname.$surname" : $surname);
802
0
    $newuid .= $offset unless $offset == 0;
803
0
    $offset++;
804
805   } while (!Check_Userid($newuid,$borrowernumber));
806
807
0
   return $newuid;
808}
809
810sub changepassword {
811
0
    my ( $uid, $member, $digest ) = @_;
812
0
    my $dbh = C4::Context->dbh;
813
814#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
815#Then we need to tell the user and have them create a new one.
816
0
    my $resultcode;
817
0
    my $sth =
818      $dbh->prepare(
819        "SELECT * FROM borrowers WHERE userid=? AND borrowernumber != ?");
820
0
    $sth->execute( $uid, $member );
821
0
    if ( ( $uid ne '' ) && ( my $row = $sth->fetchrow_hashref ) ) {
822
0
        $resultcode=0;
823    }
824    else {
825        #Everything is good so we can update the information.
826
0
        $sth =
827          $dbh->prepare(
828            "update borrowers set userid=?, password=? where borrowernumber=?");
829
0
        $sth->execute( $uid, $digest, $member );
830
0
        $resultcode=1;
831    }
832
833
0
    logaction("MEMBERS", "CHANGE PASS", $member, "") if C4::Context->preference("BorrowersLog");
834
0
    return $resultcode;
835}
836
837
838
839 - 844
=head2 fixup_cardnumber

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

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

  &UpdateGuarantees($parent_borrno);
  

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

=cut
952
953#'
954sub UpdateGuarantees {
955
0
    my %data = shift;
956
0
    my $dbh = C4::Context->dbh;
957
0
    my ( $count, $guarantees ) = GetGuarantees( $data{'borrowernumber'} );
958
0
    foreach my $guarantee (@$guarantees){
959
0
        my $guaquery = qq|UPDATE borrowers
960              SET address=?,fax=?,B_city=?,mobile=?,city=?,phone=?
961              WHERE borrowernumber=?
962        |;
963
0
        my $sth = $dbh->prepare($guaquery);
964
0
        $sth->execute($data{'address'},$data{'fax'},$data{'B_city'},$data{'mobile'},$data{'city'},$data{'phone'},$guarantee->{'borrowernumber'});
965    }
966}
967 - 978
=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
979
980#'
981sub GetPendingIssues {
982
0
    my @borrowernumbers = @_;
983
984
0
    unless (@borrowernumbers ) { # return a ref_to_array
985
0
        return \@borrowernumbers; # to not cause surprise to caller
986    }
987
988    # Borrowers part of the query
989
0
    my $bquery = '';
990    for (my $i = 0; $i < @borrowernumbers; $i++) {
991
0
        $bquery .= ' issues.borrowernumber = ?';
992
0
        if ($i < $#borrowernumbers ) {
993
0
            $bquery .= ' OR';
994        }
995
0
    }
996
997    # must avoid biblioitems.* to prevent large marc and marcxml fields from killing performance
998    # FIXME: namespace collision: each table has "timestamp" fields. Which one is "timestamp" ?
999    # FIXME: circ/ciculation.pl tries to sort by timestamp!
1000    # FIXME: C4::Print::printslip tries to sort by timestamp!
1001    # FIXME: namespace collision: other collisions possible.
1002    # FIXME: most of this data isn't really being used by callers.
1003
0
    my $query =
1004   "SELECT issues.*,
1005            items.*,
1006           biblio.*,
1007           biblioitems.volume,
1008           biblioitems.number,
1009           biblioitems.itemtype,
1010           biblioitems.isbn,
1011           biblioitems.issn,
1012           biblioitems.publicationyear,
1013           biblioitems.publishercode,
1014           biblioitems.volumedate,
1015           biblioitems.volumedesc,
1016           biblioitems.lccn,
1017           biblioitems.url,
1018           borrowers.firstname,
1019           borrowers.surname,
1020           borrowers.cardnumber,
1021           issues.timestamp AS timestamp,
1022           issues.renewals AS renewals,
1023           issues.borrowernumber AS borrowernumber,
1024            items.renewals AS totalrenewals
1025    FROM issues
1026    LEFT JOIN items ON items.itemnumber = issues.itemnumber
1027    LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1028    LEFT JOIN biblioitems ON items.biblioitemnumber = biblioitems.biblioitemnumber
1029    LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
1030    WHERE
1031      $bquery
1032    ORDER BY issues.issuedate"
1033    ;
1034
1035
0
    my $sth = C4::Context->dbh->prepare($query);
1036
0
    $sth->execute(@borrowernumbers);
1037
0
    my $data = $sth->fetchall_arrayref({});
1038
0
    my $tz = C4::Context->tz();
1039
0
    my $today = DateTime->now( time_zone => $tz);
1040
0
0
    foreach (@{$data}) {
1041
0
        if ($_->{issuedate}) {
1042
0
            $_->{issuedate} = dt_from_string($_->{issuedate}, 'sql');
1043        }
1044
0
        $_->{date_due} or next;
1045
0
        $_->{date_due} = DateTime::Format::DateParse->parse_datetime($_->{date_due}, $tz->name());
1046
0
        if ( DateTime->compare($_->{date_due}, $today) == -1 ) {
1047
0
            $_->{overdue} = 1;
1048        }
1049    }
1050
0
    return $data;
1051}
1052
1053 - 1070
=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
1071
1072#'
1073sub GetAllIssues {
1074
0
    my ( $borrowernumber, $order, $limit ) = @_;
1075
1076    #FIXME: sanity-check order and limit
1077
0
    my $dbh = C4::Context->dbh;
1078
0
    my $query =
1079  "SELECT *, issues.timestamp as issuestimestamp, issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1080  FROM issues
1081  LEFT JOIN items on items.itemnumber=issues.itemnumber
1082  LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1083  LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1084  WHERE borrowernumber=?
1085  UNION ALL
1086  SELECT *, old_issues.timestamp as issuestimestamp, old_issues.renewals AS renewals,items.renewals AS totalrenewals,items.timestamp AS itemstimestamp
1087  FROM old_issues
1088  LEFT JOIN items on items.itemnumber=old_issues.itemnumber
1089  LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1090  LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
1091  WHERE borrowernumber=? AND old_issues.itemnumber IS NOT NULL
1092  order by $order";
1093
0
    if ( $limit != 0 ) {
1094
0
        $query .= " limit $limit";
1095    }
1096
1097
0
    my $sth = $dbh->prepare($query);
1098
0
    $sth->execute($borrowernumber, $borrowernumber);
1099
0
    my @result;
1100
0
    my $i = 0;
1101
0
    while ( my $data = $sth->fetchrow_hashref ) {
1102
0
        push @result, $data;
1103    }
1104
1105
0
    return \@result;
1106}
1107
1108
1109 - 1121
=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
1122
1123#'
1124sub GetMemberAccountRecords {
1125
0
    my ($borrowernumber,$date) = @_;
1126
0
    my $dbh = C4::Context->dbh;
1127
0
    my @acctlines;
1128
0
    my $numlines = 0;
1129
0
    my $strsth = qq(
1130                        SELECT *
1131                        FROM accountlines
1132                        WHERE borrowernumber=?);
1133
0
    my @bind = ($borrowernumber);
1134
0
    if ($date && $date ne ''){
1135
0
            $strsth.=" AND date < ? ";
1136
0
            push(@bind,$date);
1137    }
1138
0
    $strsth.=" ORDER BY date desc,timestamp DESC";
1139
0
    my $sth= $dbh->prepare( $strsth );
1140
0
    $sth->execute( @bind );
1141
0
    my $total = 0;
1142
0
    while ( my $data = $sth->fetchrow_hashref ) {
1143
0
        if ( $data->{itemnumber} ) {
1144
0
            my $biblio = GetBiblioFromItemNumber( $data->{itemnumber} );
1145
0
            $data->{biblionumber} = $biblio->{biblionumber};
1146
0
            $data->{title} = $biblio->{title};
1147        }
1148
0
        $acctlines[$numlines] = $data;
1149
0
        $numlines++;
1150
0
        $total += int(1000 * $data->{'amountoutstanding'}); # convert float to integer to avoid round-off errors
1151    }
1152
0
    $total /= 1000;
1153
0
    return ( $total, \@acctlines,$numlines);
1154}
1155
1156 - 1168
=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
1169
1170sub GetBorNotifyAcctRecord {
1171
0
    my ( $borrowernumber, $notifyid ) = @_;
1172
0
    my $dbh = C4::Context->dbh;
1173
0
    my @acctlines;
1174
0
    my $numlines = 0;
1175
0
    my $sth = $dbh->prepare(
1176            "SELECT *
1177                FROM accountlines
1178                WHERE borrowernumber=?
1179                    AND notify_id=?
1180                    AND amountoutstanding != '0'
1181                ORDER BY notify_id,accounttype
1182                ");
1183
1184
0
    $sth->execute( $borrowernumber, $notifyid );
1185
0
    my $total = 0;
1186
0
    while ( my $data = $sth->fetchrow_hashref ) {
1187
0
        $acctlines[$numlines] = $data;
1188
0
        $numlines++;
1189
0
        $total += int(100 * $data->{'amountoutstanding'});
1190    }
1191
0
    $total /= 100;
1192
0
    return ( $total, \@acctlines, $numlines );
1193}
1194
1195 - 1208
=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
1209
1210# FIXME: This function is not legitimate. Multiple patrons might have the same first/last name and birthdate.
1211# This is especially true since first name is not even a required field.
1212
1213sub checkuniquemember {
1214
0
    my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
1215
0
    my $dbh = C4::Context->dbh;
1216
0
    my $request = ($collectivity) ?
1217        "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? " :
1218            ($dateofbirth) ?
1219            "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=? and dateofbirth=?" :
1220            "SELECT borrowernumber,categorycode FROM borrowers WHERE surname=? and firstname=?";
1221
0
    my $sth = $dbh->prepare($request);
1222
0
    if ($collectivity) {
1223
0
        $sth->execute( uc($surname) );
1224    } elsif($dateofbirth){
1225
0
        $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
1226    }else{
1227
0
        $sth->execute( uc($surname), ucfirst($firstname));
1228    }
1229
0
    my @data = $sth->fetchrow;
1230
0
    ( $data[0] ) and return $data[0], $data[1];
1231
0
    return 0;
1232}
1233
1234sub checkcardnumber {
1235
0
    my ($cardnumber,$borrowernumber) = @_;
1236    # If cardnumber is null, we assume they're allowed.
1237
0
    return 0 if !defined($cardnumber);
1238
0
    my $dbh = C4::Context->dbh;
1239
0
    my $query = "SELECT * FROM borrowers WHERE cardnumber=?";
1240
0
    $query .= " AND borrowernumber <> ?" if ($borrowernumber);
1241
0
  my $sth = $dbh->prepare($query);
1242
0
  if ($borrowernumber) {
1243
0
   $sth->execute($cardnumber,$borrowernumber);
1244  } else {
1245
0
     $sth->execute($cardnumber);
1246  }
1247
0
    if (my $data= $sth->fetchrow_hashref()){
1248
0
        return 1;
1249    }
1250    else {
1251
0
        return 0;
1252    }
1253}
1254
1255
1256 - 1261
=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
1262
1263sub getzipnamecity {
1264
0
    my ($cityid) = @_;
1265
0
    my $dbh = C4::Context->dbh;
1266
0
    my $sth =
1267      $dbh->prepare(
1268        "select city_name,city_state,city_zipcode,city_country from cities where cityid=? ");
1269
0
    $sth->execute($cityid);
1270
0
    my @data = $sth->fetchrow;
1271
0
    return $data[0], $data[1], $data[2], $data[3];
1272}
1273
1274
1275 - 1279
=head2 getdcity (OUEST-PROVENCE)

recover cityid  with city_name condition

=cut
1280
1281sub getidcity {
1282
0
    my ($city_name) = @_;
1283
0
    my $dbh = C4::Context->dbh;
1284
0
    my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
1285
0
    $sth->execute($city_name);
1286
0
    my $data = $sth->fetchrow;
1287
0
    return $data;
1288}
1289
1290 - 1298
=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
1299
1300sub GetFirstValidEmailAddress {
1301
0
    my $borrowernumber = shift;
1302
0
    my $dbh = C4::Context->dbh;
1303
0
    my $sth = $dbh->prepare( "SELECT email, emailpro, B_email FROM borrowers where borrowernumber = ? ");
1304
0
    $sth->execute( $borrowernumber );
1305
0
    my $data = $sth->fetchrow_hashref;
1306
1307
0
    if ($data->{'email'}) {
1308
0
       return $data->{'email'};
1309    } elsif ($data->{'emailpro'}) {
1310
0
       return $data->{'emailpro'};
1311    } elsif ($data->{'B_email'}) {
1312
0
       return $data->{'B_email'};
1313    } else {
1314
0
       return '';
1315    }
1316}
1317
1318 - 1325
=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
1326
1327sub GetExpiryDate {
1328
0
    my ( $categorycode, $dateenrolled ) = @_;
1329
0
    my $enrolments;
1330
0
    if ($categorycode) {
1331
0
        my $dbh = C4::Context->dbh;
1332
0
        my $sth = $dbh->prepare("SELECT enrolmentperiod,enrolmentperioddate FROM categories WHERE categorycode=?");
1333
0
        $sth->execute($categorycode);
1334
0
        $enrolments = $sth->fetchrow_hashref;
1335    }
1336    # die "GetExpiryDate: for enrollmentperiod $enrolmentperiod (category '$categorycode') starting $dateenrolled.\n";
1337
0
    my @date = split (/-/,$dateenrolled);
1338
0
    if($enrolments->{enrolmentperiod}){
1339
0
        return sprintf("%04d-%02d-%02d", Add_Delta_YM(@date,0,$enrolments->{enrolmentperiod}));
1340    }else{
1341
0
        return $enrolments->{enrolmentperioddate};
1342    }
1343}
1344
1345 - 1351
=head2 checkuserpassword (OUEST-PROVENCE)

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

=cut
1352
1353sub checkuserpassword {
1354
0
    my ( $borrowernumber, $userid, $password ) = @_;
1355
0
    $password = md5_base64($password);
1356
0
    my $dbh = C4::Context->dbh;
1357
0
    my $sth =
1358      $dbh->prepare(
1359"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
1360      );
1361
0
    $sth->execute( $borrowernumber, $userid, $password );
1362
0
    my $number_rows = $sth->fetchrow;
1363
0
    return $number_rows;
1364
1365}
1366
1367 - 1376
=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
1377
1378#'
1379sub GetborCatFromCatType {
1380
0
    my ( $category_type, $action ) = @_;
1381        # FIXME - This API seems both limited and dangerous.
1382
0
    my $dbh = C4::Context->dbh;
1383
0
    my $request = qq| SELECT categorycode,description
1384            FROM categories
1385            $action
1386            ORDER BY categorycode|;
1387
0
    my $sth = $dbh->prepare($request);
1388
0
        if ($action) {
1389
0
        $sth->execute($category_type);
1390    }
1391    else {
1392
0
        $sth->execute();
1393    }
1394
1395
0
    my %labels;
1396
0
    my @codes;
1397
1398
0
    while ( my $data = $sth->fetchrow_hashref ) {
1399
0
        push @codes, $data->{'categorycode'};
1400
0
        $labels{ $data->{'categorycode'} } = $data->{'description'};
1401    }
1402
0
    return ( \@codes, \%labels );
1403}
1404
1405 - 1416
=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
1417
1418sub GetBorrowercategory {
1419
0
    my ($catcode) = @_;
1420
0
    my $dbh = C4::Context->dbh;
1421
0
    if ($catcode){
1422
0
        my $sth =
1423        $dbh->prepare(
1424    "SELECT description,dateofbirthrequired,upperagelimit,category_type
1425    FROM categories
1426    WHERE categorycode = ?"
1427        );
1428
0
        $sth->execute($catcode);
1429
0
        my $data =
1430        $sth->fetchrow_hashref;
1431
0
        return $data;
1432    }
1433
0
    return;
1434} # sub getborrowercategory
1435
1436 - 1441
=head2 GetBorrowercategoryList

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

=cut
1442
1443sub GetBorrowercategoryList {
1444
0
    my $dbh = C4::Context->dbh;
1445
0
    my $sth =
1446    $dbh->prepare(
1447    "SELECT *
1448    FROM categories
1449    ORDER BY description"
1450        );
1451
0
    $sth->execute;
1452
0
    my $data =
1453    $sth->fetchall_arrayref({});
1454
0
    return $data;
1455} # sub getborrowercategory
1456
1457 - 1466
=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
1467
1468#'
1469
1470sub ethnicitycategories {
1471
0
    my $dbh = C4::Context->dbh;
1472
0
    my $sth = $dbh->prepare("Select code,name from ethnicity order by name");
1473
0
    $sth->execute;
1474
0
    my %labels;
1475
0
    my @codes;
1476
0
    while ( my $data = $sth->fetchrow_hashref ) {
1477
0
        push @codes, $data->{'code'};
1478
0
        $labels{ $data->{'code'} } = $data->{'name'};
1479    }
1480
0
    return ( \@codes, \%labels );
1481}
1482
1483 - 1491
=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
1492
1493#'
1494
1495sub fixEthnicity {
1496
0
    my $ethnicity = shift;
1497
0
    return unless $ethnicity;
1498
0
    my $dbh = C4::Context->dbh;
1499
0
    my $sth = $dbh->prepare("Select name from ethnicity where code = ?");
1500
0
    $sth->execute($ethnicity);
1501
0
    my $data = $sth->fetchrow_hashref;
1502
0
    return $data->{'name'};
1503} # sub fixEthnicity
1504
1505 - 1511
=head2 GetAge

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

this function return the borrowers age with the value of dateofbirth

=cut
1512
1513#'
1514sub GetAge{
1515
0
    my ( $date, $date_ref ) = @_;
1516
1517
0
    if ( not defined $date_ref ) {
1518
0
        $date_ref = sprintf( '%04d-%02d-%02d', Today() );
1519    }
1520
1521
0
    my ( $year1, $month1, $day1 ) = split /-/, $date;
1522
0
    my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1523
1524
0
    my $age = $year2 - $year1;
1525
0
    if ( $month1 . $day1 > $month2 . $day2 ) {
1526
0
        $age--;
1527    }
1528
1529
0
    return $age;
1530} # sub get_age
1531
1532 - 1538
=head2 get_institutions

  $insitutions = get_institutions();

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

=cut
1539
1540#'
1541sub get_institutions {
1542
0
    my $dbh = C4::Context->dbh();
1543
0
    my $sth =
1544      $dbh->prepare(
1545"SELECT borrowernumber,surname FROM borrowers WHERE categorycode=? ORDER BY surname"
1546      );
1547
0
    $sth->execute('I');
1548
0
    my %orgs;
1549
0
    while ( my $data = $sth->fetchrow_hashref() ) {
1550
0
        $orgs{ $data->{'borrowernumber'} } = $data;
1551    }
1552
0
    return ( \%orgs );
1553
1554} # sub get_institutions
1555
1556 - 1562
=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
1563
1564#'
1565sub add_member_orgs {
1566
0
    my ( $borrowernumber, $otherborrowers ) = @_;
1567
0
    my $dbh = C4::Context->dbh();
1568
0
    my $query =
1569      "INSERT INTO borrowers_to_borrowers (borrower1,borrower2) VALUES (?,?)";
1570
0
    my $sth = $dbh->prepare($query);
1571
0
    foreach my $otherborrowernumber (@$otherborrowers) {
1572
0
        $sth->execute( $borrowernumber, $otherborrowernumber );
1573    }
1574
1575} # sub add_member_orgs
1576
1577 - 1585
=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
1586
1587sub GetCities {
1588
1589
0
    my $dbh = C4::Context->dbh;
1590
0
    my $city_arr = $dbh->selectall_arrayref(
1591        q|SELECT cityid,city_zipcode,city_name,city_state,city_country FROM cities ORDER BY city_name|,
1592        { Slice => {} });
1593
0
0
    if ( @{$city_arr} ) {
1594
0
0
        unshift @{$city_arr}, {
1595            city_zipcode => q{},
1596            city_name => q{},
1597            cityid => q{},
1598            city_state => q{},
1599            city_country => q{},
1600        };
1601    }
1602
1603
0
    return $city_arr;
1604}
1605
1606 - 1615
=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
1616
1617sub GetSortDetails {
1618
0
    my ( $category, $sortvalue ) = @_;
1619
0
    my $dbh = C4::Context->dbh;
1620
0
    my $query = qq|SELECT lib
1621        FROM authorised_values
1622        WHERE category=?
1623        AND authorised_value=? |;
1624
0
    my $sth = $dbh->prepare($query);
1625
0
    $sth->execute( $category, $sortvalue );
1626
0
    my $lib = $sth->fetchrow;
1627
0
    return ($lib) if ($lib);
1628
0
    return ($sortvalue) unless ($lib);
1629}
1630
1631 - 1637
=head2 MoveMemberToDeleted

  $result = &MoveMemberToDeleted($borrowernumber);

Copy the record from borrowers to deletedborrowers table.

=cut
1638
1639# FIXME: should do it in one SQL statement w/ subquery
1640# Otherwise, we should return the @data on success
1641
1642sub MoveMemberToDeleted {
1643
0
    my ($member) = shift or return;
1644
0
    my $dbh = C4::Context->dbh;
1645
0
    my $query = qq|SELECT *
1646          FROM borrowers
1647          WHERE borrowernumber=?|;
1648
0
    my $sth = $dbh->prepare($query);
1649
0
    $sth->execute($member);
1650
0
    my @data = $sth->fetchrow_array;
1651
0
    (@data) or return; # if we got a bad borrowernumber, there's nothing to insert
1652
0
    $sth =
1653      $dbh->prepare( "INSERT INTO deletedborrowers VALUES ("
1654          . ( "?," x ( scalar(@data) - 1 ) )
1655          . "?)" );
1656
0
    $sth->execute(@data);
1657}
1658
1659 - 1666
=head2 DelMember

    DelMember($borrowernumber);

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

=cut
1667
1668sub DelMember {
1669
0
    my $dbh = C4::Context->dbh;
1670
0
    my $borrowernumber = shift;
1671    #warn "in delmember with $borrowernumber";
1672
0
    return unless $borrowernumber; # borrowernumber is mandatory.
1673
1674
0
    my $query = qq|DELETE
1675          FROM reserves
1676          WHERE borrowernumber=?|;
1677
0
    my $sth = $dbh->prepare($query);
1678
0
    $sth->execute($borrowernumber);
1679
0
    $query = "
1680       DELETE
1681       FROM borrowers
1682       WHERE borrowernumber = ?
1683   ";
1684
0
    $sth = $dbh->prepare($query);
1685
0
    $sth->execute($borrowernumber);
1686
0
    logaction("MEMBERS", "DELETE", $borrowernumber, "") if C4::Context->preference("BorrowersLog");
1687
0
    return $sth->rows;
1688}
1689
1690 - 1697
=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
1698
1699sub ExtendMemberSubscriptionTo {
1700
0
    my ( $borrowerid,$date) = @_;
1701
0
    my $dbh = C4::Context->dbh;
1702
0
    my $borrower = GetMember('borrowernumber'=>$borrowerid);
1703
0
    unless ($date){
1704
0
      $date = (C4::Context->preference('BorrowerRenewalPeriodBase') eq 'dateexpiry') ?
1705                                        C4::Dates->new($borrower->{'dateexpiry'}, 'iso')->output("iso") :
1706                                        C4::Dates->new()->output("iso");
1707
0
      $date = GetExpiryDate( $borrower->{'categorycode'}, $date );
1708    }
1709
0
    my $sth = $dbh->do(<<EOF);
1710UPDATE borrowers
1711SET dateexpiry='$date'
1712WHERE borrowernumber='$borrowerid'
1713EOF
1714    # add enrolmentfee if needed
1715
0
    $sth = $dbh->prepare("SELECT enrolmentfee FROM categories WHERE categorycode=?");
1716
0
    $sth->execute($borrower->{'categorycode'});
1717
0
    my ($enrolmentfee) = $sth->fetchrow;
1718
0
    if ($enrolmentfee && $enrolmentfee > 0) {
1719        # insert fee in patron debts
1720
0
        manualinvoice($borrower->{'borrowernumber'}, '', '', 'A', $enrolmentfee);
1721    }
1722
0
     logaction("MEMBERS", "RENEW", $borrower->{'borrowernumber'}, "Membership renewed")if C4::Context->preference("BorrowersLog");
1723
0
    return $date if ($sth);
1724
0
    return 0;
1725}
1726
1727 - 1735
=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
1736
1737sub GetRoadTypes {
1738
0
    my $dbh = C4::Context->dbh;
1739
0
    my $query = qq|
1740SELECT roadtypeid,road_type
1741FROM roadtype
1742ORDER BY road_type|;
1743
0
    my $sth = $dbh->prepare($query);
1744
0
    $sth->execute();
1745
0
    my %roadtype;
1746
0
    my @id;
1747
1748    # insert empty value to create a empty choice in cgi popup
1749
1750
0
    while ( my $data = $sth->fetchrow_hashref ) {
1751
1752
0
        push @id, $data->{'roadtypeid'};
1753
0
        $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
1754    }
1755
1756#test to know if the table contain some records if no the function return nothing
1757
0
    my $id = @id;
1758
0
    if ( $id eq 0 ) {
1759
0
        return ();
1760    }
1761    else {
1762
0
        unshift( @id, "" );
1763
0
        return ( \@id, \%roadtype );
1764    }
1765}
1766
1767
1768
1769 - 1775
=head2 GetTitles (OUEST-PROVENCE)

  ($borrowertitle)= &GetTitles();

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

=cut
1776
1777sub GetTitles {
1778
0
    my @borrowerTitle = split (/,|\|/,C4::Context->preference('BorrowersTitles'));
1779
0
    unshift( @borrowerTitle, "" );
1780
0
    my $count=@borrowerTitle;
1781
0
    if ($count == 1){
1782
0
        return ();
1783    }
1784    else {
1785
0
        return ( \@borrowerTitle);
1786    }
1787}
1788
1789 - 1795
=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
1796
1797sub GetPatronImage {
1798
0
    my ($cardnumber) = @_;
1799
0
    warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1800
0
    my $dbh = C4::Context->dbh;
1801
0
    my $query = 'SELECT mimetype, imagefile FROM patronimage WHERE cardnumber = ?';
1802
0
    my $sth = $dbh->prepare($query);
1803
0
    $sth->execute($cardnumber);
1804
0
    my $imagedata = $sth->fetchrow_hashref;
1805
0
    warn "Database error!" if $sth->errstr;
1806
0
    return $imagedata, $sth->errstr;
1807}
1808
1809 - 1816
=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
1817
1818sub PutPatronImage {
1819
0
    my ($cardnumber, $mimetype, $imgfile) = @_;
1820
0
    warn "Parameters passed in: Cardnumber=$cardnumber, Mimetype=$mimetype, " . ($imgfile ? "Imagefile" : "No Imagefile") if $debug;
1821
0
    my $dbh = C4::Context->dbh;
1822
0
    my $query = "INSERT INTO patronimage (cardnumber, mimetype, imagefile) VALUES (?,?,?) ON DUPLICATE KEY UPDATE imagefile = ?;";
1823
0
    my $sth = $dbh->prepare($query);
1824
0
    $sth->execute($cardnumber,$mimetype,$imgfile,$imgfile);
1825
0
    warn "Error returned inserting $cardnumber.$mimetype." if $sth->errstr;
1826
0
    return $sth->errstr;
1827}
1828
1829 - 1835
=head2 RmPatronImage

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

Removes the image for the patron with the supplied cardnumber.

=cut
1836
1837sub RmPatronImage {
1838
0
    my ($cardnumber) = @_;
1839
0
    warn "Cardnumber passed to GetPatronImage is $cardnumber" if $debug;
1840
0
    my $dbh = C4::Context->dbh;
1841
0
    my $query = "DELETE FROM patronimage WHERE cardnumber = ?;";
1842
0
    my $sth = $dbh->prepare($query);
1843
0
    $sth->execute($cardnumber);
1844
0
    my $dberror = $sth->errstr;
1845
0
    warn "Database error!" if $sth->errstr;
1846
0
    return $dberror;
1847}
1848
1849 - 1856
=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
1857
1858sub GetHideLostItemsPreference {
1859
0
    my ($borrowernumber) = @_;
1860
0
    my $dbh = C4::Context->dbh;
1861
0
    my $query = "SELECT hidelostitems FROM borrowers,categories WHERE borrowers.categorycode = categories.categorycode AND borrowernumber = ?";
1862
0
    my $sth = $dbh->prepare($query);
1863
0
    $sth->execute($borrowernumber);
1864
0
    my $hidelostitems = $sth->fetchrow;
1865
0
    return $hidelostitems;
1866}
1867
1868 - 1876
=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
1877
1878sub GetRoadTypeDetails {
1879
0
    my ($roadtypeid) = @_;
1880
0
    my $dbh = C4::Context->dbh;
1881
0
    my $query = qq|
1882SELECT road_type
1883FROM roadtype
1884WHERE roadtypeid=?|;
1885
0
    my $sth = $dbh->prepare($query);
1886
0
    $sth->execute($roadtypeid);
1887
0
    my $roadtype = $sth->fetchrow;
1888
0
    return ($roadtype);
1889}
1890
1891 - 1897
=head2 GetBorrowersWhoHaveNotBorrowedSince

  &GetBorrowersWhoHaveNotBorrowedSince($date)

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

=cut
1898
1899sub GetBorrowersWhoHaveNotBorrowedSince {
1900
0
    my $filterdate = shift||POSIX::strftime("%Y-%m-%d",localtime());
1901
0
    my $filterexpiry = shift;
1902
0
    my $filterbranch = shift ||
1903                        ((C4::Context->preference('IndependantBranches')
1904                             && C4::Context->userenv
1905                             && C4::Context->userenv->{flags} % 2 !=1
1906                             && C4::Context->userenv->{branch})
1907                         ? C4::Context->userenv->{branch}
1908                         : "");
1909
0
    my $dbh = C4::Context->dbh;
1910
0
    my $query = "
1911        SELECT borrowers.borrowernumber,
1912               max(old_issues.timestamp) as latestissue,
1913               max(issues.timestamp) as currentissue
1914        FROM borrowers
1915        JOIN categories USING (categorycode)
1916        LEFT JOIN old_issues USING (borrowernumber)
1917        LEFT JOIN issues USING (borrowernumber)
1918        WHERE category_type <> 'S'
1919        AND borrowernumber NOT IN (SELECT guarantorid FROM borrowers WHERE guarantorid IS NOT NULL AND guarantorid <> 0)
1920   ";
1921
0
    my @query_params;
1922
0
    if ($filterbranch && $filterbranch ne ""){
1923
0
        $query.=" AND borrowers.branchcode= ?";
1924
0
        push @query_params,$filterbranch;
1925    }
1926
0
    if($filterexpiry){
1927
0
        $query .= " AND dateexpiry < ? ";
1928
0
        push @query_params,$filterdate;
1929    }
1930
0
    $query.=" GROUP BY borrowers.borrowernumber";
1931
0
    if ($filterdate){
1932
0
        $query.=" HAVING (latestissue < ? OR latestissue IS NULL)
1933                  AND currentissue IS NULL";
1934
0
        push @query_params,$filterdate;
1935    }
1936
0
    warn $query if $debug;
1937
0
    my $sth = $dbh->prepare($query);
1938
0
    if (scalar(@query_params)>0){
1939
0
        $sth->execute(@query_params);
1940    }
1941    else {
1942
0
        $sth->execute;
1943    }
1944
1945
0
    my @results;
1946
0
    while ( my $data = $sth->fetchrow_hashref ) {
1947
0
        push @results, $data;
1948    }
1949
0
    return \@results;
1950}
1951
1952 - 1960
=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
1961
1962sub GetBorrowersWhoHaveNeverBorrowed {
1963
0
    my $filterbranch = shift ||
1964                        ((C4::Context->preference('IndependantBranches')
1965                             && C4::Context->userenv
1966                             && C4::Context->userenv->{flags} % 2 !=1
1967                             && C4::Context->userenv->{branch})
1968                         ? C4::Context->userenv->{branch}
1969                         : "");
1970
0
    my $dbh = C4::Context->dbh;
1971
0
    my $query = "
1972        SELECT borrowers.borrowernumber,max(timestamp) as latestissue
1973        FROM borrowers
1974          LEFT JOIN issues ON borrowers.borrowernumber = issues.borrowernumber
1975        WHERE issues.borrowernumber IS NULL
1976   ";
1977
0
    my @query_params;
1978
0
    if ($filterbranch && $filterbranch ne ""){
1979
0
        $query.=" AND borrowers.branchcode= ?";
1980
0
        push @query_params,$filterbranch;
1981    }
1982
0
    warn $query if $debug;
1983
1984
0
    my $sth = $dbh->prepare($query);
1985
0
    if (scalar(@query_params)>0){
1986
0
        $sth->execute(@query_params);
1987    }
1988    else {
1989
0
        $sth->execute;
1990    }
1991
1992
0
    my @results;
1993
0
    while ( my $data = $sth->fetchrow_hashref ) {
1994
0
        push @results, $data;
1995    }
1996
0
    return \@results;
1997}
1998
1999 - 2008
=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
2009
2010sub GetBorrowersWithIssuesHistoryOlderThan {
2011
0
    my $dbh = C4::Context->dbh;
2012
0
    my $date = shift ||POSIX::strftime("%Y-%m-%d",localtime());
2013
0
    my $filterbranch = shift ||
2014                        ((C4::Context->preference('IndependantBranches')
2015                             && C4::Context->userenv
2016                             && C4::Context->userenv->{flags} % 2 !=1
2017                             && C4::Context->userenv->{branch})
2018                         ? C4::Context->userenv->{branch}
2019                         : "");
2020
0
    my $query = "
2021       SELECT count(borrowernumber) as n,borrowernumber
2022       FROM old_issues
2023       WHERE returndate < ?
2024         AND borrowernumber IS NOT NULL
2025    ";
2026
0
    my @query_params;
2027
0
    push @query_params, $date;
2028
0
    if ($filterbranch){
2029
0
        $query.=" AND branchcode = ?";
2030
0
        push @query_params, $filterbranch;
2031    }
2032
0
    $query.=" GROUP BY borrowernumber ";
2033
0
    warn $query if $debug;
2034
0
    my $sth = $dbh->prepare($query);
2035
0
    $sth->execute(@query_params);
2036
0
    my @results;
2037
2038
0
    while ( my $data = $sth->fetchrow_hashref ) {
2039
0
        push @results, $data;
2040    }
2041
0
    return \@results;
2042}
2043
2044 - 2053
=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
2054
2055sub GetBorrowersNamesAndLatestIssue {
2056
0
    my $dbh = C4::Context->dbh;
2057
0
    my @borrowernumbers=@_;
2058
0
    my $query = "
2059       SELECT surname,lastname, phone, email,max(timestamp)
2060       FROM borrowers
2061         LEFT JOIN issues ON borrowers.borrowernumber=issues.borrowernumber
2062       GROUP BY borrowernumber
2063   ";
2064
0
    my $sth = $dbh->prepare($query);
2065
0
    $sth->execute;
2066
0
    my $results = $sth->fetchall_arrayref({});
2067
0
    return $results;
2068}
2069
2070 - 2080
=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
2081
2082sub DebarMember {
2083
0
    my $borrowernumber = shift;
2084
0
    my $todate = shift;
2085
2086
0
    return unless defined $borrowernumber;
2087
0
    return unless $borrowernumber =~ /^\d+$/;
2088
2089
0
    return ModMember(
2090        borrowernumber => $borrowernumber,
2091        debarred => $todate
2092    );
2093
2094}
2095
2096 - 2109
=head2 ModPrivacy

=over 4

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

Update the privacy of a patron.

return :
true on success, false on failure

=back

=cut
2110
2111sub ModPrivacy {
2112
0
    my $borrowernumber = shift;
2113
0
    my $privacy = shift;
2114
0
    return unless defined $borrowernumber;
2115
0
    return unless $borrowernumber =~ /^\d+$/;
2116
2117
0
    return ModMember( borrowernumber => $borrowernumber,
2118                      privacy => $privacy );
2119}
2120
2121 - 2131
=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
2132
2133sub AddMessage {
2134
0
    my ( $borrowernumber, $message_type, $message, $branchcode ) = @_;
2135
2136
0
    my $dbh = C4::Context->dbh;
2137
2138
0
    if ( ! ( $borrowernumber && $message_type && $message && $branchcode ) ) {
2139
0
      return;
2140    }
2141
2142
0
    my $query = "INSERT INTO messages ( borrowernumber, branchcode, message_type, message ) VALUES ( ?, ?, ?, ? )";
2143
0
    my $sth = $dbh->prepare($query);
2144
0
    $sth->execute( $borrowernumber, $branchcode, $message_type, $message );
2145
0
    logaction("MEMBERS", "ADDCIRCMESSAGE", $borrowernumber, $message) if C4::Context->preference("BorrowersLog");
2146
0
    return 1;
2147}
2148
2149 - 2158
=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
2159
2160sub GetMessages {
2161
0
    my ( $borrowernumber, $type, $branchcode ) = @_;
2162
2163
0
    if ( ! $type ) {
2164
0
      $type = '%';
2165    }
2166
2167
0
    my $dbh = C4::Context->dbh;
2168
2169
0
    my $query = "SELECT
2170                  branches.branchname,
2171                  messages.*,
2172                  message_date,
2173                  messages.branchcode LIKE '$branchcode' AS can_delete
2174                  FROM messages, branches
2175                  WHERE borrowernumber = ?
2176                  AND message_type LIKE ?
2177                  AND messages.branchcode = branches.branchcode
2178                  ORDER BY message_date DESC";
2179
0
    my $sth = $dbh->prepare($query);
2180
0
    $sth->execute( $borrowernumber, $type ) ;
2181
0
    my @results;
2182
2183
0
    while ( my $data = $sth->fetchrow_hashref ) {
2184
0
        my $d = C4::Dates->new( $data->{message_date}, 'iso' );
2185
0
        $data->{message_date_formatted} = $d->output;
2186
0
        push @results, $data;
2187    }
2188
0
    return \@results;
2189
2190}
2191
2192 - 2201
=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
2202
2203sub GetMessagesCount {
2204
0
    my ( $borrowernumber, $type, $branchcode ) = @_;
2205
2206
0
    if ( ! $type ) {
2207
0
      $type = '%';
2208    }
2209
2210
0
    my $dbh = C4::Context->dbh;
2211
2212
0
    my $query = "SELECT COUNT(*) as MsgCount FROM messages WHERE borrowernumber = ? AND message_type LIKE ?";
2213
0
    my $sth = $dbh->prepare($query);
2214
0
    $sth->execute( $borrowernumber, $type ) ;
2215
0
    my @results;
2216
2217
0
    my $data = $sth->fetchrow_hashref;
2218
0
    my $count = $data->{'MsgCount'};
2219
2220
0
    return $count;
2221}
2222
2223
2224
2225 - 2229
=head2 DeleteMessage

  DeleteMessage( $message_id );

=cut
2230
2231sub DeleteMessage {
2232
0
    my ( $message_id ) = @_;
2233
2234
0
    my $dbh = C4::Context->dbh;
2235
0
    my $query = "SELECT * FROM messages WHERE message_id = ?";
2236
0
    my $sth = $dbh->prepare($query);
2237
0
    $sth->execute( $message_id );
2238
0
    my $message = $sth->fetchrow_hashref();
2239
2240
0
    $query = "DELETE FROM messages WHERE message_id = ?";
2241
0
    $sth = $dbh->prepare($query);
2242
0
    $sth->execute( $message_id );
2243
0
    logaction("MEMBERS", "DELCIRCMESSAGE", $message->{'borrowernumber'}, $message->{'message'}) if C4::Context->preference("BorrowersLog");
2244}
2245
2246 - 2254
=head2 IssueSlip

  IssueSlip($branchcode, $borrowernumber, $quickslip)

  Returns letter hash ( see C4::Letters::GetPreparedLetter )

  $quickslip is boolean, to indicate whether we want a quick slip

=cut
2255
2256sub IssueSlip {
2257
0
    my ($branch, $borrowernumber, $quickslip) = @_;
2258
2259# return unless ( C4::Context->boolean_preference('printcirculationslips') );
2260
2261
0
    my $today = POSIX::strftime("%Y-%m-%d", localtime);
2262
2263
0
    my $issueslist = GetPendingIssues($borrowernumber);
2264
0
    foreach my $it (@$issueslist){
2265
0
        if ($it->{'issuedate'} eq $today) {
2266
0
            $it->{'today'} = 1;
2267        }
2268        elsif ($it->{'date_due'} le $today) {
2269
0
            $it->{'overdue'} = 1;
2270        }
2271
2272
0
        $it->{'date_due'}=format_date($it->{'date_due'});
2273    }
2274
0
0
    my @issues = sort { $b->{'timestamp'} <=> $a->{'timestamp'} } @$issueslist;
2275
2276
0
    my ($letter_code, %repeat);
2277
0
    if ( $quickslip ) {
2278
0
        $letter_code = 'ISSUEQSLIP';
2279
0
        %repeat = (
2280            'checkedout' => [ map {
2281                'biblio' => $_,
2282                'items' => $_,
2283                'issues' => $_,
2284
0
            }, grep { $_->{'today'} } @issues ],
2285        );
2286    }
2287    else {
2288
0
        $letter_code = 'ISSUESLIP';
2289
0
        %repeat = (
2290            'checkedout' => [ map {
2291                'biblio' => $_,
2292                'items' => $_,
2293                'issues' => $_,
2294
0
            }, grep { !$_->{'overdue'} } @issues ],
2295
2296            'overdue' => [ map {
2297                'biblio' => $_,
2298                'items' => $_,
2299                'issues' => $_,
2300
0
            }, grep { $_->{'overdue'} } @issues ],
2301
2302            'news' => [ map {
2303
0
                $_->{'timestamp'} = $_->{'newdate'};
2304
0
                { opac_news => $_ }
2305
0
            } @{ GetNewsToDisplay("slip") } ],
2306        );
2307    }
2308
2309
0
    return C4::Letters::GetPreparedLetter (
2310        module => 'circulation',
2311        letter_code => $letter_code,
2312        branchcode => $branch,
2313        tables => {
2314            'branches' => $branch,
2315            'borrowers' => $borrowernumber,
2316        },
2317        repeat => \%repeat,
2318    );
2319}
2320
2321 - 2330
=head2 GetBorrowersWithEmail

    ([$borrnum,$userid], ...) = GetBorrowersWithEmail('me@example.com');

This gets a list of users and their basic details from their email address.
As it's possible for multiple user to have the same email address, it provides
you with all of them. If there is no userid for the user, there will be an
C<undef> there. An empty list will be returned if there are no matches.

=cut
2331
2332sub GetBorrowersWithEmail {
2333
0
    my $email = shift;
2334
2335
0
    my $dbh = C4::Context->dbh;
2336
2337
0
    my $query = "SELECT borrowernumber, userid FROM borrowers WHERE email=?";
2338
0
    my $sth=$dbh->prepare($query);
2339
0
    $sth->execute($email);
2340
0
    my @result = ();
2341
0
    while (my $ref = $sth->fetch) {
2342
0
        push @result, $ref;
2343    }
2344
0
    die "Failure searching for borrowers by email address: $sth->errstr" if $sth->err;
2345
0
    return @result;
2346}
2347
2348
2349
14
3270309
END { } # module clean-up code here (global destructor)
2350
23511;
2352