View | Details | Raw Unified | Return to bug 12598
Collapse All | Expand All

(-)a/misc/import_borrowers.pl (-1 / +367 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2007 Liblime
4
# Parts copyright 2010 BibLibre
5
# Parts copyright 2014 ByWater Solutions
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it
10
# under the terms of the GNU General Public License as published by
11
# the Free Software Foundation; either version 3 of the License, or
12
# (at your option) any later version.
13
#
14
# Koha is distributed in the hope that it will be useful, but
15
# WITHOUT ANY WARRANTY; without even the implied warranty of
16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
# GNU General Public License for more details.
18
#
19
# You should have received a copy of the GNU General Public License
20
# along with Koha; if not, see <http://www.gnu.org/licenses>.
21
22
use Modern::Perl;
23
24
use C4::Dates qw(format_date_in_iso);
25
use C4::Context;
26
use C4::Branch qw(GetBranchName);
27
use C4::Members;
28
use C4::Members::Attributes qw(:all);
29
use C4::Members::AttributeTypes;
30
use C4::Members::Messaging;
31
use Koha::Borrower::Debarments;
32
33
use Getopt::Long;
34
use Text::CSV;
35
36
my $extended = C4::Context->preference('ExtendedPatronAttributes');
37
my $set_messaging_prefs =
38
  C4::Context->preference('EnhancedMessagingPreferences');
39
my @columnkeys = C4::Members::columns();
40
if ($extended) {
41
    push @columnkeys, 'patron_attributes';
42
}
43
my $columnkeystpl =
44
  [ map { { 'key' => $_ } } grep { $_ ne 'borrowernumber' } @columnkeys ]
45
  ;    # ref. to array of hashrefs.
46
47
our $csv =
48
  Text::CSV->new( { binary => 1 } );    # binary needed for non-ASCII Unicode
49
50
my ( $template, $loggedinuser, $cookie );
51
52
my $csv_file;
53
my $matchpoint;
54
my $overwrite_cardnumber;
55
my %defaults;
56
my $ext_preserve = 0;
57
my $verbose;
58
my $help;
59
60
GetOptions(
61
    'c|csv=s'                       => \$csv_file,
62
    'm|matchpoint=s'                => \$matchpoint,
63
    'd|default=s'                   => \%defaults,
64
    'o|overwrite'                   => \$overwrite_cardnumber,
65
    'p|preserve-extended-atributes' => \$ext_preserve,
66
    'v|verbose'                     => \$verbose,
67
    'h|help|?'                      => \$help,
68
);
69
70
print_help() if ( $help || !$csv_file || !$matchpoint );
71
72
my $handle;
73
open( $handle, "<", $csv_file ) or die $!;
74
75
my $imported    = 0;
76
my $alreadyindb = 0;
77
my $overwritten = 0;
78
my $invalid     = 0;
79
my $matchpoint_attr_type;
80
81
# use header line to construct key to column map
82
my $borrowerline = <$handle>;
83
my $status       = $csv->parse($borrowerline);
84
print "WARNING: CSV header line is incomplete: $borrowerline\n" unless $status;
85
my @csvcolumns = $csv->fields();
86
my %csvkeycol;
87
my $col = 0;
88
89
foreach my $keycol (@csvcolumns) {
90
91
    # columnkeys don't contain whitespace, but some stupid tools add it
92
    $keycol =~ s/ +//g;
93
    $csvkeycol{$keycol} = $col++;
94
}
95
if ($extended) {
96
    $matchpoint_attr_type = C4::Members::AttributeTypes->fetch($matchpoint);
97
}
98
99
my $today_iso = C4::Dates->new()->output('iso');
100
my @criticals =
101
  qw(surname branchcode categorycode);    # there probably should be others
102
my @bad_dates;                            # I've had a few.
103
my $date_re = C4::Dates->new->regexp('syspref');
104
my $iso_re  = C4::Dates->new->regexp('iso');
105
LINE: while ( my $borrowerline = <$handle> ) {
106
    my %borrower;
107
    my @missing_criticals;
108
    my $patron_attributes;
109
    my $status  = $csv->parse($borrowerline);
110
    my @columns = $csv->fields();
111
    if ( !$status ) {
112
        push @missing_criticals,
113
          { badparse => 1, line => $., lineraw => $borrowerline };
114
        print "ERROR: Unable to parse line $.: $borrowerline";
115
    }
116
    elsif ( @columns == @columnkeys ) {
117
        @borrower{@columnkeys} = @columns;
118
119
        # MJR: try to fill blanks gracefully by using default values
120
        foreach my $key (@columnkeys) {
121
            if ( $borrower{$key} !~ /\S/ ) {
122
                $borrower{$key} = $defaults{$key};
123
            }
124
        }
125
    }
126
    else {
127
        # MJR: try to recover gracefully by using default values
128
        foreach my $key (@columnkeys) {
129
            if ( defined( $csvkeycol{$key} )
130
                and $columns[ $csvkeycol{$key} ] =~ /\S/ )
131
            {
132
                $borrower{$key} = $columns[ $csvkeycol{$key} ];
133
            }
134
            elsif ( $defaults{$key} ) {
135
                $borrower{$key} = $defaults{$key};
136
            }
137
            elsif ( scalar grep { $key eq $_ } @criticals ) {
138
139
                # a critical field is undefined
140
                print
141
"ERROR: missing critical column data '$key' for line $.: $borrowerline\n";
142
            }
143
            else {
144
                $borrower{$key} = '';
145
            }
146
        }
147
    }
148
149
    #warn join(':',%borrower);
150
    if ( $borrower{categorycode} ) {
151
        print "ERROR: invalid categorycode for line $.: $borrowerline\n"
152
          unless ( GetBorrowercategory( $borrower{categorycode} ) );
153
    }
154
    else {
155
        print "ERROR: missing categorycode for line $.: $borrowerline\n";
156
    }
157
158
    if ( $borrower{branchcode} ) {
159
        print "ERROR: invalid branchcode for line $.: $borrowerline\n"
160
          unless ( GetBranchName( $borrower{branchcode} ) );
161
    }
162
    else {
163
        print "ERROR: missing branchcode for line $.: $borrowerline\n";
164
    }
165
166
    if ($extended) {
167
        my $attr_str = $borrower{patron_attributes};
168
169
        # fixup double quotes in case we are passed smart quotes
170
        $attr_str =~ s/\xe2\x80\x9c/"/g;
171
        $attr_str =~ s/\xe2\x80\x9d/"/g;
172
173
        # not really a field in borrowers, so we don't want to pass it to ModMember.
174
        delete $borrower{patron_attributes};
175
        $patron_attributes = extended_attributes_code_value_arrayref($attr_str);
176
    }
177
178
    # Popular spreadsheet applications make it difficult to force date outputs to be zero-padded, but we require it.
179
    foreach (qw(dateofbirth dateenrolled dateexpiry)) {
180
        my $tempdate = $borrower{$_} or next;
181
182
        if ( $tempdate =~ /$date_re/ ) {
183
            $borrower{$_} = format_date_in_iso($tempdate);
184
        }
185
        elsif ( $tempdate =~ /$iso_re/ ) {
186
            $borrower{$_} = $tempdate;
187
        }
188
        else {
189
            $borrower{$_} = '';
190
            push @missing_criticals,
191
              {
192
                key      => $_,
193
                line     => $.,
194
                lineraw  => $borrowerline,
195
                bad_date => 1
196
              };
197
        }
198
    }
199
200
    $borrower{dateenrolled} = $today_iso unless $borrower{dateenrolled};
201
202
    $borrower{dateexpiry} =
203
      GetExpiryDate( $borrower{categorycode}, $borrower{dateenrolled} )
204
      unless $borrower{dateexpiry};
205
206
    my $borrowernumber;
207
    my $member;
208
    if ( ( $matchpoint eq 'cardnumber' ) && ( $borrower{'cardnumber'} ) ) {
209
        $member = GetMember( 'cardnumber' => $borrower{'cardnumber'} );
210
        if ($member) {
211
            $borrowernumber = $member->{'borrowernumber'};
212
        }
213
    }
214
    elsif ( ( $matchpoint eq 'userid' ) && ( $borrower{'userid'} ) ) {
215
        $member = GetMember( 'userid' => $borrower{'userid'} );
216
        if ($member) {
217
            $borrowernumber = $member->{'borrowernumber'};
218
        }
219
    }
220
    elsif ($extended) {
221
        if ( defined($matchpoint_attr_type) ) {
222
            foreach my $attr (@$patron_attributes) {
223
                if ( $attr->{code} eq $matchpoint and $attr->{value} ne '' ) {
224
                    my @borrowernumbers =
225
                      $matchpoint_attr_type->get_patrons( $attr->{value} );
226
                    $borrowernumber = $borrowernumbers[0]
227
                      if scalar(@borrowernumbers) == 1;
228
                    last;
229
                }
230
            }
231
        }
232
    }
233
234
    if ( C4::Members::checkcardnumber( $borrower{cardnumber}, $borrowernumber ) ) {
235
        $borrowernumber ||= q{};
236
        print "ERROR: invalid cardnumber '$borrower{cardnumber}' for borrowernumber $borrowernumber\n";
237
        $invalid++;
238
        next;
239
    }
240
241
    if ($borrowernumber) {
242
243
        # borrower exists
244
        unless ($overwrite_cardnumber) {
245
            $alreadyindb++;
246
            print "$borrower{'surname'} / $borrowernumber alredy in database.\n" if $verbose;
247
            next LINE;
248
        }
249
250
        $borrower{'borrowernumber'} = $borrowernumber;
251
252
        # use values from extant patron unless our csv file includes this column or we provided a default.
253
        for my $col ( keys %borrower ) {
254
            # The password is always encrypted, skip it!
255
            next if $col eq 'password';
256
257
            unless ( exists( $csvkeycol{$col} ) || $defaults{$col} ) {
258
                $borrower{$col} = $member->{$col} if ( $member->{$col} );
259
            }
260
        }
261
262
        unless ( ModMember(%borrower) ) {
263
            $invalid++;
264
265
            # untill we have better error trapping, we have no way of knowing why ModMember errored out...
266
            print "Failure to update $borrower{'surname'} / $borrowernumber\n"
267
              if $verbose;
268
            next LINE;
269
        }
270
271
        if ( $borrower{debarred} ) {
272
273
            # Check to see if this debarment already exists
274
            my $debarrments = GetDebarments(
275
                {
276
                    borrowernumber => $borrowernumber,
277
                    expiration     => $borrower{debarred},
278
                    comment        => $borrower{debarredcomment}
279
                }
280
            );
281
282
            # If it doesn't, then add it!
283
            unless (@$debarrments) {
284
                AddDebarment(
285
                    {
286
                        borrowernumber => $borrowernumber,
287
                        expiration     => $borrower{debarred},
288
                        comment        => $borrower{debarredcomment}
289
                    }
290
                );
291
            }
292
        }
293
294
        if ($extended) {
295
            if ($ext_preserve) {
296
                my $old_attributes = GetBorrowerAttributes($borrowernumber);
297
                $patron_attributes = extended_attributes_merge( $old_attributes, $patron_attributes );
298
            }
299
        }
300
301
        print "Overwriting $borrower{'surname'} / $borrowernumber with new data\n";
302
        $overwritten++;
303
    }
304
    else {
305
        if ( !$borrower{'cardnumber'} ) {
306
            $borrower{'cardnumber'} = fixup_cardnumber(undef);
307
        }
308
309
        if ( $borrowernumber = AddMember(%borrower) ) {
310
311
            if ( $borrower{debarred} ) {
312
                AddDebarment(
313
                    {
314
                        borrowernumber => $borrowernumber,
315
                        expiration     => $borrower{debarred},
316
                        comment        => $borrower{debarredcomment}
317
                    }
318
                );
319
            }
320
321
            if ($extended) {
322
                SetBorrowerAttributes( $borrowernumber, $patron_attributes );
323
            }
324
325
            if ($set_messaging_prefs) {
326
                C4::Members::Messaging::SetMessagingPreferencesFromDefaults(
327
                    {
328
                        borrowernumber => $borrowernumber,
329
                        categorycode   => $borrower{categorycode}
330
                    }
331
                );
332
            }
333
334
            $imported++;
335
336
            print "Imported new patron $borrower{'surname'} / $borrowernumber\n"
337
              if $verbose;
338
        }
339
        else {
340
            $invalid++;
341
            print "Failure to import $borrower{'surname'}\n" if $verbose;
342
        }
343
    }
344
}
345
346
if ($verbose) {
347
    my $total = $imported + $alreadyindb + $invalid + $overwritten;
348
    print "\nImport complete:\n";
349
    print "Imported:    $imported\n";
350
    print "Overwritten: $overwritten\n";
351
    print "Skipped:     $alreadyindb\n";
352
    print "Invalid:     $invalid\n";
353
    print "Total:       $total\n\n";
354
}
355
356
sub print_help {
357
    print <<_USAGE_;
358
import_borrowers.pl -c /path/to/borrowers.csv -m cardnumber
359
    -c --csv                            Path to the CSV file of patrons  to import
360
    -m --matchpoint                     Field on which to match incoming patrons to existing patrons
361
    -d --default                        Set defaults to patron fields, repeatable e.g. --default branchcode=MPL --default categorycode=PT
362
    -p --preserve-extended-atributes    Retain extended patron attributes for existing patrons being overwritten
363
    -o --overwrite                      Overwrite existing patrons with new data if a match is found
364
    -v --verbose                        Be verbose
365
_USAGE_
366
    exit;
367
}

Return to bug 12598