[Koha-patches] [PATCH] Allow option to preserve Extended Attributes on patron import update.

Galen Charlton galen.charlton at liblime.com
Wed May 27 20:38:58 CEST 2009


From: Joe Atzberger <joe.atzberger at liblime.com>

Essentially, this patch provides the option to overwrite only matching
Extended Attributes, instead of all of them, treating the ext. fields more
like normal fields.

Several functions added to Members::Attributes with corresponding tests.

[ LL ref. 342 ]

Signed-off-by: Galen Charlton <galen.charlton at liblime.com>
---
 C4/Members/AttributeTypes.pm                       |   22 +++--
 C4/Members/Attributes.pm                           |  107 ++++++++++++++++++--
 .../prog/en/modules/tools/import_borrowers.tmpl    |   27 ++++-
 t/Members_Attributes.t                             |  110 ++++++++++++++++++++
 tools/import_borrowers.pl                          |   35 +++---
 5 files changed, 263 insertions(+), 38 deletions(-)
 create mode 100755 t/Members_Attributes.t

diff --git a/C4/Members/AttributeTypes.pm b/C4/Members/AttributeTypes.pm
index 4eb6990..93c67a5 100644
--- a/C4/Members/AttributeTypes.pm
+++ b/C4/Members/AttributeTypes.pm
@@ -60,28 +60,34 @@ $attr_type = C4::Members::AttributeTypes->delete($code);
 
 =over 4
 
-my @attribute_types = C4::Members::AttributeTypes::GetAttributeTypes();
+my @attribute_types = C4::Members::AttributeTypes::GetAttributeTypes($all_fields);
 
 =back
 
 Returns an array of hashrefs of each attribute type defined
 in the database.  The array is sorted by code.  Each hashref contains
-the following fields:
+at least the following fields:
 
 code
 description
 
+If $all_fields is true, then each hashref also contains the other fields from borrower_attribute_types.
+
 =cut
 
 sub GetAttributeTypes {
+    my $all = @_ ? shift : 0;
+    my $select = $all ? '*' : 'code, description';
     my $dbh = C4::Context->dbh;
-    my $sth = $dbh->prepare('SELECT code, description FROM borrower_attribute_types ORDER by code');
+    my $sth = $dbh->prepare("SELECT $select FROM borrower_attribute_types ORDER by code");
     $sth->execute();
-    my @results = ();
-    while (my $row = $sth->fetchrow_hashref) {
-        push @results, $row;
-    }
-    return @results;
+    my $results = $sth->fetchall_arrayref({});
+    return @$results;
+}
+
+sub GetAttributeTypes_hashref {
+    my %hash = map {$_->{code} => $_} GetAttributeTypes(@_);
+    return \%hash;
 }
 
 =head1 METHODS 
diff --git a/C4/Members/Attributes.pm b/C4/Members/Attributes.pm
index e012320..88c6c09 100644
--- a/C4/Members/Attributes.pm
+++ b/C4/Members/Attributes.pm
@@ -18,25 +18,34 @@ package C4::Members::Attributes;
 # Suite 330, Boston, MA  02111-1307 USA
 
 use strict;
+use warnings;
+
+use Text::CSV;      # Don't be tempted to use Text::CSV::Unicode -- even in binary mode it fails.
 use C4::Context;
 use C4::Members::AttributeTypes;
 
-use vars qw($VERSION);
+use vars qw($VERSION @ISA @EXPORT_OK @EXPORT %EXPORT_TAGS);
+our ($csv, $AttributeTypes);
 
 BEGIN {
     # set the version for version checking
-    $VERSION = 3.00;
+    $VERSION = 3.01;
+    @ISA = qw(Exporter);
+    @EXPORT_OK = qw(GetBorrowerAttributes CheckUniqueness SetBorrowerAttributes
+                    extended_attributes_code_value_arrayref extended_attributes_merge);
+    %EXPORT_TAGS = ( all => \@EXPORT_OK );
 }
 
 =head1 NAME
 
-C4::Members::Attribute - manage extend patron attributes
+C4::Members::Attributes - manage extend patron attributes
 
 =head1 SYNOPSIS
 
 =over 4
 
