d8c4068bd6a1b6caa85ce710183539d20ada27c7
[koha_gimpoz] / tools / import_borrowers.pl
1 #!/usr/bin/perl
2
3 # Copyright 2007 Liblime Ltd
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 # Script to take some borrowers data in a known format and load it into Koha
21 #
22 # File format
23 #
24 # cardnumber,surname,firstname,title,othernames,initials,streetnumber,streettype,
25 # address line , address line 2, city, zipcode, email, phone, mobile, fax, work email, work phone,
26 # alternate streetnumber, alternate streettype, alternate address line 1, alternate city,
27 # alternate zipcode, alternate email, alternate phone, date of birth, branchcode,
28 # categorycode, enrollment date, expiry date, noaddress, lost, debarred, contact surname,
29 # contact firstname, contact title, borrower notes, contact relationship, ethnicity, ethnicity notes
30 # gender, username, opac note, contact note, password, sort one, sort two
31 #
32 # any fields except cardnumber can be blank but the number of fields must match
33 # dates should be in the format you have set up Koha to expect
34 # branchcode and categorycode need to be valid
35
36 use strict;
37 use C4::Auth;
38 use C4::Output;
39 use C4::Dates qw(format_date_in_iso);
40 use C4::Context;
41 use C4::Members;
42 use C4::Members::Attributes;
43 use C4::Members::AttributeTypes;
44
45 use Text::CSV;
46 use CGI;
47
48 my @errors;
49 my $extended = C4::Context->preference('ExtendedPatronAttributes');
50 my @columnkeys = C4::Members->columns;
51 if ($extended) {
52     push @columnkeys, 'patron_attributes';
53 }
54 my $columnkeystpl = [ map { {'key' => $_} } @columnkeys ];  # ref. to array of hashrefs.
55
56 my $input = CGI->new();
57 my $csv   = Text::CSV->new();
58
59 my ( $template, $loggedinuser, $cookie ) = get_template_and_user({
60         template_name   => "tools/import_borrowers.tmpl",
61         query           => $input,
62         type            => "intranet",
63         authnotrequired => 0,
64         flagsrequired   => { tools => 'import_patrons' },
65         debug           => 1,
66 });
67
68 $template->param(columnkeys => $columnkeystpl);
69
70 if ($input->param('sample')) {
71     print $input->header(
72         -type       => 'application/vnd.sun.xml.calc', # 'application/vnd.ms-excel' ?
73         -attachment => 'patron_import.csv',
74     );
75     $csv->combine(@columnkeys);
76     print $csv->string, "\n";
77     exit 1;
78 }
79 my $uploadborrowers      = $input->param('uploadborrowers');
80 my $matchpoint           = $input->param('matchpoint');
81 if ($matchpoint) {
82     $matchpoint =~ s/^patron_attribute_//;
83 }
84 my $overwrite_cardnumber = $input->param('overwrite_cardnumber');
85
86 $template->param( SCRIPT_NAME => $ENV{'SCRIPT_NAME'} );
87
88 ($extended) and $template->param(ExtendedPatronAttributes => 1);
89
90 if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
91     my $imported    = 0;
92     my $alreadyindb = 0;
93     my $overwritten = 0;
94     my $invalid     = 0;
95     my $matchpoint_attr_type; 
96     my %defaults = $input->Vars;
97
98     # use header line to construct key to column map
99     my $borrowerline = <$uploadborrowers>;
100     my $status = $csv->parse($borrowerline);
101     ($status) or push @errors, {badheader=>1,line=>$., lineraw=>$borrowerline};
102     my @csvcolumns = $csv->fields();
103     my %csvkeycol;
104     my $col = 0;
105     foreach my $keycol (@csvcolumns) {
106         # columnkeys don't contain whitespace, but some stupid tools add it
107         $keycol =~ s/ +//g;
108         $csvkeycol{$keycol} = $col++;
109     }
110     #warn($borrowerline);
111
112     if ($extended) {
113         $matchpoint_attr_type = C4::Members::AttributeTypes->fetch($matchpoint);
114     }
115
116     my @criticals = qw(surname);    # there probably should be others
117     my @errors;
118     LINE: while ( my $borrowerline = <$uploadborrowers> ) {
119         my %borrower;
120         my @missing_criticals;
121         my $patron_attributes;
122         my $status  = $csv->parse($borrowerline);
123         my @columns = $csv->fields();
124         if (! $status) {
125             push @missing_criticals, {badparse=>1, line=>$., lineraw=>$borrowerline};
126         } elsif (@columns == @columnkeys) {
127             @borrower{@columnkeys} = @columns;
128         } else {
129             # MJR: try to recover gracefully by using default values
130             foreach my $key (@columnkeys) {
131                 if (defined($csvkeycol{$key}) and $columns[$csvkeycol{$key}] =~ /\S/) { 
132                     $borrower{$key} = $columns[$csvkeycol{$key}];
133                 } elsif ( $defaults{$key} ) {
134                     $borrower{$key} = $defaults{$key};
135                 } elsif ( scalar grep {$key eq $_} @criticals ) {
136                     # a critical field is undefined
137                     push @missing_criticals, {key=>$key, line=>$., lineraw=>$borrowerline};
138                 } else {
139                         $borrower{$key} = '';
140                 }
141             }
142         }
143         #warn join(':',%borrower);
144         if (@missing_criticals) {
145             foreach (@missing_criticals) {
146                 $_->{borrowernumber} = $borrower{borrowernumber} || 'UNDEF';
147                 $_->{surname}        = $borrower{surname} || 'UNDEF';
148             }
149             $invalid++;
150             (25 > scalar @errors) and push @errors, {missing_criticals=>\@missing_criticals};
151             # The first 25 errors are enough.  Keeping track of 30,000+ would destroy performance.
152             next LINE;
153         }
154         my @attrs;
155         if ($extended) {
156             my $attr_str = $borrower{patron_attributes};
157             delete $borrower{patron_attributes};
158             my $ok = $csv->parse($attr_str);
159             my @list = $csv->fields();
160             # FIXME error handling
161             $patron_attributes = [ map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ } @list ];
162         }
163         foreach (qw(dateofbirth dateenrolled dateexpiry)) {
164             my $tempdate = $borrower{$_} or next;
165             $borrower{$_} = format_date_in_iso($tempdate) || '';
166         }
167         my $borrowernumber;
168         if ($matchpoint eq 'cardnumber') {
169             my $member = GetMember( $borrower{'cardnumber'}, 'cardnumber' );
170             if ($member) {
171                 $borrowernumber = $member->{'borrowernumber'};
172             }
173         } elsif ($extended) {
174             if (defined($matchpoint_attr_type)) {
175                 foreach my $attr (@$patron_attributes) {
176                     if ($attr->{code} eq $matchpoint and $attr->{value} ne '') {
177                         my @borrowernumbers = $matchpoint_attr_type->get_patrons($attr->{value});
178                         $borrowernumber = $borrowernumbers[0] if scalar(@borrowernumbers) == 1;
179                         last;
180                     }
181                 }
182             }
183         }
184             
185         if ($borrowernumber) {
186             # borrower exists
187             unless ($overwrite_cardnumber) {
188                 $alreadyindb++;
189                 $template->param('lastalreadyindb'=>$borrower{'surname'}.' / '.$borrowernumber);
190                 next LINE;
191             }
192             $borrower{'borrowernumber'} = $borrowernumber;
193             unless (ModMember(%borrower)) {
194                 $invalid++;
195                 $template->param('lastinvalid'=>$borrower{'surname'}.' / '.$borrowernumber);
196                 next LINE;
197             }
198             if ($extended) {
199                 C4::Members::Attributes::SetBorrowerAttributes($borrower{'borrowernumber'}, $patron_attributes);
200             }
201             $overwritten++;
202             $template->param('lastoverwritten'=>$borrower{'surname'}.' / '.$borrowernumber);
203         } else {
204             # FIXME: fixup_cardnumber says to lock table, but the web interface doesn't so this doesn't either.
205             # At least this is closer to AddMember than in members/memberentry.pl
206             if (!$borrower{'cardnumber'}) {
207                 $borrower{'cardnumber'} = fixup_cardnumber('');
208             }
209             if ($borrowernumber = AddMember(%borrower)) {
210                 if ($extended) {
211                     C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, $patron_attributes);
212                 }
213                 $imported++;
214                 $template->param('lastimported'=>$borrower{'surname'}.' / '.$borrowernumber);
215             } else {
216                 $invalid++;             # was just "$invalid", I assume incrementing was the point --atz
217                 $template->param('lastinvalid'=>$borrower{'surname'}.' / AddMember');
218             }
219         }
220     }
221     (@errors) and $template->param(ERRORS=>\@errors);
222     $template->param(
223         'uploadborrowers' => 1,
224         'imported'        => $imported,
225         'overwritten'     => $overwritten,
226         'alreadyindb'     => $alreadyindb,
227         'invalid'         => $invalid,
228         'total'           => $imported + $alreadyindb + $invalid + $overwritten,
229     );
230
231 } else {
232     if ($extended) {
233         my @matchpoints = ();
234         my @attr_types = C4::Members::AttributeTypes::GetAttributeTypes();
235         foreach my $type (@attr_types) {
236             my $attr_type = C4::Members::AttributeTypes->fetch($type->{code});
237             if ($attr_type->unique_id()) {
238             push @matchpoints, { code =>  "patron_attribute_" . $attr_type->code(), description => $attr_type->description() };
239             }
240         }
241         $template->param(matchpoints => \@matchpoints);
242     }
243 }
244
245 output_html_with_http_headers $input, $cookie, $template->output;
246