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

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

Return to bug 12598