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 |
} |