3 # Copyright 2007 Liblime
4 # Parts copyright 2010 BibLibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 # Script to take some borrowers data in a known format and load it into Koha
25 # cardnumber,surname,firstname,title,othernames,initials,streetnumber,streettype,
26 # address line , address line 2, city, zipcode, contry, email, phone, mobile, fax, work email, work phone,
27 # alternate streetnumber, alternate streettype, alternate address line 1, alternate city,
28 # alternate zipcode, alternate country, alternate email, alternate phone, date of birth, branchcode,
29 # categorycode, enrollment date, expiry date, noaddress, lost, debarred, contact surname,
30 # contact firstname, contact title, borrower notes, contact relationship, ethnicity, ethnicity notes
31 # gender, username, opac note, contact note, password, sort one, sort two
33 # any fields except cardnumber can be blank but the number of fields must match
34 # dates should be in the format you have set up Koha to expect
35 # branchcode and categorycode need to be valid
42 use C4
::Dates
qw(format_date_in_iso);
44 use C4
::Branch
qw(GetBranchName);
46 use C4
::Members
::Attributes
qw(:all);
47 use C4
::Members
::AttributeTypes
;
48 use C4
::Members
::Messaging
;
49 use Koha
::Borrower
::Debarments
;
52 # Text::CSV::Unicode, even in binary mode, fails to parse lines with these diacriticals:
57 # use encoding 'utf8'; # don't do this
59 my (@errors, @feedback);
60 my $extended = C4
::Context
->preference('ExtendedPatronAttributes');
61 my $set_messaging_prefs = C4
::Context
->preference('EnhancedMessagingPreferences');
62 my @columnkeys = C4
::Members
::columns
();
64 push @columnkeys, 'patron_attributes';
66 my $columnkeystpl = [ map { {'key' => $_} } grep {$_ ne 'borrowernumber' } @columnkeys ]; # ref. to array of hashrefs.
68 my $input = CGI
->new();
69 our $csv = Text
::CSV
->new({binary
=> 1}); # binary needed for non-ASCII Unicode
70 #push @feedback, {feedback=>1, name=>'backend', value=>$csv->backend, backend=>$csv->backend}; #XXX
72 my ( $template, $loggedinuser, $cookie ) = get_template_and_user
({
73 template_name
=> "tools/import_borrowers.tmpl",
77 flagsrequired
=> { tools
=> 'import_patrons' },
81 $template->param(columnkeys
=> $columnkeystpl);
83 if ($input->param('sample')) {
85 -type
=> 'application/vnd.sun.xml.calc', # 'application/vnd.ms-excel' ?
86 -attachment
=> 'patron_import.csv',
88 $csv->combine(@columnkeys);
89 print $csv->string, "\n";
92 my $uploadborrowers = $input->param('uploadborrowers');
93 my $matchpoint = $input->param('matchpoint');
95 $matchpoint =~ s/^patron_attribute_//;
97 my $overwrite_cardnumber = $input->param('overwrite_cardnumber');
99 $template->param( SCRIPT_NAME
=> $ENV{'SCRIPT_NAME'} );
101 ($extended) and $template->param(ExtendedPatronAttributes
=> 1);
103 if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
104 push @feedback, {feedback
=>1, name
=>'filename', value
=>$uploadborrowers, filename
=>$uploadborrowers};
105 my $handle = $input->upload('uploadborrowers');
106 my $uploadinfo = $input->uploadInfo($uploadborrowers);
107 foreach (keys %$uploadinfo) {
108 push @feedback, {feedback
=>1, name
=>$_, value
=>$uploadinfo->{$_}, $_=>$uploadinfo->{$_}};
114 my $matchpoint_attr_type;
115 my %defaults = $input->Vars;
117 # use header line to construct key to column map
118 my $borrowerline = <$handle>;
119 my $status = $csv->parse($borrowerline);
120 ($status) or push @errors, {badheader
=>1,line
=>$., lineraw
=>$borrowerline};
121 my @csvcolumns = $csv->fields();
124 foreach my $keycol (@csvcolumns) {
125 # columnkeys don't contain whitespace, but some stupid tools add it
127 $csvkeycol{$keycol} = $col++;
129 #warn($borrowerline);
130 my $ext_preserve = $input->param('ext_preserve') || 0;
132 $matchpoint_attr_type = C4
::Members
::AttributeTypes
->fetch($matchpoint);
135 push @feedback, {feedback
=>1, name
=>'headerrow', value
=>join(', ', @csvcolumns)};
136 my $today_iso = C4
::Dates
->new()->output('iso');
137 my @criticals = qw(surname branchcode categorycode); # there probably should be others
138 my @bad_dates; # I've had a few.
139 my $date_re = C4
::Dates
->new->regexp('syspref');
140 my $iso_re = C4
::Dates
->new->regexp('iso');
141 LINE
: while ( my $borrowerline = <$handle> ) {
143 my @missing_criticals;
144 my $patron_attributes;
145 my $status = $csv->parse($borrowerline);
146 my @columns = $csv->fields();
148 push @missing_criticals, {badparse
=>1, line
=>$., lineraw
=>$borrowerline};
149 } elsif (@columns == @columnkeys) {
150 @borrower{@columnkeys} = @columns;
151 # MJR: try to fill blanks gracefully by using default values
152 foreach my $key (@columnkeys) {
153 if ($borrower{$key} !~ /\S/) {
154 $borrower{$key} = $defaults{$key};
158 # MJR: try to recover gracefully by using default values
159 foreach my $key (@columnkeys) {
160 if (defined($csvkeycol{$key}) and $columns[$csvkeycol{$key}] =~ /\S/) {
161 $borrower{$key} = $columns[$csvkeycol{$key}];
162 } elsif ( $defaults{$key} ) {
163 $borrower{$key} = $defaults{$key};
164 } elsif ( scalar grep {$key eq $_} @criticals ) {
165 # a critical field is undefined
166 push @missing_criticals, {key
=>$key, line
=>$., lineraw
=>$borrowerline};
168 $borrower{$key} = '';
172 #warn join(':',%borrower);
173 if ($borrower{categorycode
}) {
174 push @missing_criticals, {key
=>'categorycode', line
=>$. , lineraw
=>$borrowerline, value
=>$borrower{categorycode
}, category_map
=>1}
175 unless GetBorrowercategory
($borrower{categorycode
});
177 push @missing_criticals, {key
=>'categorycode', line
=>$. , lineraw
=>$borrowerline};
179 if ($borrower{branchcode
}) {
180 push @missing_criticals, {key
=>'branchcode', line
=>$. , lineraw
=>$borrowerline, value
=>$borrower{branchcode
}, branch_map
=>1}
181 unless GetBranchName
($borrower{branchcode
});
183 push @missing_criticals, {key
=>'branchcode', line
=>$. , lineraw
=>$borrowerline};
185 if (@missing_criticals) {
186 foreach (@missing_criticals) {
187 $_->{borrowernumber
} = $borrower{borrowernumber
} || 'UNDEF';
188 $_->{surname
} = $borrower{surname
} || 'UNDEF';
191 (25 > scalar @errors) and push @errors, {missing_criticals
=>\
@missing_criticals};
192 # The first 25 errors are enough. Keeping track of 30,000+ would destroy performance.
196 my $attr_str = $borrower{patron_attributes
};
197 $attr_str =~ s/\xe2\x80\x9c/"/g; # fixup double quotes in case we are passed smart quotes
198 $attr_str =~ s/\xe2\x80\x9d/"/g;
199 push @feedback, {feedback
=>1, name
=>'attribute string', value
=>$attr_str, filename
=>$uploadborrowers};
200 delete $borrower{patron_attributes
}; # not really a field in borrowers, so we don't want to pass it to ModMember.
201 $patron_attributes = extended_attributes_code_value_arrayref
($attr_str);
203 # Popular spreadsheet applications make it difficult to force date outputs to be zero-padded, but we require it.
204 foreach (qw(dateofbirth dateenrolled dateexpiry)) {
205 my $tempdate = $borrower{$_} or next;
206 if ($tempdate =~ /$date_re/) {
207 $borrower{$_} = format_date_in_iso
($tempdate);
208 } elsif ($tempdate =~ /$iso_re/) {
209 $borrower{$_} = $tempdate;
212 push @missing_criticals, {key
=>$_, line
=>$. , lineraw
=>$borrowerline, bad_date
=>1};
215 $borrower{dateenrolled
} = $today_iso unless $borrower{dateenrolled
};
216 $borrower{dateexpiry
} = GetExpiryDate
($borrower{categorycode
},$borrower{dateenrolled
}) unless $borrower{dateexpiry
};
219 if ( ($matchpoint eq 'cardnumber') && ($borrower{'cardnumber'}) ) {
220 $member = GetMember
( 'cardnumber' => $borrower{'cardnumber'} );
222 $borrowernumber = $member->{'borrowernumber'};
224 } elsif ($extended) {
225 if (defined($matchpoint_attr_type)) {
226 foreach my $attr (@
$patron_attributes) {
227 if ($attr->{code
} eq $matchpoint and $attr->{value
} ne '') {
228 my @borrowernumbers = $matchpoint_attr_type->get_patrons($attr->{value
});
229 $borrowernumber = $borrowernumbers[0] if scalar(@borrowernumbers) == 1;
236 if ( C4
::Members
::checkcardnumber
( $borrower{cardnumber
}, $borrowernumber ) ) {
238 invalid_cardnumber
=> 1,
239 borrowernumber
=> $borrowernumber,
240 cardnumber
=> $borrower{cardnumber
}
247 if ($borrowernumber) {
249 unless ($overwrite_cardnumber) {
251 $template->param('lastalreadyindb'=>$borrower{'surname'}.' / '.$borrowernumber);
254 $borrower{'borrowernumber'} = $borrowernumber;
255 for my $col (keys %borrower) {
256 # use values from extant patron unless our csv file includes this column or we provided a default.
257 # FIXME : You cannot update a field with a perl-evaluated false value using the defaults.
259 # The password is always encrypted, skip it!
260 next if $col eq 'password';
262 unless(exists($csvkeycol{$col}) || $defaults{$col}) {
263 $borrower{$col} = $member->{$col} if($member->{$col}) ;
266 unless (ModMember
(%borrower)) {
268 # untill we have better error trapping, we have no way of knowing why ModMember errored out...
269 push @errors, {unknown_error
=> 1};
270 $template->param('lastinvalid'=>$borrower{'surname'}.' / '.$borrowernumber);
273 if ( $borrower{debarred
} ) {
274 # Check to see if this debarment already exists
275 my $debarrments = GetDebarments
(
277 borrowernumber
=> $borrowernumber,
278 expiration
=> $borrower{debarred
},
279 comment
=> $borrower{debarredcomment
}
282 # If it doesn't, then add it!
283 unless (@
$debarrments) {
286 borrowernumber
=> $borrowernumber,
287 expiration
=> $borrower{debarred
},
288 comment
=> $borrower{debarredcomment
}
295 my $old_attributes = GetBorrowerAttributes
($borrowernumber);
296 $patron_attributes = extended_attributes_merge
($old_attributes, $patron_attributes); #TODO: expose repeatable options in template
298 push @errors, {unknown_error
=> 1} unless SetBorrowerAttributes
($borrower{'borrowernumber'}, $patron_attributes);
301 $template->param('lastoverwritten'=>$borrower{'surname'}.' / '.$borrowernumber);
303 # FIXME: fixup_cardnumber says to lock table, but the web interface doesn't so this doesn't either.
304 # At least this is closer to AddMember than in members/memberentry.pl
305 if (!$borrower{'cardnumber'}) {
306 $borrower{'cardnumber'} = fixup_cardnumber
(undef);
308 if ($borrowernumber = AddMember
(%borrower)) {
310 if ( $borrower{debarred
} ) {
313 borrowernumber
=> $borrowernumber,
314 expiration
=> $borrower{debarred
},
315 comment
=> $borrower{debarredcomment
}
321 SetBorrowerAttributes
($borrowernumber, $patron_attributes);
324 if ($set_messaging_prefs) {
325 C4
::Members
::Messaging
::SetMessagingPreferencesFromDefaults
({ borrowernumber
=> $borrowernumber,
326 categorycode
=> $borrower{categorycode
} });
330 $template->param('lastimported'=>$borrower{'surname'}.' / '.$borrowernumber);
333 push @errors, {unknown_error
=> 1};
334 $template->param('lastinvalid'=>$borrower{'surname'}.' / AddMember');
338 (@errors ) and $template->param( ERRORS
=>\
@errors );
339 (@feedback) and $template->param(FEEDBACK
=>\
@feedback);
341 'uploadborrowers' => 1,
342 'imported' => $imported,
343 'overwritten' => $overwritten,
344 'alreadyindb' => $alreadyindb,
345 'invalid' => $invalid,
346 'total' => $imported + $alreadyindb + $invalid + $overwritten,
351 my @matchpoints = ();
352 my @attr_types = C4
::Members
::AttributeTypes
::GetAttributeTypes
(undef, 1);
353 foreach my $type (@attr_types) {
354 my $attr_type = C4
::Members
::AttributeTypes
->fetch($type->{code
});
355 if ($attr_type->unique_id()) {
356 push @matchpoints, { code
=> "patron_attribute_" . $attr_type->code(), description
=> $attr_type->description() };
359 $template->param(matchpoints
=> \
@matchpoints);
363 output_html_with_http_headers
$input, $cookie, $template->output;