From 75040a8caeaec8721451e6b09e049ae0c45a1b71 Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Tue, 27 Jan 2015 10:50:18 -0500 Subject: [PATCH] Bug 12598 - Update command line script to use patron import subroutine Signed-off-by: Benjamin Rokseth --- misc/import_borrowers.pl | 334 +++++------------------------------------------ 1 file changed, 34 insertions(+), 300 deletions(-) diff --git a/misc/import_borrowers.pl b/misc/import_borrowers.pl index d775e12..d6ca3d3 100755 --- a/misc/import_borrowers.pl +++ b/misc/import_borrowers.pl @@ -21,40 +21,16 @@ 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 ); +use Koha::Patrons::Import qw(import_patrons); my $csv_file; my $matchpoint; my $overwrite_cardnumber; my %defaults; my $ext_preserve = 0; -my $verbose; +my $verbose = 0; my $help; GetOptions( @@ -63,7 +39,7 @@ GetOptions( 'd|default=s' => \%defaults, 'o|overwrite' => \$overwrite_cardnumber, 'p|preserve-extended-atributes' => \$ext_preserve, - 'v|verbose' => \$verbose, + 'v|verbose+' => \$verbose, 'h|help|?' => \$help, ); @@ -72,285 +48,43 @@ 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; - } - } - } +my $return = Koha::Patrons::Import::import_patrons( + { + file => $handle, + defaults => \%defaults, + matchpoint => $matchpoint, + overwrite_cardnumber => $overwrite_cardnumber, + preserve_extended_attributes => $ext_preserve, } +); - 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} - } - ); - } +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}; - $imported++; +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{}; +} - print "Imported new patron $borrower{'surname'} / $borrowernumber\n" - if $verbose; - } - else { - $invalid++; - print "Failure to import $borrower{'surname'}\n" if $verbose; - } - } +if ($verbose > 1 ) { + say "Errors:"; + say Data::Dumper::Dumper( $errors ); } -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"; +if ($verbose > 2 ) { + say "Feedback:"; + say Data::Dumper::Dumper( $feedback ); } sub print_help { -- 2.1.4