-my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber);
+    use C4::Members::Attributes;
+    my $attributes = C4::Members::Attributes::GetBorrowerAttributes($borrowernumber);
 
 =back
 
@@ -96,7 +105,7 @@ sub GetBorrowerAttributes {
 
 =over 4
 
-my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
+    my $ok = CheckUniqueness($code, $value[, $borrowernumber]);
 
 =back
 
@@ -137,7 +146,6 @@ sub CheckUniqueness {
         $sth->execute($code, $value);
     }
     my ($count) = $sth->fetchrow_array;
-    $sth->finish();
     return ($count == 0);
 }
 
@@ -145,7 +153,7 @@ sub CheckUniqueness {
 
 =over 4
 
-SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] );
+    SetBorrowerAttributes($borrowernumber, [ { code => 'CODE', value => 'value', password => 'password' }, ... ] );
 
 =back
 
@@ -170,6 +178,91 @@ sub SetBorrowerAttributes {
     }
 }
 
+=head2 extended_attributes_code_value_arrayref 
+
+=over 4
+
+    my $patron_attributes = "homeroom:1150605,grade:01,extradata:foobar";
+    my $aref = extended_attributes_code_value_arrayref($patron_attributes);
+
+=back
+
+Takes a comma-delimited CSV-style string argument and returns the kind of data structure that SetBorrowerAttributes wants, 
+namely a reference to array of hashrefs like:
+ [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
+
+Caches Text::CSV parser object for efficiency.
+
+=cut
+
+sub extended_attributes_code_value_arrayref {
+    my $string = shift or return;
+    $csv or $csv = Text::CSV->new({binary => 1});  # binary needed for non-ASCII Unicode
+    my $ok   = $csv->parse($string);  # parse field again to get subfields!
+    my @list = $csv->fields();
+    # TODO: error handling (check $ok)
+    return [
+        sort {&_sort_by_code($a,$b)}
+        map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ }
+        @list
+    ];
+    # nested map because of split
+}
+
+=head2 extended_attributes_merge
+
+=over 4
+
+    my $old_attributes = extended_attributes_code_value_arrayref("homeroom:224,grade:04,deanslist:2007,deanslist:2008,somedata:xxx");
+    my $new_attributes = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2009,extradata:foobar");
+    my $merged = extended_attributes_merge($patron_attributes, $new_attributes, 1);
+
+    # assuming deanslist is a repeatable code, value same as:
+    # $merged = extended_attributes_code_value_arrayref("homeroom:115,grade:05,deanslist:2007,deanslist:2008,deanslist:2009,extradata:foobar,somedata:xxx");
+
+=back
+
+Takes three arguments.  The first two are references to array of hashrefs, each like:
+ [ { code => 'CODE', value => 'value' }, { code => 'CODE2', value => 'othervalue' } ... ]
+
+The third option specifies whether repeatable codes are clobbered or collected.  True for non-clobber.
+
+Returns one reference to (merged) array of hashref.
+
+Caches results of C4::Members::AttributeTypes::GetAttributeTypes_hashref(1) for efficiency.
+
+=cut
+
+sub extended_attributes_merge {
+    my $old = shift or return;
+    my $new = shift or return $old;
+    my $keep = @_ ? shift : 0;
+    $AttributeTypes or $AttributeTypes = C4::Members::AttributeTypes::GetAttributeTypes_hashref(1);
+    my @merged = @$old;
+    foreach my $att (@$new) {
+        unless ($att->{code}) {
+            warn "Cannot merge element: no 'code' defined";
+            next;
+        }
+        unless ($AttributeTypes->{$att->{code}}) {
+            warn "Cannot merge element: unrecognized code = '$att->{code}'";
+            next;
+        }
+        unless ($AttributeTypes->{$att->{code}}->{repeatable} and $keep) {
+            @merged = grep {$att->{code} ne $_->{code}} @merged;    # filter out any existing attributes of the same code
+        }
+        push @merged, $att;
+    }
+    return [( sort {&_sort_by_code($a,$b)} @merged )];
+}
+
+sub _sort_by_code {
+    my ($x, $y) = @_;
+    defined ($x->{code}) or return -1;
+    defined ($y->{code}) or return 1;
+    return $x->{code} cmp $y->{code} || $x->{value} cmp $y->{value};
+}
+
 =head1 AUTHOR
 
 Koha Development Team <info at koha.org>
diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/import_borrowers.tmpl b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/import_borrowers.tmpl
index 47dc3a0..8d88ce6 100644
--- a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/import_borrowers.tmpl
+++ b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/import_borrowers.tmpl
@@ -114,12 +114,27 @@
     <!-- /TMPL_LOOP -->
 </ol></fieldset>
 	<fieldset class="rows">
-	<legend>If matching record is already in the borrowers table:</legend><ol><li class="radio">
-		 
-		<input type="radio" id="overwrite_cardnumberno" name="overwrite_cardnumber" value="0" checked="checked" /><label for="overwrite_cardnumberno">Ignore this one, keep the existing one</label></li>
-<li class="radio">
-			<input type="radio" id="overwrite_cardnumberyes" name="overwrite_cardnumber" value="1" /><label for="overwrite_cardnumberyes">Overwrite the existing one with this</label>
-	</li></ol></fieldset>
+	<legend>If matching record is already in the borrowers table:</legend>
+    <ol><li class="radio">
+        <input type="radio" id="overwrite_cardnumberno" name="overwrite_cardnumber" value="0" checked="checked" /><label for="overwrite_cardnumberno">Ignore this one, keep the existing one</label>
+        </li>
+        <li class="radio">
+		<input type="radio" id="overwrite_cardnumberyes" name="overwrite_cardnumber" value="1" /><label for="overwrite_cardnumberyes">Overwrite the existing one with this</label>
+        </li>
+    </ol>
+    </fieldset>
+    <!-- TMPL_IF NAME="ExtendedPatronAttributes" -->
+	<fieldset class="rows">
+	<legend>Extended Attributes</legend>
+    <ol><li class="radio">
+        <input type="radio" id="ext_preserve_0" name="ext_preserve" value="0" checked="checked" /><label for="ext_preserve_0">Replace all Extended Attributes</label>
+        </li>
+        <li class="radio">
+        <input type="radio" id="ext_preserve_1" name="ext_preserve" value="1" /><label for="ext_preserve_1">Replace only included Extended Attributes</label>
+        </li>
+    </ol>
+    </fieldset>
+    <!-- /TMPL_IF -->
 	<fieldset class="action"><input type="submit" value="Import" /></fieldset>
 </form>
 <!-- /TMPL_IF -->
