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

(-)a/misc/import_borrowers.pl (-301 / +34 lines)
Lines 21-60 Link Here
21
21
22
use Modern::Perl;
22
use Modern::Perl;
23
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;
24
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
25
50
my ( $template, $loggedinuser, $cookie );
26
use Koha::Patrons::Import qw(import_patrons);
51
27
52
my $csv_file;
28
my $csv_file;
53
my $matchpoint;
29
my $matchpoint;
54
my $overwrite_cardnumber;
30
my $overwrite_cardnumber;
55
my %defaults;
31
my %defaults;
56
my $ext_preserve = 0;
32
my $ext_preserve = 0;
57
my $verbose;
33
my $verbose      = 0;
58
my $help;
34
my $help;
59
35
60
GetOptions(
36
GetOptions(
Lines 63-69 GetOptions( Link Here
63
    'd|default=s'                   => \%defaults,
39
    'd|default=s'                   => \%defaults,
64
    'o|overwrite'                   => \$overwrite_cardnumber,
40
    'o|overwrite'                   => \$overwrite_cardnumber,
65
    'p|preserve-extended-atributes' => \$ext_preserve,
41
    'p|preserve-extended-atributes' => \$ext_preserve,
66
    'v|verbose'                     => \$verbose,
42
    'v|verbose+'                    => \$verbose,
67
    'h|help|?'                      => \$help,
43
    'h|help|?'                      => \$help,
68
);
44
);
69
45
Lines 72-356 print_help() if ( $help || !$csv_file || !$matchpoint ); Link Here
72
my $handle;
48
my $handle;
73
open( $handle, "<", $csv_file ) or die $!;
49
open( $handle, "<", $csv_file ) or die $!;
74
50
75
my $imported    = 0;
51
my $return = Koha::Patrons::Import::import_patrons(
76
my $alreadyindb = 0;
52
    {
77
my $overwritten = 0;
53
        file                         => $handle,
78
my $invalid     = 0;
54
        defaults                     => \%defaults,
79
my $matchpoint_attr_type;
55
        matchpoint                   => $matchpoint,
80
56
        overwrite_cardnumber         => $overwrite_cardnumber,
81
# use header line to construct key to column map
57
        preserve_extended_attributes => $ext_preserve,
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
    }
58
    }
59
);
233
60
234
    if ( C4::Members::checkcardnumber( $borrower{cardnumber}, $borrowernumber ) ) {
61
my $feedback    = $return->{feedback};
235
        $borrowernumber ||= q{};
62
my $errors      = $return->{errors};
236
        print "ERROR: invalid cardnumber '$borrower{cardnumber}' for borrowernumber $borrowernumber\n";
63
my $imported    = $return->{imported};
237
        $invalid++;
64
my $overwritten = $return->{overwritten};
238
        next;
65
my $alreadyindb = $return->{already_in_db};
239
    }
66
my $invalid     = $return->{invalid};
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
67
334
            $imported++;
68
if ($verbose) {
69
    my $total = $imported + $alreadyindb + $invalid + $overwritten;
70
    say q{};
71
    say "Import complete:";
72
    say "Imported:    $imported";
73
    say "Overwritten: $overwritten";
74
    say "Skipped:     $alreadyindb";
75
    say "Invalid:     $invalid";
76
    say "Total:       $total";
77
    say q{};
78
}
335
79
336
            print "Imported new patron $borrower{'surname'} / $borrowernumber\n"
80
if ($verbose > 1 ) {
337
              if $verbose;
81
    say "Errors:";
338
        }
82
    say Data::Dumper::Dumper( $errors );
339
        else {
340
            $invalid++;
341
            print "Failure to import $borrower{'surname'}\n" if $verbose;
342
        }
343
    }
344
}
83
}
345
84
346
if ($verbose) {
85
if ($verbose > 2 ) {
347
    my $total = $imported + $alreadyindb + $invalid + $overwritten;
86
    say "Feedback:";
348
    print "\nImport complete:\n";
87
    say Data::Dumper::Dumper( $feedback );
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
}
88
}
355
89
356
sub print_help {
90
sub print_help {
357
- 

Return to bug 12598