From bff2fad7796710ce9d3b4b234062b9c12e84ca1e Mon Sep 17 00:00:00 2001 From: Martin Stenberg Date: Mon, 26 Oct 2015 14:27:50 +0100 Subject: [PATCH] Bug 14957: Rule based permission for MARC fields This patch adds a rule based permission system for MARC field modifications. Test plan: 1. Apply this patch 2. Apply related database patch 2. Apply related scripts update patch 3. Run updatedatabase.pl 5. Log in to staff client 4. Enable new syspref MARCPermissions 5. You should see a new link "MARC field permissions" in the "Catalog" section under "Koha administrtion". 6. Go to the "MARC field permissions" page 7. Next to the page heading ("Manage MARC field permissions") there is a button with a question mark, click this for more information about the rule system. 8. Add desired rules to the rule table, press the +-button to add. 9. Clicking the pen-icon (edit) should allow you to edit corresponding rule. 10. Clicking the x-icon should remove corresponding rule after confirmation. 11. Selecting one or more rules followed by clicking the trash-icon should remove all selected rules after confirmation. 12. To test your rules, import or in other way modify a record. 13. Check that the record was modified as defined by your rules. Sponsored-by: Halland County Library --- C4/Biblio.pm | 1018 +++++++++++++++++++- admin/marc-permissions.pl | 123 +++ .../prog/en/modules/admin/admin-home.tt | 2 + .../prog/en/modules/admin/marc-permissions.tt | 485 ++++++++++ .../en/modules/admin/preferences/cataloguing.pref | 30 +- .../prog/en/modules/admin/preferences/logs.pref | 6 + t/db_dependent/Biblio/MARCPermissions.t | 284 ++++++ 7 files changed, 1906 insertions(+), 42 deletions(-) create mode 100755 admin/marc-permissions.pl create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-permissions.tt create mode 100755 t/db_dependent/Biblio/MARCPermissions.t diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 6d64e80..45412fd 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -28,6 +28,7 @@ use MARC::File::USMARC; use MARC::File::XML; use POSIX qw(strftime); use Module::Load::Conditional qw(can_load); +use String::Similarity; use C4::Koha; use C4::Log; # logaction @@ -105,6 +106,12 @@ BEGIN { &CountBiblioInOrders &GetSubscriptionsId &GetHolds + + &GetMarcPermissionsRules + &GetMarcPermissionsModules + &ModMarcPermissionsRule + &AddMarcPermissionsRule + &DelMarcPermissionsRule ); # To modify something @@ -133,6 +140,7 @@ BEGIN { # they are useful in a few circumstances, so they are exported, # but don't use them unless you are a core developer ;-) push @EXPORT, qw( + &ApplyMarcPermissions &ModBiblioMarc ); @@ -230,15 +238,27 @@ bib to add, while the second argument is the desired MARC framework code. This function also accepts a third, optional argument: a hashref -to additional options. The only defined option is C, -which if present and mapped to a true value, causes C -to omit the call to save the MARC in C -This option is provided B -for the use of scripts such as C that may need -to do some manipulation of the MARC record for item parsing before -saving it and which cannot afford the performance hit of saving -the MARC record twice. Consequently, do not use that option -unless you can guarantee that C will be called. +to additional options. Defined options are: + +C + + If present and mapped to a true value, causes C to omit the call + to save the MARC in C This + option is provided B for the use of scripts such as + C that may need to do some manipulation of the MARC + record for item parsing before saving it and which cannot afford the + performance hit of saving the MARC record twice. Consequently, do not use + that option unless you can guarantee that C will be called. + +C + + Optional hashref defining permission filters from the + marc_permissions_modules table in form of {module => filter}. Three + predefined filter modules exists: + + * source + * category + * borrower =cut @@ -271,7 +291,7 @@ sub AddBiblio { _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode ); # now add the record - ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save; + ModBiblioMarc( $record, $biblionumber, $frameworkcode, $options->{filter} ) unless $defer_marc_save; # update OAI-PMH sets if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) { @@ -300,12 +320,21 @@ in the C and C tables, as well as which fields are used to store embedded item, biblioitem, and biblionumber data for indexing. +This function also accepts a forth, optional argument: a hashref defining +permission filters from the marc_permissions_modules table in form of +{module => filter}. Three predefined filter modules exists: + + * source + * category + * borrower + Returns 1 on success 0 on failure =cut sub ModBiblio { - my ( $record, $biblionumber, $frameworkcode ) = @_; + my ( $record, $biblionumber, $frameworkcode, $filter ) = @_; + if (!$record) { carp 'No record passed to ModBiblio'; return 0; @@ -343,13 +372,13 @@ sub ModBiblio { _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber ); # load the koha-table data object - my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode ); + my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode, undef, $biblionumber, $filter ); # update MARC subfield that stores biblioitems.cn_sort _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode ); # update the MARC record (that now contains biblio and items) with the new record data - &ModBiblioMarc( $record, $biblionumber, $frameworkcode ); + &ModBiblioMarc( $record, $biblionumber, $frameworkcode, $filter); # modify the other koha tables _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); @@ -2677,7 +2706,7 @@ sub TransformHtmlToMarc { =head2 TransformMarcToKoha - $result = TransformMarcToKoha( $record, $frameworkcode ) + $result = TransformMarcToKoha( $record, $frameworkcode, $biblionumber, $filter ) Extract data from a MARC bib record into a hashref representing Koha biblio, biblioitems, and items fields. @@ -2688,7 +2717,7 @@ hash_ref =cut sub TransformMarcToKoha { - my ( $record, $frameworkcode, $limit_table ) = @_; + my ( $record, $frameworkcode, $limit_table, $biblionumber, $filter ) = @_; my $result = {}; if (!defined $record) { @@ -2709,6 +2738,17 @@ sub TransformMarcToKoha { $tables{'biblioitems'} = 1; } + # apply permissions + if ( C4::Context->preference('MARCPermissions') && $biblionumber && $filter) { + $record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $record, + frameworkcode => $frameworkcode, + filter => $filter, + nolog => 1 + }); + } + # traverse through record MARCFIELD: foreach my $field ( $record->fields() ) { my $tag = $field->tag(); @@ -3004,10 +3044,10 @@ sub ModZebra { # replaced by a zebraqueue table, that is filled with ModZebra to run. # the table is emptied by rebuild_zebra.pl script (using the -z switch) my $check_sql = "SELECT COUNT(*) FROM zebraqueue - WHERE server = ? - AND biblio_auth_number = ? - AND operation = ? - AND done = 0"; + WHERE server = ? + AND biblio_auth_number = ? + AND operation = ? + AND done = 0"; my $check_sth = $dbh->prepare_cached($check_sql); $check_sth->execute( $server, $biblionumber, $op ); my ($count) = $check_sth->fetchrow_array; @@ -3466,7 +3506,7 @@ sub _koha_delete_biblioitems { =head2 ModBiblioMarc - &ModBiblioMarc($newrec,$biblionumber,$frameworkcode); + &ModBiblioMarc($newrec,$biblionumber,$frameworkcode,$filter); Add MARC XML data for a biblio to koha @@ -3477,7 +3517,8 @@ Function exported, but should NOT be used, unless you really know what you're do sub ModBiblioMarc { # pass the MARC::Record to this function, and it will create the records in # the marcxml field - my ( $record, $biblionumber, $frameworkcode ) = @_; + my ( $record, $biblionumber, $frameworkcode, $filter ) = @_; + if ( !$record ) { carp 'ModBiblioMarc passed an undefined record'; return; @@ -3523,6 +3564,16 @@ sub ModBiblioMarc { $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005; } + # apply permissions + if ( C4::Context->preference('MARCPermissions') ) { + $record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $record, + frameworkcode => $frameworkcode, + filter => $filter + }); + } + $sth = $dbh->prepare("UPDATE biblioitems SET marcxml=? WHERE biblionumber=?"); $sth->execute( $record->as_xml_record($encoding), $biblionumber ); $sth->finish; @@ -3819,6 +3870,931 @@ sub RemoveAllNsb { return $record; } +=head2 ApplyMarcPermissions + + my $record = ApplyMarcPermissions($arguments) + +Applies marc permission rules to a record. + +C<$arguments> is expected to be a hashref with below keys defined. + +=over 4 + +=item C +biblionumber of old record + +=item C +record that will modify old record + +=item C +only tags included in framework will be processed + +=item C +hashref containing at least one filter module from the marc_permissions_modules +table in form {module => filter}. Three predefined filter modules exists: + + * source + * category + * borrower + +=item C +optional reference to array that will be filled with rule evaluation log +entries. + +=item C +optional boolean which when true disables logging to action log. + +=back + +Returns: + +=over 4 + +=item C<$record> + +new MARC record based on C with C applied. If no old +record for C can be found, C is returned unchanged. +Default action when no matching filter found is to leave old record unchanged. + +=back + +=cut + +sub ApplyMarcPermissions { + my $arguments = shift; + my $biblionumber = $arguments->{biblionumber}; + my $new_record = $arguments->{record}; + my $frameworkcode = $arguments->{frameworkcode} || ''; + + if ( !$biblionumber ) { + carp 'ApplyMarcPermissions called on undefined biblionumber'; + return; + } + if ( !$new_record ) { + carp 'ApplyMarcPermissions called on undefined record'; + return; + } + my $filter = $arguments->{filter} + or return $new_record; + + my $log = $arguments->{log} || []; + my $nolog = $arguments->{nolog}; + + my $dbh = C4::Context->dbh; + + my $is_regex = sub { + my ( $tag, $m ) = @_; + # tag is not exactly same as possible regex + $tag ne $m && + + # wildcard + $m ne '*' && + + # valid tagDataType + $m !~ /^(0[1-9A-z][\dA-Z]) | + ([1-9A-z][\dA-z]{2})$/x && + + # nor valid controltagDataType + $m !~ /00[1-9A-Za-z]{1}/ && + + # so we try it as a regex + $tag =~ /^$m$/ + }; + + my $old_record = GetMarcBiblio($biblionumber); + if ( $old_record ) { + my $ret_record = MARC::Record->new(); + my $perm = GetMarcPermissions() or return $new_record; + my $marc_struct = GetMarcStructure(1, $frameworkcode); + my $similarity_pref = C4::Context->preference("MARCPermissionsCorrectionSimilarity"); + $similarity_pref = defined $similarity_pref && + $similarity_pref >= 0 && + $similarity_pref <= 100 ? + $similarity_pref/100.0 : undef; + + # First came the leader ... + $ret_record->leader($old_record->leader()); + + # ... and then came all the tags in the framework + for my $tag (sort keys %{$marc_struct}) { + my @old_fields = $old_record->field($tag); + my @new_fields = $new_record->field($tag); + next unless @old_fields or @new_fields; + + my @perms = ( + $perm->{'*'}, + ( # regex tags + map { $perm->{$_} } + grep { $is_regex->( $tag, $_ ) } sort keys %{$perm} + ), + $perm->{$tag} + ); + + # There can be more than one field for each tag, so we have to + # iterate all fields and distinguish which are new, removed or + # modified + my $max_fields = ($#old_fields, $#new_fields) + [$#old_fields< $#new_fields]; + for ( my $i_field = 0; $i_field <= $max_fields; $i_field++ ) { + my $old_field = $old_fields[$i_field]; + my $new_field = $new_fields[$i_field]; + + # Existing field + if ( $old_field and $new_field ) { + # Control fields + if ( $old_field->is_control_field() ) { + # Existing control field + if ( $old_field and $new_field ) { + my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @perms); + if ( defined $on_existing->{action} ) { + push @{$log}, + { + rule => $on_existing->{rule}, + event => "existing", + action => $on_existing->{action}, + tag => $tag, + subfieldcode => undef, + filter => $filter + }; + if ( $on_existing->{action} eq 'skip' ) { + $ret_record->insert_fields_ordered($old_field); + next; + } elsif ( $on_existing->{action} eq 'overwrite' ) { + $ret_record->insert_fields_ordered($new_field); + next; + } elsif ( $on_existing->{action} eq 'add' ) { + $ret_record->insert_fields_ordered($old_field); + $ret_record->insert_fields_ordered($new_field); + next; + } elsif ( $on_existing->{action} eq 'add_or_correct' ) { + if ( $similarity_pref ) { + my $similarity = similarity $old_field->data(), $new_field->data(); + if ( $similarity >= $similarity_pref ) { + $ret_record->insert_fields_ordered($new_field); + } else { + $ret_record->insert_fields_ordered($old_field); + $ret_record->insert_fields_ordered($new_field); + } + } else { + $ret_record->insert_fields_ordered($old_field); + } + } + } else { # default to skip + $ret_record->insert_fields_ordered($old_field); + next; + } + # New control field + } elsif ( not $old_field and $new_field ) { + my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms); + if ( defined $on_new->{action} ) { + push @{$log}, + { + rule => $on_new->{rule}, + event => "new", + action => $on_new->{action}, + tag => $tag, + subfieldcode => undef, + filter => $filter + }; + if ( $on_new->{action} eq 'skip' ) { + next; + } elsif ( $on_new->{action} eq 'add' ) { + $ret_record->insert_fields_ordered($new_field); + next; + } + } + # Removed control field + } elsif ( $old_field and not $new_field ) { + my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms); + if ( defined $on_removed->{action} ) { + push @{$log}, + { + rule => $on_removed->{rule}, + event => "removed", + action => $on_removed->{action}, + tag => $tag, + subfieldcode => undef + }; + if ( $on_removed->{action} eq 'skip' ) { + $ret_record->insert_fields_ordered($old_field); + next; + } elsif ( $on_removed->{action} eq 'remove' ) { + next; + } + } else { # default to skip + $ret_record->insert_fields_ordered($old_field); + next; + } + } + # Indicators and subfields + } else { + # Indicators + my @old_ind = map { $old_field->indicator($_) } (1,2); + my @new_ind = map { $new_field->indicator($_) } (1,2); + my @ind = ('',''); + + for my $i ((0,1)) { + my @ind_perms = ( + @perms, + $perm->{$tag}->{subfields}->{ 'i' . ( $i + 1 ) } + ); + + # Existing indicator + if ( defined $old_ind[$i] and defined $new_ind[$i] ) { + my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @ind_perms); + if ( defined $on_existing->{action} ) { + push @{$log}, + { + rule => $on_existing->{rule}, + event => "existing", + action => $on_existing->{action}, + tag => $tag, + subfieldcode => 'i' . ( $i + 1 ), + filter => $filter + }; + if ( $on_existing->{action} eq 'skip' ) { + $ind[$i] = $old_ind[$i]; + } elsif ( $on_existing->{action} eq 'overwrite' ) { + $ind[$i] = $new_ind[$i]; + } + } else { # default to skip + $ind[$i] = $old_ind[$i]; + } + # New indicator + } elsif ( not defined $old_ind[$i] and defined $new_ind[$i] ) { + my $on_new = GetMarcPermissionsAction('on_new', $filter, @ind_perms); + if ( defined $on_new->{action} ) { + push @{$log}, + { + rule => $on_new->{rule}, + event => "new", + action => $on_new->{action}, + tag => $tag, + subfieldcode => 'i' . ( $i + 1 ), + filter => $filter + }; + if ( $on_new->{action} eq 'skip' ) { + $ind[$i] = $old_ind[$i]; + } elsif ( $on_new->{action} eq 'add' ) { + $ind[$i] = $new_ind[$i]; + } + } + # Removed indicator + } elsif ( defined $old_ind[$i] and not defined $new_ind[$i] ) { + my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @ind_perms); + if ( defined $on_removed->{action} ) { + push @{$log}, + { + rule => $on_removed->{rule}, + event => "removed", + action => $on_removed->{action}, + tag => $tag, + subfieldcode => 'i' . ( $i + 1 ), + filter => $filter + }; + if ( $on_removed->{action} eq 'skip' ) { + $ind[$i] = $old_ind[$i]; + } elsif ( $on_removed->{action} eq 'remove' ) { + $ind[$i] = ''; + } + } else { # default to skip + $ind[$i] = $old_ind[$i]; + } + } + } + + # Subfields + my @subfields = (); + my %proccessed_subcodes = (); + + # Try to preserve subfield order by first processing + # subfields from the old record, and then subfields from + # the framework structure unless include in old record. + my @sorted_subfields = ( + map { shift @{$_} } $old_field->subfields(), + () = sort keys %{ $marc_struct->{$tag} } + ); + for my $subcode ( @sorted_subfields ) { + next if $proccessed_subcodes{$subcode}; + $proccessed_subcodes{$subcode} = 1; + next unless ref $marc_struct->{$tag}{$subcode} eq 'HASH'; + my @old_subfields = $old_field->subfield($subcode); + my @new_subfields = $new_field->subfield($subcode); + next unless @old_subfields or @new_subfields; + + my @subfield_perms = ( + @perms, + $perm->{'*'}->{subfields}->{'*'}, + $perm->{$tag}->{subfields}->{'*'}, + ( # tag->regex + map { $perm->{$tag}->{subfields}->{$_} } + grep { + # subcode is not exactly same as + # possible regex + $subcode ne $_ && + + # wildcard, not checking for valid + # subfieldcodeDataType since it + # contains too many regex characters + $_ !~ /^(\*)$/ && + + # so we try it as a regex + $subcode =~ /$_/ + } sort + keys %{ $perm->{$tag}->{subfields} } + ), + ( # regex->* + map { $perm->{$_}->{subfields}->{'*'} } + grep { $is_regex->( $tag, $_ ) } + sort keys %{$perm} + ), + $perm->{'*'}->{subfields}->{$subcode}, + ( # regex->subcode + map { $perm->{$_}->{subfields}->{$subcode} } + grep { $is_regex->( $tag, $_ ) } + sort keys %{$perm} + ), + $perm->{$tag}->{subfields}->{$subcode} + ); + + # Existing subfield + if ( @old_subfields and @new_subfields ) { + my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @subfield_perms); + if ( defined $on_existing->{action} ) { + push @{$log}, + { + rule => $on_existing->{rule}, + event => "existing", + action => $on_existing->{action}, + tag => $tag, + subfieldcode => $subcode, + filter => $filter + }; + if ( $on_existing->{action} eq 'skip' ) { + push(@subfields, map {($subcode,$_)} @old_subfields); + next; + } elsif ( $on_existing->{action} eq 'overwrite' ) { + push(@subfields, map {($subcode,$_)} @new_subfields); + next; + } elsif ( $on_existing->{action} eq 'add' ) { + push(@subfields, map {($subcode,$_)} @old_subfields); + push(@subfields, map {($subcode,$_)} @new_subfields); + next; + } elsif ( $on_existing->{action} eq 'add_or_correct' ) { + if ( $similarity_pref ) { + my @corrected_vals = (); + + # correct all old subfields + for ( my $i_new = 0; $i_new <= $#new_subfields; $i_new++ ) { + my $new_val = $new_subfields[$i_new]; + for ( my $i_old = 0; $i_old <= $#old_subfields; $i_old++ ) { + my $old_val = $old_subfields[$i_old]; + next if not defined $old_val or not defined $new_val; + my $similarity = similarity $old_val, $new_val; + if ( $similarity >= $similarity_pref ) { + $corrected_vals[$i_old] = $new_val; + $new_subfields[$i_new] = undef; + $old_subfields[$i_old] = undef; + last; + } + } + } + + # insert all unchanged old subfields + map { + $corrected_vals[$_] = $old_subfields[$_] + if defined $old_subfields[$_] + } 0 .. $#old_subfields; + + + # append all remaning new subfields + map {push @corrected_vals, $_ if defined} @new_subfields; + + push(@subfields, map {($subcode,$_)} @corrected_vals); + } else { + push(@subfields, map {($subcode,$_)} @old_subfields); + } + } + } else { # default to skip + push(@subfields, map {($subcode,$_)} @old_subfields); + next; + } + # New subfield + } elsif ( not @old_subfields and @new_subfields ) { + my $on_new = GetMarcPermissionsAction('on_new', $filter, @subfield_perms); + if ( defined $on_new->{action} ) { + push @{$log}, + { + rule => $on_new->{rule}, + event => "new", + action => $on_new->{action}, + tag => $tag, + subfieldcode => $subcode, + filter => $filter + }; + if ( $on_new->{action} eq 'skip' ) { + next; + } elsif ( $on_new->{action} eq 'add' ) { + push(@subfields, map {($subcode,$_)} @new_subfields); + next; + } + } + # Removed subfield + } elsif ( @old_subfields and not @new_subfields ) { + my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @subfield_perms); + if ( defined $on_removed->{action} ) { + push @{$log}, + { + rule => $on_removed->{rule}, + event => "removed", + action => $on_removed->{action}, + tag => $tag, + subfieldcode => $subcode, + filter => $filter + }; + if ( $on_removed->{action} eq 'skip' ) { + push(@subfields, ($subcode => @old_subfields)); + next; + } elsif ( $on_removed->{action} eq 'remove' ) { + next; + } + } else { # default to skip + push(@subfields, ($subcode => @old_subfields)); + next; + } + } + } # / for each subfield + $ret_record->insert_grouped_field(MARC::Field->new($tag, $ind[0], $ind[1], @subfields)); + } + # New field + } elsif ( not $old_field and $new_field ) { + my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms); + if ( defined $on_new->{action} ) { + push @{$log}, + { + rule => $on_new->{rule}, + event => "new", + action => $on_new->{action}, + tag => $tag, + subfieldcode => undef, + filter => $filter + }; + if ( $on_new->{action} eq 'skip' ) { + next; + } elsif ( $on_new->{action} eq 'add' ) { + $ret_record->insert_fields_ordered($new_field); + next; + } + } + # Removed field + } elsif ( $old_field and not $new_field ) { + my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms); + if ( defined $on_removed->{action} ) { + push @{$log}, + { + rule => $on_removed->{rule}, + event => "removed", + action => $on_removed->{action}, + tag => $tag, + subfieldcode => undef, + filter => $filter + }; + if ( $on_removed->{action} eq 'skip' ) { + $ret_record->insert_grouped_field($old_field); + next; + } elsif ( $on_removed->{action} eq 'remove' ) { + next; + } + } else { # default to skip + $ret_record->insert_grouped_field($old_field); + next; + } + } + } # / for each field + } # / for each tag + if ( !$nolog && C4::Context->preference("MARCPermissionsLog") ) { + my $log_str = ''; + my $n = $#{$log}; + for my $l ( @{$log} ) { + $log_str .= "{\n"; + my $kn = keys %{$l}; + for my $k ( sort keys %{$l} ) { + if ( $k eq 'filter' ) { + $log_str .= " filter => {\n"; + my $fkn = keys %{ $l->{$k} }; + for my $fk ( sort keys %{ $l->{$k} } ) { + $log_str .= ' ' + . $fk . ' => ' + . $l->{$k}->{$fk} + . ( --$fkn ? ',' : '' ) . "\n"; + } + $log_str .= " }" . ( --$kn ? ',' : '' ) . "\n"; + } + else { + $log_str .= ' ' + . $k . ' => ' + . $l->{$k} + . ( --$kn ? ',' : '' ) . "\n" + if defined $l->{$k}; + } + } + $log_str .= '}' . ( $n-- ? ",\n" : '' ); + } + logaction( "CATALOGUING", "MODIFY", $biblionumber, $log_str ); + } + return $ret_record; + } + return $new_record; +} + + +=head2 GetMarcPermissions + + my $marc_permissions = GetMarcPermissions() + +Loads MARC field permissions from the marc_permissions table. + +Returns: + +=over 4 + +=item C<$marc_permissions> + +hashref with permissions structure for use with GetMarcPermissionsAction. + +=back + +=cut + +sub GetMarcPermissions { + my $dbh = C4::Context->dbh; + my $rule_count = 0; + my %perms = (); + + my $query = ' + SELECT `marc_permissions`.*, + `marc_permissions_modules`.`name`, + `marc_permissions_modules`.`description`, + `marc_permissions_modules`.`specificity` + FROM `marc_permissions` + LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` + ORDER BY `marc_permissions_modules`.`specificity`, `id` + '; + my $sth = $dbh->prepare($query); + $sth->execute(); + while ( my $row = $sth->fetchrow_hashref ) { + $rule_count++; + if ( defined $row->{tagsubfield} and $row->{tagsubfield} ) { + $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} } + ->{on_existing}->{ $row->{name} }->{ $row->{filter} } = + { action => $row->{on_existing}, rule => $row->{'id'} }; + $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} } + ->{on_new}->{ $row->{name} }->{ $row->{filter} } = + { action => $row->{on_new}, rule => $row->{'id'} }; + $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} } + ->{on_removed}->{ $row->{name} }->{ $row->{filter} } = + { action => $row->{on_removed}, rule => $row->{'id'} }; + } + else { + $perms{ $row->{tagfield} }->{on_existing}->{ $row->{name} } + ->{ $row->{filter} } = + { action => $row->{on_existing}, rule => $row->{'id'} }; + $perms{ $row->{tagfield} }->{on_new}->{ $row->{name} } + ->{ $row->{filter} } = + { action => $row->{on_new}, rule => $row->{'id'} }; + $perms{ $row->{tagfield} }->{on_removed}->{ $row->{name} } + ->{ $row->{filter} } = + { action => $row->{on_removed}, rule => $row->{'id'} }; + } + } + + return unless $rule_count; + return \%perms; +} + +=head2 GetMarcPermissionsAction + + my $action = GetMarcPermissionsAction($event, $filter, @permissions) + +Gets action based on C<$event>, C<$filter> and C<@permissions>. + +=over 4 + +=item C<$event> + +which event: 'on_existing', 'on_new' or 'on_removed' + +=item C<$filter> + +hashref containing at least one filter module from the marc_permissions_modules +table in form {module => filter}. Three predefined filter modules exists: + + * source + * category + * borrower + +=item C<@permissions> + +list of permission structures in order of specificity from least to most +specific. + +=back + +Returns: + +=over 4 + +=item C<$action> + +hashref defining matching action. + +=back + +=cut + +sub GetMarcPermissionsAction { + my $what = shift or return; + my $filter = shift or return; + my @perms = @_; + + my $modules = GetMarcPermissionsModules(); + + my $action = undef; + for my $perm (@perms) { + next if not defined $perm; + next if not defined $perm->{$what}; + my $tmp_action = undef; + + for my $module ( @{$modules} ) { + if (defined $perm->{$what}->{ $module->{'name'} } + and + defined $perm->{$what}->{ $module->{'name'} }->{'*'}->{action} ) + { + $tmp_action = $perm->{$what}->{ $module->{'name'} }->{'*'}; + } + if ( defined $filter->{ $module->{'name'} } + and defined $perm->{$what}->{ $module->{'name'} } + and defined $perm->{$what}->{ $module->{'name'} } + ->{ $filter->{ $module->{'name'} } }->{action} ) + { + $tmp_action = $perm->{$what}->{ $module->{'name'} } + ->{ $filter->{ $module->{'name'} } }; + } + } + + $action = $tmp_action if defined $tmp_action; + } + + return $action; +} + +=head2 GetMarcPermissionsRules + + my $rules = GetMarcPermissionsRules() + +Returns: + +=over 4 + +=item C<$rules> + +array (in list context, arrayref otherwise) of hashrefs from marc_permissions +table in order of module specificity and rule id. + +=back + +=cut + +sub GetMarcPermissionsRules { + my $dbh = C4::Context->dbh; + my @rules = (); + + my $query = ' + SELECT `marc_permissions`.`id`, + `marc_permissions`.`tagfield`, + `marc_permissions`.`tagsubfield`, + `marc_permissions`.`filter`, + `marc_permissions`.`on_existing`, + `marc_permissions`.`on_new`, + `marc_permissions`.`on_removed`, + `marc_permissions_modules`.`name` as `module`, + `marc_permissions_modules`.`description`, + `marc_permissions_modules`.`specificity` + FROM `marc_permissions` + LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` + ORDER BY `marc_permissions_modules`.`specificity`, `id` + '; + my $sth = $dbh->prepare($query); + $sth->execute(); + while ( my $row = $sth->fetchrow_hashref ) { + push(@rules, $row); + } + + return wantarray ? @rules : \@rules; +} + +=head2 GetMarcPermissionsModules + + my $modules = GetMarcPermissionsModules() + +Returns: + +=over 4 + +=item C<$modules> + +array (in list context, arrayref otherwise) of hashrefs from +marc_permissions_modules table in order of specificity. + +=back + +=cut + +sub GetMarcPermissionsModules { + my $dbh = C4::Context->dbh; + my @modules = (); + + my $query = ' + SELECT * + FROM `marc_permissions_modules` + ORDER BY `specificity` + '; + my $sth = $dbh->prepare($query); + $sth->execute(); + while ( my $row = $sth->fetchrow_hashref ) { + push(@modules, $row); + } + + return wantarray ? @modules : \@modules; +} + +=head2 ModMarcPermissionsRule + + my $success = ModMarcPermissionsRule($id, $fields) + +Modifies rule in the marc_permissions table. + +=over 4 + +=item C<$id> + +rule id to modify + +=item C<$fields> + +hashref defining the table fields + + * tagfield - required + * tagsubfield + * module - required + * filter - required + * on_existing - required + * on_new - required + * on_removed - required + +=back + +Returns: + +=over 4 + +=item C<$success> + +undef if an error occurs, otherwise true. + +=back + +=cut + +sub ModMarcPermissionsRule { + my ($id, $f) = @_; + my $dbh = C4::Context->dbh; + my $query = ' + UPDATE `marc_permissions` + SET + tagfield = ?, + tagsubfield = ?, + module = ?, + filter = ?, + on_existing = ?, + on_new = ?, + on_removed = ? + WHERE + id = ? + '; + my $sth = $dbh->prepare($query); + return $sth->execute ( + $f->{tagfield}, + $f->{tagsubfield}, + $f->{module}, + $f->{filter}, + $f->{on_existing}, + $f->{on_new}, + $f->{on_removed}, + $id + ); +} + +=head2 AddMarcPermissionsRule + + my $success = AddMarcPermissionsRule($fields) + +Add rule to the marc_permissions table. + +=over 4 + +=item C<$fields> + +hashref defining the table fields + + tagfield - required + tagsubfield + module - required + filter - required + on_existing - required + on_new - required + on_removed - required + +=back + +Returns: + +=over 4 + +=item C<$success> + +undef if an error occurs, otherwise true. + +=back + +=cut + +sub AddMarcPermissionsRule { + my $f = shift; + my $dbh = C4::Context->dbh; + my $query = ' + INSERT INTO `marc_permissions` + ( + tagfield, + tagsubfield, + module, + filter, + on_existing, + on_new, + on_removed + ) + VALUES (?, ?, ?, ?, ?, ?, ?) + '; + my $sth = $dbh->prepare($query); + return $sth->execute ( + $f->{tagfield}, + $f->{tagsubfield}, + $f->{module}, + $f->{filter}, + $f->{on_existing}, + $f->{on_new}, + $f->{on_removed} + ); +} + +=head2 DelMarcPermissionsRule + + my $success = DelMarcPermissionsRule($id) + +Deletes rule from the marc_permissions table. + +=over 4 + +=item C<$id> + +rule id to delete + +=back + +Returns: + +=over 4 + +=item C<$success> + +undef if an error occurs, otherwise true. + +=back + +=cut + +sub DelMarcPermissionsRule { + my $id = shift; + my $dbh = C4::Context->dbh; + my $query = ' + DELETE FROM `marc_permissions` + WHERE + id = ? + '; + my $sth = $dbh->prepare($query); + return $sth->execute($id); +} + 1; diff --git a/admin/marc-permissions.pl b/admin/marc-permissions.pl new file mode 100755 index 0000000..03999cb --- /dev/null +++ b/admin/marc-permissions.pl @@ -0,0 +1,123 @@ +#!/usr/bin/perl + +# 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 strict; +use warnings; + +# standard or CPAN modules used +use CGI qw ( -utf8 ); +use CGI::Cookie; +use MARC::File::USMARC; + +# Koha modules used +use C4::Context; +use C4::Koha; +use C4::Auth; +use C4::AuthoritiesMarc; +use C4::Output; +use C4::Biblio; +use C4::ImportBatch; +use C4::Matcher; +use C4::BackgroundJob; +use C4::Labels::Batch; + +my $script_name = "/cgi-bin/koha/admin/marc-permissions.pl"; + +my $input = new CGI; +my $op = $input->param('op') || ''; + +my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => "admin/marc-permissions.tt", + query => $input, + type => "intranet", + authnotrequired => 0, + flagsrequired => { parameters => 'parameters_remaining_permissions' }, + debug => 1, + } +); + +my %cookies = parse CGI::Cookie($cookie); +our $sessionID = $cookies{'CGISESSID'}->value; + +my $rules; +if ( $op eq "remove" ) { + $template->{VARS}->{removeConfirm} = 1; + my @removeIDs = $input->multi_param('batchremove'); + push( @removeIDs, scalar $input->param('id') ) if $input->param('id'); + + $rules = GetMarcPermissionsRules(); + for my $removeID (@removeIDs) { + map { $_->{'remove'} = 1 if $_->{'id'} == $removeID } @{$rules}; + } + +} +elsif ( $op eq "doremove" ) { + my @removeIDs = $input->multi_param('batchremove'); + push( @removeIDs, scalar $input->param('id') ) if $input->param('id'); + for my $removeID (@removeIDs) { + DelMarcPermissionsRule($removeID); + } + + $rules = GetMarcPermissionsRules(); + +} +elsif ( $op eq "edit" ) { + $template->{VARS}->{edit} = 1; + my $id = $input->param('id'); + $rules = GetMarcPermissionsRules(); + map { $_->{'edit'} = 1 if $_->{'id'} == $id } @{$rules}; + +} +elsif ( $op eq "doedit" ) { + my $id = $input->param('id'); + my $fields = { + module => scalar $input->param('module'), + tagfield => scalar $input->param('tagfield'), + tagsubfield => scalar $input->param('tagsubfield'), + filter => scalar $input->param('filter'), + on_existing => scalar $input->param('on_existing'), + on_new => scalar $input->param('on_new'), + on_removed => scalar $input->param('on_removed') + }; + + ModMarcPermissionsRule( $id, $fields ); + $rules = GetMarcPermissionsRules(); + +} +elsif ( $op eq "add" ) { + my $fields = { + module => scalar $input->param('module'), + tagfield => scalar $input->param('tagfield'), + tagsubfield => scalar $input->param('tagsubfield'), + filter => scalar $input->param('filter'), + on_existing => scalar $input->param('on_existing'), + on_new => scalar $input->param('on_new'), + on_removed => scalar $input->param('on_removed') + }; + + AddMarcPermissionsRule($fields); + $rules = GetMarcPermissionsRules(); + +} +else { + $rules = GetMarcPermissionsRules(); +} +my $modules = GetMarcPermissionsModules(); +$template->param( rules => $rules, modules => $modules ); + +output_html_with_http_headers $input, $cookie, $template->output; diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt index 6c128d6..af778dd 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt @@ -89,6 +89,8 @@
Search engine configuration
Manage indexes, facets, and their mappings to MARC fields and subfields.
[% END %] +
MARC field permissions
+
Managed MARC field permissions