diff --git a/t/Members_Attributes.t b/t/Members_Attributes.t
new file mode 100755
index 0000000..a60a988
--- /dev/null
+++ b/t/Members_Attributes.t
@@ -0,0 +1,110 @@
+#!/usr/bin/perl
+#
+#
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+
+BEGIN {
+    use_ok('C4::Members::Attributes', qw(:all));
+}
+
+INIT {
+    $C4::Members::Attributes::AttributeTypes = {
+          'grade' => {
+                       'opac_display' => '1',
+                       'staff_searchable' => '1',
+                       'description' => 'Grade level',
+                       'password_allowed' => '0',
+                       'authorised_value_category' => '',
+                       'repeatable' => '0',
+                       'code' => 'grade',
+                       'unique_id' => '0'
+                     },
+          'deanslist' => {
+                           'opac_display' => '0',
+                           'staff_searchable' => '1',
+                           'description' => 'Deans List (annual)',
+                           'password_allowed' => '0',
+                           'authorised_value_category' => '',
+                           'repeatable' => '1',
+                           'code' => 'deanslist',
+                           'unique_id' => '0'
+                         },
+          'somedata' => {
+                           'opac_display' => '0',
+                           'staff_searchable' => '0',
+                           'description' => 'Some Ext. Attribute',
+                           'password_allowed' => '0',
+                           'authorised_value_category' => '',
+                           'repeatable' => '0',
+                           'code' => 'somedata',
+                           'unique_id' => '0'
+                         },
+          'extradata' => {
+                           'opac_display' => '0',
+                           'staff_searchable' => '0',
+                           'description' => 'Another Ext. Attribute',
+                           'password_allowed' => '0',
+                           'authorised_value_category' => '',
+                           'repeatable' => '0',
+                           'code' => 'extradata',
+                           'unique_id' => '0'
+                         },
+          'school_id' => {
+                           'opac_display' => '1',
+                           'staff_searchable' => '1',
+                           'description' => 'School ID Number',
+                           'password_allowed' => '0',
+                           'authorised_value_category' => '',
+                           'repeatable' => '0',
+                           'code' => 'school_id',
+                           'unique_id' => '1'
+                         },
+          'homeroom' => {
+                          'opac_display' => '1',
+                          'staff_searchable' => '1',
+                          'description' => 'Homeroom',
+                          'password_allowed' => '0',
+                          'authorised_value_category' => '',
+                          'repeatable' => '0',
+                          'code' => 'homeroom',
+                          'unique_id' => '0'
+                        }
+    };  # This is important to prevent extended_attributes_merge from touching DB.
+}
+
+
+my @merge_tests = (
+    {
+        line1 => "homeroom:501",
+        line2 => "grade:01",
+        merge => "homeroom:501,grade:01",
+    },
+    {
+        line1 => "homeroom:224,grade:04,deanslist:2008,deanslist:2007,somedata:xxx",
+        line2 => "homeroom:115,grade:05,deanslist:2009,extradata:foobar",
+        merge => "homeroom:115,grade:05,deanslist:2008,deanslist:2007,deanslist:2009,extradata:foobar,somedata:xxx",
+    },
+);
+
+can_ok('C4::Members::Attributes', qw(extended_attributes_merge extended_attributes_code_value_arrayref));
+
+ok(ref($C4::Members::Attributes::AttributeTypes) eq 'HASH', '$C4::Members::Attributes::AttributeTypes is a hashref');
+
+diag scalar(@merge_tests) . " tests for extended_attributes_merge";
+
+foreach my $test (@merge_tests) {
+    my ($old, $new, $merged);
+    ok($old = extended_attributes_code_value_arrayref($test->{line1}), "extended_attributes_code_value_arrayref('$test->{line1}')");
+    foreach (@$old) { diag "old attribute: $_->{code} = $_->{value}"; }
+    ok($new = extended_attributes_code_value_arrayref($test->{line2}), "extended_attributes_code_value_arrayref('$test->{line2}')");
+    foreach (@$new) { diag "new attribute: $_->{code} = $_->{value}"; }
+    ok($merged = extended_attributes_merge($old, $new),                "extended_attributes_merge(\$old, \$new)");
+    foreach (@$merged) { diag "merge (overwrite) attribute: $_->{code} = $_->{value}"; }
+    ok($merged = extended_attributes_merge($old, $new, 1),             "extended_attributes_merge(\$old, \$new, 1)");
+    foreach (@$merged) { diag "merge (preserve) attribute: $_->{code} = $_->{value}"; }
+}
+
diff --git a/tools/import_borrowers.pl b/tools/import_borrowers.pl
index 0385275..f987fa3 100755
--- a/tools/import_borrowers.pl
+++ b/tools/import_borrowers.pl
@@ -42,7 +42,7 @@ use C4::Dates qw(format_date_in_iso);
 use C4::Context;
 use C4::Branch qw(GetBranchName);
 use C4::Members;
-use C4::Members::Attributes;
+use C4::Members::Attributes qw(:all);
 use C4::Members::AttributeTypes;
 use C4::Members::Messaging;
 
