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
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
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
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
43 use C4
::Branch qw
/GetBranchesLoop GetBranchName/;
45 use C4
::Members
::Attributes
qw(:all);
46 use C4
::Members
::AttributeTypes
;
47 use C4
::Members
::Messaging
;
48 use C4
::Reports
::Guided
;
50 use Koha
::Patron
::Debarments
;
54 # Text::CSV::Unicode, even in binary mode, fails to parse lines with these diacriticals:
59 # use encoding 'utf8'; # don't do this
61 my (@errors, @feedback);
62 my $extended = C4
::Context
->preference('ExtendedPatronAttributes');
63 my $set_messaging_prefs = C4
::Context
->preference('EnhancedMessagingPreferences');
64 my @columnkeys = C4
::Members
::columns
();
65 @columnkeys = map { $_ ne 'borrowernumber' ?
$_ : () } @columnkeys;
67 push @columnkeys, 'patron_attributes';
70 my $input = CGI
->new();
71 our $csv = Text
::CSV
->new({binary
=> 1}); # binary needed for non-ASCII Unicode
72 #push @feedback, {feedback=>1, name=>'backend', value=>$csv->backend, backend=>$csv->backend}; #XXX
74 my ( $template, $loggedinuser, $cookie ) = get_template_and_user
({
75 template_name
=> "tools/import_borrowers.tt",
79 flagsrequired
=> { tools
=> 'import_patrons' },
83 # get the branches and pass them to the template
84 my $branches = GetBranchesLoop
();
85 $template->param( branches
=> $branches ) if ( $branches );
86 # get the patron categories and pass them to the template
87 my $categories = GetBorrowercategoryList
();
88 $template->param( categories
=> $categories ) if ( $categories );
89 my $columns = C4
::Templates
::GetColumnDefs
( $input )->{borrowers
};
90 $columns = [ grep { $_->{field
} ne 'borrowernumber' ?
$_ : () } @
$columns ];
91 $template->param( borrower_fields
=> $columns );
93 if ($input->param('sample')) {
95 -type
=> 'application/vnd.sun.xml.calc', # 'application/vnd.ms-excel' ?
96 -attachment
=> 'patron_import.csv',
98 $csv->combine(@columnkeys);
99 print $csv->string, "\n";
102 my $uploadborrowers = $input->param('uploadborrowers');
103 my $matchpoint = $input->param('matchpoint');
105 $matchpoint =~ s/^patron_attribute_//;
107 my $overwrite_cardnumber = $input->param('overwrite_cardnumber');
109 $template->param( SCRIPT_NAME
=> '/cgi-bin/koha/tools/import_borrowers.pl' );
111 if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
112 push @feedback, {feedback
=>1, name
=>'filename', value
=>$uploadborrowers, filename
=>$uploadborrowers};
113 my $handle = $input->upload('uploadborrowers');
114 my $uploadinfo = $input->uploadInfo($uploadborrowers);
115 foreach (keys %$uploadinfo) {
116 push @feedback, {feedback
=>1, name
=>$_, value
=>$uploadinfo->{$_}, $_=>$uploadinfo->{$_}};
122 my $matchpoint_attr_type;
123 my %defaults = $input->Vars;
125 # use header line to construct key to column map
126 my $borrowerline = <$handle>;
127 my $status = $csv->parse($borrowerline);
128 ($status) or push @errors, {badheader
=>1,line
=>$., lineraw
=>$borrowerline};
129 my @csvcolumns = $csv->fields();
132 foreach my $keycol (@csvcolumns) {
133 # columnkeys don't contain whitespace, but some stupid tools add it
135 $csvkeycol{$keycol} = $col++;
137 #warn($borrowerline);
138 my $ext_preserve = $input->param('ext_preserve') || 0;
140 $matchpoint_attr_type = C4
::Members
::AttributeTypes
->fetch($matchpoint);
143 push @feedback, {feedback
=>1, name
=>'headerrow', value
=>join(', ', @csvcolumns)};
144 my $today_iso = output_pref
( { dt
=> dt_from_string
, dateonly
=> 1, dateformat
=> 'iso' });
145 my @criticals = qw(surname branchcode categorycode); # there probably should be others
146 my @bad_dates; # I've had a few.
147 LINE
: while ( my $borrowerline = <$handle> ) {
149 my @missing_criticals;
150 my $patron_attributes;
151 my $status = $csv->parse($borrowerline);
152 my @columns = $csv->fields();
154 push @missing_criticals, {badparse
=>1, line
=>$., lineraw
=>$borrowerline};
155 } elsif (@columns == @columnkeys) {
156 @borrower{@columnkeys} = @columns;
157 # MJR: try to fill blanks gracefully by using default values
158 foreach my $key (@columnkeys) {
159 if ($borrower{$key} !~ /\S/) {
160 $borrower{$key} = $defaults{$key};
164 # MJR: try to recover gracefully by using default values
165 foreach my $key (@columnkeys) {
166 if (defined($csvkeycol{$key}) and $columns[$csvkeycol{$key}] =~ /\S/) {
167 $borrower{$key} = $columns[$csvkeycol{$key}];
168 } elsif ( $defaults{$key} ) {
169 $borrower{$key} = $defaults{$key};
170 } elsif ( scalar grep {$key eq $_} @criticals ) {
171 # a critical field is undefined
172 push @missing_criticals, {key
=>$key, line
=>$., lineraw
=>$borrowerline};
174 $borrower{$key} = '';
178 #warn join(':',%borrower);
179 if ($borrower{categorycode
}) {
180 push @missing_criticals, {key
=>'categorycode', line
=>$. , lineraw
=>$borrowerline, value
=>$borrower{categorycode
}, category_map
=>1}
181 unless GetBorrowercategory
($borrower{categorycode
});
183 push @missing_criticals, {key
=>'categorycode', line
=>$. , lineraw
=>$borrowerline};
185 if ($borrower{branchcode
}) {
186 push @missing_criticals, {key
=>'branchcode', line
=>$. , lineraw
=>$borrowerline, value
=>$borrower{branchcode
}, branch_map
=>1}
187 unless GetBranchName
($borrower{branchcode
});
189 push @missing_criticals, {key
=>'branchcode', line
=>$. , lineraw
=>$borrowerline};
191 if (@missing_criticals) {
192 foreach (@missing_criticals) {
193 $_->{borrowernumber
} = $borrower{borrowernumber
} || 'UNDEF';
194 $_->{surname
} = $borrower{surname
} || 'UNDEF';
197 (25 > scalar @errors) and push @errors, {missing_criticals
=>\
@missing_criticals};
198 # The first 25 errors are enough. Keeping track of 30,000+ would destroy performance.
202 my $attr_str = $borrower{patron_attributes
};
203 $attr_str =~ s/\xe2\x80\x9c/"/g; # fixup double quotes in case we are passed smart quotes
204 $attr_str =~ s/\xe2\x80\x9d/"/g;
205 push @feedback, {feedback
=>1, name
=>'attribute string', value
=>$attr_str, filename
=>$uploadborrowers};
206 delete $borrower{patron_attributes
}; # not really a field in borrowers, so we don't want to pass it to ModMember.
207 $patron_attributes = extended_attributes_code_value_arrayref
($attr_str);
209 # Popular spreadsheet applications make it difficult to force date outputs to be zero-padded, but we require it.
210 foreach (qw(dateofbirth dateenrolled dateexpiry)) {
211 my $tempdate = $borrower{$_} or next;
212 $tempdate = eval { output_pref
( { dt
=> dt_from_string
( $tempdate ), dateonly
=> 1, dateformat
=> 'iso' } ); };
214 $borrower{$_} = $tempdate;
217 push @missing_criticals, {key
=>$_, line
=>$. , lineraw
=>$borrowerline, bad_date
=>1};
220 $borrower{dateenrolled
} = $today_iso unless $borrower{dateenrolled
};
221 $borrower{dateexpiry
} = GetExpiryDate
($borrower{categorycode
},$borrower{dateenrolled
}) unless $borrower{dateexpiry
};
224 if ( ($matchpoint eq 'cardnumber') && ($borrower{'cardnumber'}) ) {
225 $member = GetMember
( 'cardnumber' => $borrower{'cardnumber'} );
227 $borrowernumber = $member->{'borrowernumber'};
229 } elsif ( ($matchpoint eq 'userid') && ($borrower{'userid'}) ) {
230 $member = GetMember
( 'userid' => $borrower{'userid'} );
232 $borrowernumber = $member->{'borrowernumber'};
234 } elsif ($extended) {
235 if (defined($matchpoint_attr_type)) {
236 foreach my $attr (@
$patron_attributes) {
237 if ($attr->{code
} eq $matchpoint and $attr->{value
} ne '') {
238 my @borrowernumbers = $matchpoint_attr_type->get_patrons($attr->{value
});
239 $borrowernumber = $borrowernumbers[0] if scalar(@borrowernumbers) == 1;
246 if ( C4
::Members
::checkcardnumber
( $borrower{cardnumber
}, $borrowernumber ) ) {
248 invalid_cardnumber
=> 1,
249 borrowernumber
=> $borrowernumber,
250 cardnumber
=> $borrower{cardnumber
}
256 # generate a proper login if none provided
257 if ( $borrower{userid
} eq '' || !Check_Userid
( $borrower{userid
} ) ) {
258 push @errors, { duplicate_userid
=> 1, userid
=> $borrower{userid
} };
264 if ($borrowernumber) {
266 unless ($overwrite_cardnumber) {
268 $template->param('lastalreadyindb'=>$borrower{'surname'}.' / '.$borrowernumber);
271 $borrower{'borrowernumber'} = $borrowernumber;
272 for my $col (keys %borrower) {
273 # use values from extant patron unless our csv file includes this column or we provided a default.
274 # FIXME : You cannot update a field with a perl-evaluated false value using the defaults.
276 # The password is always encrypted, skip it!
277 next if $col eq 'password';
279 unless(exists($csvkeycol{$col}) || $defaults{$col}) {
280 $borrower{$col} = $member->{$col} if($member->{$col}) ;
283 unless (ModMember
(%borrower)) {
285 # until we have better error trapping, we have no way of knowing why ModMember errored out...
286 push @errors, {unknown_error
=> 1};
287 $template->param('lastinvalid'=>$borrower{'surname'}.' / '.$borrowernumber);
291 # Don't add a new restriction if the existing 'combined' restriction matches this one
292 if ( $borrower{debarred
} && ( ( $borrower{debarred
} ne $member->{debarred
} ) || ( $borrower{debarredcomment
} ne $member->{debarredcomment
} ) ) ) {
293 # Check to see if this debarment already exists
294 my $debarrments = GetDebarments
(
296 borrowernumber
=> $borrowernumber,
297 expiration
=> $borrower{debarred
},
298 comment
=> $borrower{debarredcomment
}
301 # If it doesn't, then add it!
302 unless (@
$debarrments) {
305 borrowernumber
=> $borrowernumber,
306 expiration
=> $borrower{debarred
},
307 comment
=> $borrower{debarredcomment
}
315 my $old_attributes = GetBorrowerAttributes
($borrowernumber);
316 $patron_attributes = extended_attributes_merge
($old_attributes, $patron_attributes); #TODO: expose repeatable options in template
318 push @errors, {unknown_error
=> 1} unless SetBorrowerAttributes
($borrower{'borrowernumber'}, $patron_attributes, 'no_branch_limit' );
321 $template->param('lastoverwritten'=>$borrower{'surname'}.' / '.$borrowernumber);
323 # FIXME: fixup_cardnumber says to lock table, but the web interface doesn't so this doesn't either.
324 # At least this is closer to AddMember than in members/memberentry.pl
325 if (!$borrower{'cardnumber'}) {
326 $borrower{'cardnumber'} = fixup_cardnumber
(undef);
328 if ($borrowernumber = AddMember
(%borrower)) {
330 if ( $borrower{debarred
} ) {
333 borrowernumber
=> $borrowernumber,
334 expiration
=> $borrower{debarred
},
335 comment
=> $borrower{debarredcomment
}
341 SetBorrowerAttributes
($borrowernumber, $patron_attributes);
344 if ($set_messaging_prefs) {
345 C4
::Members
::Messaging
::SetMessagingPreferencesFromDefaults
({ borrowernumber
=> $borrowernumber,
346 categorycode
=> $borrower{categorycode
} });
350 $template->param('lastimported'=>$borrower{'surname'}.' / '.$borrowernumber);
353 push @errors, {unknown_error
=> 1};
354 $template->param('lastinvalid'=>$borrower{'surname'}.' / AddMember');
358 (@errors ) and $template->param( ERRORS
=>\
@errors );
359 (@feedback) and $template->param(FEEDBACK
=>\
@feedback);
361 'uploadborrowers' => 1,
362 'imported' => $imported,
363 'overwritten' => $overwritten,
364 'alreadyindb' => $alreadyindb,
365 'invalid' => $invalid,
366 'total' => $imported + $alreadyindb + $invalid + $overwritten,
371 my @matchpoints = ();
372 my @attr_types = C4
::Members
::AttributeTypes
::GetAttributeTypes
(undef, 1);
373 foreach my $type (@attr_types) {
374 my $attr_type = C4
::Members
::AttributeTypes
->fetch($type->{code
});
375 if ($attr_type->unique_id()) {
376 push @matchpoints, { code
=> "patron_attribute_" . $attr_type->code(), description
=> $attr_type->description() };
379 $template->param(matchpoints
=> \
@matchpoints);
383 output_html_with_http_headers
$input, $cookie, $template->output;