Attachment #36687 for bug #12598

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





use Modern::Perl;

use C4::Dates qw(format_date_in_iso);
use C4::Context;
use C4::Branch qw(GetBranchName);
use C4::Members;
use C4::Members::Attributes qw(:all);
use C4::Members::AttributeTypes;
use C4::Members::Messaging;
use Koha::Borrower::Debarments;

use Getopt::Long;
use Text::CSV;

my $extended = C4::Context->preference('ExtendedPatronAttributes');
my $set_messaging_prefs =
  C4::Context->preference('EnhancedMessagingPreferences');
my @columnkeys = C4::Members::columns();
if ($extended) {
    push @columnkeys, 'patron_attributes';
}
my $columnkeystpl =
  [ map { { 'key' => $_ } } grep { $_ ne 'borrowernumber' } @columnkeys ]
  ;    # ref. to array of hashrefs.

our $csv =
  Text::CSV->new( { binary => 1 } );    # binary needed for non-ASCII Unicode

use Koha::Patrons::Import qw(import_patrons);

my $csv_file;
my $matchpoint;
my $overwrite_cardnumber;
my %defaults;
my $ext_preserve = 0;
my $verbose      = 0;
my $help;

GetOptions(

    'd|default=s'                   => \%defaults,
    'o|overwrite'                   => \$overwrite_cardnumber,
    'p|preserve-extended-atributes' => \$ext_preserve,
    'v|verbose+'                    => \$verbose,
    'h|help|?'                      => \$help,
);


my $handle;
open( $handle, "<", $csv_file ) or die $!;

