From b13176ff9302da1e05b399f62279ea736afdafab Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Mon, 21 Jul 2014 13:50:08 -0400 Subject: [PATCH] Bug 12598: New misc/import_borrowers.pl command line tool Test Plan: 1) Apply this patch 2) Test importing patrons from command line, options are availble with --help. Signed-off-by: Bernardo Gonzalez Kriegel Tested with minimal csv (cardnumber,surname,firstname,categorycode,branchcode,password,userid) Overwrite does not change category or branch. Patrons are loaded, userid & password works Updated license to GPLv3 No other koha-qa errors. --- misc/import_borrowers.pl | 367 ++++++++++++++++++++++++++++++++++++++++++++++ 1 files changed, 367 insertions(+), 0 deletions(-) create mode 100755 misc/import_borrowers.pl diff --git a/misc/import_borrowers.pl b/misc/import_borrowers.pl new file mode 100755 index 0000000..d775e12 --- /dev/null +++ b/misc/import_borrowers.pl @@ -0,0 +1,367 @@ +#!/usr/bin/perl + +# Copyright 2007 Liblime +# Parts copyright 2010 BibLibre +# Parts copyright 2014 ByWater Solutions +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +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 + +my ( $template, $loggedinuser, $cookie ); + +my $csv_file; +my $matchpoint; +my $overwrite_cardnumber; +my %defaults; +my $ext_preserve = 0; +my $verbose; +my $help; + +GetOptions( + 'c|csv=s' => \$csv_file, + 'm|matchpoint=s' => \$matchpoint, + 'd|default=s' => \%defaults, + 'o|overwrite' => \$overwrite_cardnumber, + 'p|preserve-extended-atributes' => \$ext_preserve, + 'v|verbose' => \$verbose, + 'h|help|?' => \$help, +); + +print_help() if ( $help || !$csv_file || !$matchpoint ); + +my $handle; +open( $handle, "<", $csv_file ) or die $!; + +my $imported = 0; +my $alreadyindb = 0; +my $overwritten = 0; +my $invalid = 0; +my $matchpoint_attr_type; + +# use header line to construct key to column map +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; + } + } + } + } + + if ( C4::Members::checkcardnumber( $borrower{cardnumber}, $borrowernumber ) ) { + $borrowernumber ||= q{}; + print "ERROR: invalid cardnumber '$borrower{cardnumber}' for borrowernumber $borrowernumber\n"; + $invalid++; + next; + } + + 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} + } + ); + } + + $imported++; + + print "Imported new patron $borrower{'surname'} / $borrowernumber\n" + if $verbose; + } + else { + $invalid++; + print "Failure to import $borrower{'surname'}\n" if $verbose; + } + } +} + +if ($verbose) { + my $total = $imported + $alreadyindb + $invalid + $overwritten; + print "\nImport complete:\n"; + print "Imported: $imported\n"; + print "Overwritten: $overwritten\n"; + print "Skipped: $alreadyindb\n"; + print "Invalid: $invalid\n"; + print "Total: $total\n\n"; +} + +sub print_help { + print <<_USAGE_; +import_borrowers.pl -c /path/to/borrowers.csv -m cardnumber + -c --csv Path to the CSV file of patrons to import + -m --matchpoint Field on which to match incoming patrons to existing patrons + -d --default Set defaults to patron fields, repeatable e.g. --default branchcode=MPL --default categorycode=PT + -p --preserve-extended-atributes Retain extended patron attributes for existing patrons being overwritten + -o --overwrite Overwrite existing patrons with new data if a match is found + -v --verbose Be verbose +_USAGE_ + exit; +} -- 1.7.2.5