@@ -64,7 +64,7 @@ if ($extended) {
 my $columnkeystpl = [ map { {'key' => $_} }  grep {$_ ne 'borrowernumber' && $_ ne 'cardnumber'} @columnkeys ];  # ref. to array of hashrefs.
 
 my $input = CGI->new();
-my $csv   = Text::CSV->new({binary => 1});  # binary needed for non-ASCII Unicode
+our $csv  = Text::CSV->new({binary => 1});  # binary needed for non-ASCII Unicode
 # push @feedback, {feedback=>1, name=>'backend', value=>$csv->backend, backend=>$csv->backend};
 
 my ( $template, $loggedinuser, $cookie ) = get_template_and_user({
@@ -125,6 +125,7 @@ if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
         $csvkeycol{$keycol} = $col++;
     }
     #warn($borrowerline);
+    my $ext_preserve = $input->param('ext_preserve') || 0;
     if ($extended) {
         $matchpoint_attr_type = C4::Members::AttributeTypes->fetch($matchpoint);
     }
@@ -189,14 +190,10 @@ if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
             # The first 25 errors are enough.  Keeping track of 30,000+ would destroy performance.
             next LINE;
         }
-        my @attrs;
         if ($extended) {
             my $attr_str = $borrower{patron_attributes};
-            delete $borrower{patron_attributes};
-            my $ok = $csv->parse($attr_str);
-            my @list = $csv->fields();
-            # FIXME error handling
-            $patron_attributes = [ map { map { my @arr = split /:/, $_, 2; { code => $arr[0], value => $arr[1] } } $_ } @list ];
+            delete $borrower{patron_attributes};    # not really a field in borrowers, so we don't want to pass it to ModMember.
+            $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)) {
@@ -239,20 +236,24 @@ if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
                 next LINE;
             }
             $borrower{'borrowernumber'} = $borrowernumber;
-	    for my $col ( keys %borrower) {
-            # use values from extant patron unless our csv file includes this column or we provided a default.
-            # FIXME : You cannot update a field with a  perl-evaluated false value using the defaults.
-            unless(exists($csvkeycol{$col}) || $defaults{$col}) {
-                $borrower{$col} = $member->{$col} if($member->{$col}) ;
+            for my $col (keys %borrower) {
+                # use values from extant patron unless our csv file includes this column or we provided a default.
+                # FIXME : You cannot update a field with a  perl-evaluated false value using the defaults.
+                unless(exists($csvkeycol{$col}) || $defaults{$col}) {
+                    $borrower{$col} = $member->{$col} if($member->{$col}) ;
+                }
             }
-        }
             unless (ModMember(%borrower)) {
                 $invalid++;
                 $template->param('lastinvalid'=>$borrower{'surname'}.' / '.$borrowernumber);
                 next LINE;
             }
             if ($extended) {
-                C4::Members::Attributes::SetBorrowerAttributes($borrower{'borrowernumber'}, $patron_attributes);
+                if ($ext_preserve) {
+                    my $old_attributes = GetBorrowerAttributes($borrowernumber);
+                    $patron_attributes = extended_attributes_merge($old_attributes, $patron_attributes);  #TODO: expose repeatable options in template
+                }
+                SetBorrowerAttributes($borrower{'borrowernumber'}, $patron_attributes);
             }
             $overwritten++;
             $template->param('lastoverwritten'=>$borrower{'surname'}.' / '.$borrowernumber);
@@ -264,7 +265,7 @@ if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
             }
             if ($borrowernumber = AddMember(%borrower)) {
                 if ($extended) {
-                    C4::Members::Attributes::SetBorrowerAttributes($borrowernumber, $patron_attributes);
+                    SetBorrowerAttributes($borrowernumber, $patron_attributes);
                 }
                 if ($set_messaging_prefs) {
                     C4::Members::Messaging::SetMessagingPreferencesFromDefaults({ borrowernumber => $borrowernumber,
@@ -273,7 +274,7 @@ if ( $uploadborrowers && length($uploadborrowers) > 0 ) {
                 $imported++;
                 $template->param('lastimported'=>$borrower{'surname'}.' / '.$borrowernumber);
             } else {
-                $invalid++;		# was just "$invalid", I assume incrementing was the point --atz
+                $invalid++;
                 $template->param('lastinvalid'=>$borrower{'surname'}.' / AddMember');
             }
         }
-- 
1.5.6.5




More information about the Koha-patches mailing list