my $return = Koha::Patrons::Import::import_patrons(
    {
        file                         => $handle,
        defaults                     => \%defaults,
        matchpoint                   => $matchpoint,
        overwrite_cardnumber         => $overwrite_cardnumber,
        preserve_extended_attributes => $ext_preserve,
my $borrowerline = <$handle>;
my $status       = $csv->parse($borrowerline);
print "WARNING: CSV header line is incomplete: $borrowerline\n" unless $status;
my @csvcolumns = $csv->fields();
my %csvkeycol;
my $col = 0;

foreach my $keycol (@csvcolumns) {

    # columnkeys don't contain whitespace, but some stupid tools add it
    $keycol =~ s/ +//g;
    $csvkeycol{$keycol} = $col++;
}
if ($extended) {
    $matchpoint_attr_type = C4::Members::AttributeTypes->fetch($matchpoint);
}

my $today_iso = C4::Dates->new()->output('iso');
my @criticals =
  qw(surname branchcode categorycode);    # there probably should be others
my @bad_dates;                            # I've had a few.
my $date_re = C4::Dates->new->regexp('syspref');
my $iso_re  = C4::Dates->new->regexp('iso');
LINE: while ( my $borrowerline = <$handle> ) {
    my %borrower;
    my @missing_criticals;
    my $patron_attributes;
    my $status  = $csv->parse($borrowerline);
    my @columns = $csv->fields();
    if ( !$status ) {
        push @missing_criticals,
          { badparse => 1, line => $., lineraw => $borrowerline };
        print "ERROR: Unable to parse line $.: $borrowerline";
    }
    elsif ( @columns == @columnkeys ) {
        @borrower{@columnkeys} = @columns;

        # MJR: try to fill blanks gracefully by using default values
        foreach my $key (@columnkeys) {
            if ( $borrower{$key} !~ /\S/ ) {
                $borrower{$key} = $defaults{$key};
            }
        }
    }
    else {
        # MJR: try to recover gracefully by using default values
        foreach my $key (@columnkeys) {
            if ( defined( $csvkeycol{$key} )
                and $columns[ $csvkeycol{$key} ] =~ /\S/ )
            {
                $borrower{$key} = $columns[ $csvkeycol{$key} ];
            }
            elsif ( $defaults{$key} ) {
                $borrower{$key} = $defaults{$key};
            }
            elsif ( scalar grep { $key eq $_ } @criticals ) {

                # a critical field is undefined
                print
"ERROR: missing critical column data '$key' for line $.: $borrowerline\n";
            }
            else {
                $borrower{$key} = '';
            }
        }
    }

    #warn join(':',%borrower);
    if ( $borrower{categorycode} ) {
        print "ERROR: invalid categorycode for line $.: $borrowerline\n"
          unless ( GetBorrowercategory( $borrower{categorycode} ) );
    }
    else {
        print "ERROR: missing categorycode for line $.: $borrowerline\n";
    }

    if ( $borrower{branchcode} ) {
        print "ERROR: invalid branchcode for line $.: $borrowerline\n"
          unless ( GetBranchName( $borrower{branchcode} ) );
    }
    else {
        print "ERROR: missing branchcode for line $.: $borrowerline\n";
    }

    if ($extended) {
        my $attr_str = $borrower{patron_attributes};

        # fixup double quotes in case we are passed smart quotes
        $attr_str =~ s/\xe2\x80\x9c/"/g;
        $attr_str =~ s/\xe2\x80\x9d/"/g;

        # not really a field in borrowers, so we don't want to pass it to ModMember.
        delete $borrower{patron_attributes};
        $patron_attributes = extended_attributes_code_value_arrayref($attr_str);
    }

    # Popular spreadsheet applications make it difficult to force date outputs to be zero-padded, but we require it.
    foreach (qw(dateofbirth dateenrolled dateexpiry)) {
        my $tempdate = $borrower{$_} or next;

        if ( $tempdate =~ /$date_re/ ) {
            $borrower{$_} = format_date_in_iso($tempdate);
        }
        elsif ( $tempdate =~ /$iso_re/ ) {
            $borrower{$_} = $tempdate;
        }
        else {
            $borrower{$_} = '';
            push @missing_criticals,
              {
                key      => $_,
                line     => $.,
                lineraw  => $borrowerline,
                bad_date => 1
              };
        }
    }

    $borrower{dateenrolled} = $today_iso unless $borrower{dateenrolled};

    $borrower{dateexpiry} =
      GetExpiryDate( $borrower{categorycode}, $borrower{dateenrolled} )
      unless $borrower{dateexpiry};

    my $borrowernumber;
    my $member;
    if ( ( $matchpoint eq 'cardnumber' ) && ( $borrower{'cardnumber'} ) ) {
        $member = GetMember( 'cardnumber' => $borrower{'cardnumber'} );
        if ($member) {
            $borrowernumber = $member->{'borrowernumber'};
        }
    }
    elsif ( ( $matchpoint eq 'userid' ) && ( $borrower{'userid'} ) ) {
        $member = GetMember( 'userid' => $borrower{'userid'} );
        if ($member) {
            $borrowernumber = $member->{'borrowernumber'};
        }
    }
    elsif ($extended) {
        if ( defined($matchpoint_attr_type) ) {
            foreach my $attr (@$patron_attributes) {
                if ( $attr->{code} eq $matchpoint and $attr->{value} ne '' ) {
                    my @borrowernumbers =
                      $matchpoint_attr_type->get_patrons( $attr->{value} );
                    $borrowernumber = $borrowernumbers[0]
                      if scalar(@borrowernumbers) == 1;
                    last;
                }
            }
        }
    }
);

my $feedback    = $return->{feedback};
my $errors      = $return->{errors};
my $imported    = $return->{imported};
my $overwritten = $return->{overwritten};
my $alreadyindb = $return->{already_in_db};
my $invalid     = $return->{invalid};

    if ($borrowernumber) {

        # borrower exists
        unless ($overwrite_cardnumber) {
            $alreadyindb++;
            print "$borrower{'surname'} / $borrowernumber alredy in database.\n" if $verbose;
            next LINE;
        }

        $borrower{'borrowernumber'} = $borrowernumber;

        # use values from extant patron unless our csv file includes this column or we provided a default.
        for my $col ( keys %borrower ) {
            # The password is always encrypted, skip it!
            next if $col eq 'password';

            unless ( exists( $csvkeycol{$col} ) || $defaults{$col} ) {
                $borrower{$col} = $member->{$col} if ( $member->{$col} );
            }
        }

        unless ( ModMember(%borrower) ) {
            $invalid++;

            # untill we have better error trapping, we have no way of knowing why ModMember errored out...
            print "Failure to update $borrower{'surname'} / $borrowernumber\n"
              if $verbose;
            next LINE;
        }

        if ( $borrower{debarred} ) {

            # Check to see if this debarment already exists
            my $debarrments = GetDebarments(
                {
                    borrowernumber => $borrowernumber,
                    expiration     => $borrower{debarred},
                    comment        => $borrower{debarredcomment}
                }
            );

            # If it doesn't, then add it!
            unless (@$debarrments) {
                AddDebarment(
                    {
                        borrowernumber => $borrowernumber,
                        expiration     => $borrower{debarred},
                        comment        => $borrower{debarredcomment}
                    }
                );
            }
        }

        if ($extended) {
            if ($ext_preserve) {
                my $old_attributes = GetBorrowerAttributes($borrowernumber);
                $patron_attributes = extended_attributes_merge( $old_attributes, $patron_attributes );
            }
        }

        print "Overwriting $borrower{'surname'} / $borrowernumber with new data\n";
        $overwritten++;
    }
    else {
        if ( !$borrower{'cardnumber'} ) {
            $borrower{'cardnumber'} = fixup_cardnumber(undef);
        }

        if ( $borrowernumber = AddMember(%borrower) ) {

            if ( $borrower{debarred} ) {
                AddDebarment(
                    {
                        borrowernumber => $borrowernumber,
                        expiration     => $borrower{debarred},
                        comment        => $borrower{debarredcomment}
                    }
                );
            }

            if ($extended) {
                SetBorrowerAttributes( $borrowernumber, $patron_attributes );
            }

            if ($set_messaging_prefs) {
                C4::Members::Messaging::SetMessagingPreferencesFromDefaults(
                    {
                        borrowernumber => $borrowernumber,
                        categorycode   => $borrower{categorycode}
                    }
                );
            }

if ($verbose) {
    my $total = $imported + $alreadyindb + $invalid + $overwritten;
    say q{};
    say "Import complete:";
    say "Imported:    $imported";
    say "Overwritten: $overwritten";
    say "Skipped:     $alreadyindb";
    say "Invalid:     $invalid";
    say "Total:       $total";
    say q{};
}

if ($verbose > 1 ) {
    say "Errors:";
    say Data::Dumper::Dumper( $errors );
        else {
            $invalid++;
            print "Failure to import $borrower{'surname'}\n" if $verbose;
        }
    }
}

if ($verbose > 2 ) {
    say "Feedback:";
    say Data::Dumper::Dumper( $feedback );
    print "Imported:    $imported\n";
    print "Overwritten: $overwritten\n";
    print "Skipped:     $alreadyindb\n";
    print "Invalid:     $invalid\n";
    print "Total:       $total\n\n";
}

sub print_help {
- 

Return to bug 12598

Lines 21-60 Link Here

(-)a/misc/import_borrowers.pl (-301 / +34 lines)
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	-