Acquisition parameters

diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-permissions.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-permissions.tt new file mode 100644 index 0000000..964d517 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-permissions.tt @@ -0,0 +1,485 @@ +[% USE Koha %] +[% INCLUDE 'doc-head-open.inc' %] +Koha › Administration › MARC field permissions +[% INCLUDE 'doc-head-close.inc' %] + +[% INCLUDE 'datatables.inc' %] + + + + + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'cat-search.inc' %] + + + +
+
+
+
+ +

Manage MARC field permissions

+[% UNLESS Koha.Preference( 'MARCPermissions' ) %] +
+The MARCPermissions preference is not set, don't forget to enable it for rules to take effect. +
+[% END %] + + +[% IF removeConfirm %] +
+

Remove rule?

+

Are you sure you want to remove the selected rule(s)?

+ +
+ +
+ +
+[% END %] + +
+ + + + + + + + + + + + + + [% UNLESS edit %] + + + + + + + + + + + + + + + [% END %] + + [% FOREACH rule IN rules %] + + [% IF rule.edit %] + + + + + + + + + + + [% ELSE %] + + + + + + + + + + + [% END %] + + [% END %] + +
RuleTagSubfield tagModuleFilterOn ExistingOn NewOn Removed  
  + + + + + + + +
[% rule.id %] + + + + + + + + + + + [% rule.id %][% rule.tagfield %][% rule.tagsubfield%][% rule.module %][% rule.filter %][% rule.on_existing %][% rule.on_new %][% rule.on_removed %] + + + + [% IF rule.remove %] + + [% ELSE %] + + [% END %] +
+
+ +
+ +
+ +
+
+
+[% INCLUDE 'admin-menu.inc' %] +
+
+[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref index 1aeadf9..5fe2090 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref @@ -234,24 +234,12 @@ Cataloging: Exporting: - - - Include following fields when exporting BibTeX, - - pref: BibtexExportAdditionalFields - type: textarea - - "Use one line per tag in the format BT_TAG: TAG$SUBFIELD ( e.g. lccn: 010$a )" - - "
" - - "To specificy multiple marc tags/subfields as targets for a repeating BibTex tag, use the following format: BT_TAG: [TAG2$SUBFIELD1, TAG2$SUBFIELD2] ( e.g. notes: [501$a, 505$g] )" - - "
" - - "All values of repeating tags and subfields will be printed with the given BibTeX tag." - - "
" - - "Use '@' ( with quotes ) as the BT_TAG to replace the bibtex record type with a field value of your choosing." - - - - Include following fields when exporting RIS, - - pref: RisExportAdditionalFields - type: textarea - - "Use one line per tag in the format RIS_TAG: TAG$SUBFIELD ( e.g. LC: 010$a )" - - "
" - - "To specificy multiple marc tags/subfields as targets for a repeating RIS tag, use the following format: RIS_TAG: [TAG2$SUBFIELD1, TAG2$SUBFIELD2] ( e.g. NT: [501$a, 505$g] )" - - "
" - - "All values of repeating tags and subfields will be printed with the given RIS tag." - - "
" - - "Use of TY ( record type ) as a key will replace the default TY with the field value of your choosing." + - When importing records + - pref: MARCPermissions + choices: + yes: "use" + no: "don't use" + - MARC permissions rules to decide which action to take for each field. + - When add_or_correct, consider a field modification to be a correction if the old and new value has a similarity of + - pref: MARCPermissionsCorrectionSimilarity + - %. If similarity falls below this value, the new value will be treated as a new field. diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/logs.pref b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/logs.pref index 4aa5790..aa47f7a 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/logs.pref +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/logs.pref @@ -66,6 +66,12 @@ Logging: on: Log off: "Don't log" - when reports are added, deleted or changed. + - + - pref: MARCPermissionsLog + choices: + on: Log + off: "Don't log" + - MARC permissions rule evaluations when applying rules for MARC field modifications. Debugging: - - pref: DumpTemplateVarsIntranet diff --git a/t/db_dependent/Biblio/MARCPermissions.t b/t/db_dependent/Biblio/MARCPermissions.t new file mode 100755 index 0000000..cf2e2c6 --- /dev/null +++ b/t/db_dependent/Biblio/MARCPermissions.t @@ -0,0 +1,284 @@ +#!/usr/bin/perl + +# 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 Test::More tests => 16; +use Test::MockModule; + +use MARC::Record; +use Data::Dumper; + +BEGIN { + use_ok('C4::Biblio'); +} + +# Start transaction +my $dbh = C4::Context->dbh; +$dbh->{AutoCommit} = 0; +$dbh->{RaiseError} = 1; + +# Undef C4::Biblio::inverted_field_map to avoid problems introduced +# by caching in TransformMarcToKoha +undef $C4::Biblio::inverted_field_map; + +C4::Context->set_preference( "MARCPermissions", 1); +C4::Context->set_preference( "MARCPermissionsLog", 1); +C4::Context->set_preference( "MARCPermissionsCorrectionSimilarity", 90); + +# Create a record +my $record = MARC::Record->new(); +$record->append_fields ( + MARC::Field->new('008', '12345'), + MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'), + MARC::Field->new('250', '','', 'a' => '250 bottles of beer on the wall'), + MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'), + MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'), + MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'), +); + +# Add record to DB +my ($biblionumber, $biblioitemnumber) = AddBiblio($record, ''); + +my $modules = GetMarcPermissionsModules(); + +############################################################################## +# Test overwrite rule +my $mod_record = MARC::Record->new(); +$mod_record->append_fields ( + MARC::Field->new('008', '12345'), + MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'), + MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'), + MARC::Field->new('500', '1','1', 'a' => 'this field has now been changed'), + MARC::Field->new('500', '2','2', 'a' => 'and so have this field'), +); + +# Clear MARC permission rules from DB +DelMarcPermissionsRule($_->{id}) for GetMarcPermissionsRules(); + +# Add MARC permission rules to DB +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '*', + tagsubfield => '', + filter => '*', + on_existing => 'overwrite', + on_new => 'add', + on_removed => 'remove' +}); + +my @log = (); +my $new_record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $mod_record, + frameworkcode => '', + filter => {$modules->[0]->{'name'} => 'foo'}, + log => \@log + }); + +my @a500 = $new_record->field('500'); +is ($a500[0]->subfield('a'), 'this field has now been changed', 'old field is replaced when overwrite'); +is ($a500[1]->subfield('a'), 'and so have this field', 'old field is replaced when overwrite'); + +############################################################################## +# Test remove rule +is ($new_record->field('250'), undef, 'removed field is removed'); + +############################################################################## +# Test skip rule +$mod_record = MARC::Record->new(); +$mod_record->append_fields ( + MARC::Field->new('008', '12345'), + MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'), + MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'), + MARC::Field->new('500', '1','1', 'a' => 'this should not show'), + MARC::Field->new('500', '2','2', 'a' => 'and neither should this'), +); + +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '500', + tagsubfield => '*', + filter => '*', + on_existing => 'skip', + on_new => 'skip', + on_removed => 'skip' +}); + +@log = (); +$new_record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $mod_record, + frameworkcode => '', + filter => {$modules->[0]->{'name'} => 'foo'}, + log => \@log + }); + +@a500 = $new_record->field('500'); +is ($a500[0]->subfield('a'), 'the lazy programmer jumps over the quick brown tests', 'old field is kept when skip'); +is ($a500[1]->subfield('a'), 'the quick brown test jumps over the lazy programmers', 'old field is kept when skip'); + +############################################################################## +# Test add rule +$mod_record = MARC::Record->new(); +$mod_record->append_fields ( + MARC::Field->new('008', '12345'), + MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'), + MARC::Field->new('250', '','', 'a' => '250 bottles of beer on the wall'), + #MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'), + MARC::Field->new('245', '1','2', 'a' => 'some new fun value'), + MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'), + MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'), +); + +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '245', + tagsubfield => '*', + filter => '*', + on_existing => 'add', + on_new => 'add', + on_removed => 'skip' +}); + + +@log = (); +$new_record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $mod_record, + frameworkcode => '', + filter => {$modules->[0]->{'name'} => 'foo'}, + log => \@log + }); + +my @a245 = $new_record->field('245')->subfield('a'); +is ($a245[0], 'field data for 245 a with indicators 12', 'old field is kept when adding new'); +is ($a245[1], 'some new fun value', 'new field is added'); + +############################################################################## +# Test add_or_correct rule +$mod_record = MARC::Record->new(); +$mod_record->append_fields ( + MARC::Field->new('008', '12345'), + #MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'), + MARC::Field->new('100', '','', 'a' => 'a very different value'), + MARC::Field->new('250', '','', 'a' => '250 bottles of beer on the wall'), + #MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'), + MARC::Field->new('245', '1','2', 'a' => 'Field data for 245 a with indicators 12', 'a' => 'some very different value'), + MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'), + MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'), +); + +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '(100|245)', + tagsubfield => '*', + filter => '*', + on_existing => 'add_or_correct', + on_new => 'add', + on_removed => 'skip' +}); + +@log = (); +$new_record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $mod_record, + frameworkcode => '', + filter => {$modules->[0]->{'name'} => 'foo'}, + log => \@log + }); + +@a245 = $new_record->field('245')->subfield('a'); +is ($a245[0], 'Field data for 245 a with indicators 12', 'add_or_correct modifies field when a correction'); +is ($a245[1], 'some very different value', 'add_or_correct adds field when not a correction'); + +my @a100 = $new_record->field('100')->subfield('a'); +is ($a100[0], 'field data for 100 a without indicators', 'add_or_correct keeps old field when not a correction'); +is ($a100[1], 'a very different value', 'add_or_correct adds field when not a correction'); + +############################################################################## +# Test rule evaluation order +$mod_record = MARC::Record->new(); +$mod_record->append_fields ( + MARC::Field->new('008', '12345'), + MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'), + MARC::Field->new('250', '','', 'a' => 'take one down, pass it around'), + MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'), + MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'), + MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'), +); + + +DelMarcPermissionsRule($_->{id}) for GetMarcPermissionsRules(); + +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '*', + tagsubfield => '*', + filter => '*', + on_existing => 'skip', + on_new => 'skip', + on_removed => 'skip' +}); +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '250', + tagsubfield => '*', + filter => '*', + on_existing => 'overwrite', + on_new => 'skip', + on_removed => 'skip' +}); +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '*', + tagsubfield => 'a', + filter => '*', + on_existing => 'add_or_correct', + on_new => 'skip', + on_removed => 'skip' +}); +AddMarcPermissionsRule({ + module => $modules->[0]->{'id'}, + tagfield => '250', + tagsubfield => 'a', + filter => '*', + on_existing => 'add', + on_new => 'skip', + on_removed => 'skip' +}); + +@log = (); +$new_record = ApplyMarcPermissions({ + biblionumber => $biblionumber, + record => $mod_record, + frameworkcode => '', + filter => {$modules->[0]->{'name'} => 'foo'}, + log => \@log + }); + +my @rule = grep { $_->{tag} eq '250' and $_->{subfieldcode} eq 'a' } @log; +is(scalar @rule, 1, 'only one rule applied'); +is($rule[0]->{event}.':'.$rule[0]->{action}, 'existing:add', 'most specific rule used'); + +my @a250 = $new_record->field('250')->subfield('a'); +is ($a250[0], '250 bottles of beer on the wall', 'most specific rule is applied, original field kept'); +is ($a250[1], 'take one down, pass it around', 'most specific rule is applied, new field added'); + +$dbh->rollback; + +1; -- 2.1.4