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

(-)a/C4/Biblio.pm (-21 / +997 lines)
Lines 28-33 use MARC::File::USMARC; Link Here
28
use MARC::File::XML;
28
use MARC::File::XML;
29
use POSIX qw(strftime);
29
use POSIX qw(strftime);
30
use Module::Load::Conditional qw(can_load);
30
use Module::Load::Conditional qw(can_load);
31
use String::Similarity;
31
32
32
use C4::Koha;
33
use C4::Koha;
33
use C4::Log;    # logaction
34
use C4::Log;    # logaction
Lines 105-110 BEGIN { Link Here
105
      &CountBiblioInOrders
106
      &CountBiblioInOrders
106
      &GetSubscriptionsId
107
      &GetSubscriptionsId
107
      &GetHolds
108
      &GetHolds
109
110
      &GetMarcPermissionsRules
111
      &GetMarcPermissionsModules
112
      &ModMarcPermissionsRule
113
      &AddMarcPermissionsRule
114
      &DelMarcPermissionsRule
108
    );
115
    );
109
116
110
    # To modify something
117
    # To modify something
Lines 133-138 BEGIN { Link Here
133
    # they are useful in a few circumstances, so they are exported,
140
    # they are useful in a few circumstances, so they are exported,
134
    # but don't use them unless you are a core developer ;-)
141
    # but don't use them unless you are a core developer ;-)
135
    push @EXPORT, qw(
142
    push @EXPORT, qw(
143
      &ApplyMarcPermissions
136
      &ModBiblioMarc
144
      &ModBiblioMarc
137
    );
145
    );
138
146
Lines 230-244 bib to add, while the second argument is the desired MARC Link Here
230
framework code.
238
framework code.
231
239
232
This function also accepts a third, optional argument: a hashref
240
This function also accepts a third, optional argument: a hashref
233
to additional options.  The only defined option is C<defer_marc_save>,
241
to additional options. Defined options are:
234
which if present and mapped to a true value, causes C<AddBiblio>
242
235
to omit the call to save the MARC in C<bibilioitems.marc>
243
C<defer_marc_save>
236
and C<biblioitems.marcxml>  This option is provided B<only>
244
237
for the use of scripts such as C<bulkmarcimport.pl> that may need
245
    If present and mapped to a true value, causes C<AddBiblio> to omit the call
238
to do some manipulation of the MARC record for item parsing before
246
    to save the MARC in C<bibilioitems.marc> and C<biblioitems.marcxml>  This
239
saving it and which cannot afford the performance hit of saving
247
    option is provided B<only> for the use of scripts such as
240
the MARC record twice.  Consequently, do not use that option
248
    C<bulkmarcimport.pl> that may need to do some manipulation of the MARC
241
unless you can guarantee that C<ModBiblioMarc> will be called.
249
    record for item parsing before saving it and which cannot afford the
250
    performance hit of saving the MARC record twice.  Consequently, do not use
251
    that option unless you can guarantee that C<ModBiblioMarc> will be called.
252
253
C<filter>
254
255
    Optional hashref defining permission filters from the
256
    marc_permissions_modules table in form of {module => filter}. Three
257
    predefined filter modules exists:
258
259
        * source
260
        * category
261
        * borrower
242
262
243
=cut
263
=cut
244
264
Lines 271-277 sub AddBiblio { Link Here
271
    _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
291
    _koha_marc_update_biblioitem_cn_sort( $record, $olddata, $frameworkcode );
272
292
273
    # now add the record
293
    # now add the record
274
    ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
294
    ModBiblioMarc( $record, $biblionumber, $frameworkcode, $options->{filter} ) unless $defer_marc_save;
275
295
276
    # update OAI-PMH sets
296
    # update OAI-PMH sets
277
    if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
297
    if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
Lines 300-311 in the C<biblio> and C<biblioitems> tables, as well as Link Here
300
which fields are used to store embedded item, biblioitem,
320
which fields are used to store embedded item, biblioitem,
301
and biblionumber data for indexing.
321
and biblionumber data for indexing.
302
322
323
This function also accepts a forth, optional argument: a hashref defining
324
permission filters from the marc_permissions_modules table in form of
325
{module => filter}. Three predefined filter modules exists:
326
327
    * source
328
    * category
329
    * borrower
330
303
Returns 1 on success 0 on failure
331
Returns 1 on success 0 on failure
304
332
305
=cut
333
=cut
306
334
307
sub ModBiblio {
335
sub ModBiblio {
308
    my ( $record, $biblionumber, $frameworkcode ) = @_;
336
    my ( $record, $biblionumber, $frameworkcode, $filter ) = @_;
337
309
    if (!$record) {
338
    if (!$record) {
310
        carp 'No record passed to ModBiblio';
339
        carp 'No record passed to ModBiblio';
311
        return 0;
340
        return 0;
Lines 343-355 sub ModBiblio { Link Here
343
    _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
372
    _koha_marc_update_bib_ids( $record, $frameworkcode, $biblionumber, $biblioitemnumber );
344
373
345
    # load the koha-table data object
374
    # load the koha-table data object
346
    my $oldbiblio = TransformMarcToKoha( $record, $frameworkcode );
375
    my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode, undef, $biblionumber, $filter );
347
376
348
    # update MARC subfield that stores biblioitems.cn_sort
377
    # update MARC subfield that stores biblioitems.cn_sort
349
    _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
378
    _koha_marc_update_biblioitem_cn_sort( $record, $oldbiblio, $frameworkcode );
350
379
351
    # update the MARC record (that now contains biblio and items) with the new record data
380
    # update the MARC record (that now contains biblio and items) with the new record data
352
    &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
381
    &ModBiblioMarc( $record, $biblionumber, $frameworkcode, $filter);
353
382
354
    # modify the other koha tables
383
    # modify the other koha tables
355
    _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
384
    _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
Lines 2677-2683 sub TransformHtmlToMarc { Link Here
2677
2706
2678
=head2 TransformMarcToKoha
2707
=head2 TransformMarcToKoha
2679
2708
2680
  $result = TransformMarcToKoha( $record, $frameworkcode )
2709
  $result = TransformMarcToKoha( $record, $frameworkcode, $biblionumber, $filter )
2681
2710
2682
Extract data from a MARC bib record into a hashref representing
2711
Extract data from a MARC bib record into a hashref representing
2683
Koha biblio, biblioitems, and items fields. 
2712
Koha biblio, biblioitems, and items fields. 
Lines 2688-2694 hash_ref Link Here
2688
=cut
2717
=cut
2689
2718
2690
sub TransformMarcToKoha {
2719
sub TransformMarcToKoha {
2691
    my ( $record, $frameworkcode, $limit_table ) = @_;
2720
    my ( $record, $frameworkcode, $limit_table, $biblionumber, $filter ) = @_;
2692
2721
2693
    my $result = {};
2722
    my $result = {};
2694
    if (!defined $record) {
2723
    if (!defined $record) {
Lines 2709-2714 sub TransformMarcToKoha { Link Here
2709
        $tables{'biblioitems'} = 1;
2738
        $tables{'biblioitems'} = 1;
2710
    }
2739
    }
2711
2740
2741
    # apply permissions
2742
    if ( C4::Context->preference('MARCPermissions') && $biblionumber && $filter) {
2743
        $record = ApplyMarcPermissions({
2744
                biblionumber => $biblionumber,
2745
                record => $record,
2746
                frameworkcode => $frameworkcode,
2747
                filter => $filter,
2748
                nolog => 1
2749
            });
2750
    }
2751
2712
    # traverse through record
2752
    # traverse through record
2713
  MARCFIELD: foreach my $field ( $record->fields() ) {
2753
  MARCFIELD: foreach my $field ( $record->fields() ) {
2714
        my $tag = $field->tag();
2754
        my $tag = $field->tag();
Lines 3004-3013 sub ModZebra { Link Here
3004
    # replaced by a zebraqueue table, that is filled with ModZebra to run.
3044
    # replaced by a zebraqueue table, that is filled with ModZebra to run.
3005
    # the table is emptied by rebuild_zebra.pl script (using the -z switch)
3045
    # the table is emptied by rebuild_zebra.pl script (using the -z switch)
3006
    my $check_sql = "SELECT COUNT(*) FROM zebraqueue
3046
    my $check_sql = "SELECT COUNT(*) FROM zebraqueue
3007
    WHERE server = ?
3047
                     WHERE server = ?
3008
        AND   biblio_auth_number = ?
3048
                     AND   biblio_auth_number = ?
3009
        AND   operation = ?
3049
                     AND   operation = ?
3010
        AND   done = 0";
3050
                     AND   done = 0";
3011
    my $check_sth = $dbh->prepare_cached($check_sql);
3051
    my $check_sth = $dbh->prepare_cached($check_sql);
3012
    $check_sth->execute( $server, $biblionumber, $op );
3052
    $check_sth->execute( $server, $biblionumber, $op );
3013
    my ($count) = $check_sth->fetchrow_array;
3053
    my ($count) = $check_sth->fetchrow_array;
Lines 3467-3473 sub _koha_delete_biblioitems { Link Here
3467
3507
3468
=head2 ModBiblioMarc
3508
=head2 ModBiblioMarc
3469
3509
3470
  &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3510
  &ModBiblioMarc($newrec,$biblionumber,$frameworkcode,$filter);
3471
3511
3472
Add MARC data for a biblio to koha 
3512
Add MARC data for a biblio to koha 
3473
3513
Lines 3478-3484 Function exported, but should NOT be used, unless you really know what you're do Link Here
3478
sub ModBiblioMarc {
3518
sub ModBiblioMarc {
3479
    # pass the MARC::Record to this function, and it will create the records in
3519
    # pass the MARC::Record to this function, and it will create the records in
3480
    # the marc field
3520
    # the marc field
3481
    my ( $record, $biblionumber, $frameworkcode ) = @_;
3521
    my ( $record, $biblionumber, $frameworkcode, $filter ) = @_;
3522
3482
    if ( !$record ) {
3523
    if ( !$record ) {
3483
        carp 'ModBiblioMarc passed an undefined record';
3524
        carp 'ModBiblioMarc passed an undefined record';
3484
        return;
3525
        return;
Lines 3524-3529 sub ModBiblioMarc { Link Here
3524
      $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3565
      $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3525
    }
3566
    }
3526
3567
3568
    # apply permissions
3569
    if ( C4::Context->preference('MARCPermissions') ) {
3570
        $record = ApplyMarcPermissions({
3571
                biblionumber => $biblionumber,
3572
                record => $record,
3573
                frameworkcode => $frameworkcode,
3574
                filter => $filter
3575
            });
3576
    }
3577
3527
    $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3578
    $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3528
    $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3579
    $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3529
    $sth->finish;
3580
    $sth->finish;
Lines 3820-3825 sub RemoveAllNsb { Link Here
3820
    return $record;
3871
    return $record;
3821
}
3872
}
3822
3873
3874
=head2 ApplyMarcPermissions
3875
3876
    my $record = ApplyMarcPermissions($arguments)
3877
3878
Applies marc permission rules to a record.
3879
3880
C<$arguments> is expected to be a hashref with below keys defined.
3881
3882
=over 4
3883
3884
=item C<biblionumber>
3885
biblionumber of old record
3886
3887
=item C<record>
3888
record that will modify old record
3889
3890
=item C<frameworkcode>
3891
only tags included in framework will be processed
3892
3893
=item C<filter>
3894
hashref containing at least one filter module from the marc_permissions_modules
3895
table in form {module => filter}. Three predefined filter modules exists:
3896
3897
    * source
3898
    * category
3899
    * borrower
3900
3901
=item C<log>
3902
optional reference to array that will be filled with rule evaluation log
3903
entries.
3904
3905
=item C<nolog>
3906
optional boolean which when true disables logging to action log.
3907
3908
=back
3909
3910
Returns:
3911
3912
=over 4
3913
3914
=item C<$record>
3915
3916
new MARC record based on C<record> with C<filter> applied. If no old
3917
record for C<biblionumber> can be found, C<record> is returned unchanged.
3918
Default action when no matching filter found is to leave old record unchanged.
3919
3920
=back
3921
3922
=cut
3923
3924
sub ApplyMarcPermissions {
3925
    my $arguments     = shift;
3926
    my $biblionumber  = $arguments->{biblionumber};
3927
    my $new_record    = $arguments->{record};
3928
    my $frameworkcode = $arguments->{frameworkcode} || '';
3929
3930
    if ( !$biblionumber ) {
3931
        carp 'ApplyMarcPermissions called on undefined biblionumber';
3932
        return;
3933
    }
3934
    if ( !$new_record ) {
3935
        carp 'ApplyMarcPermissions called on undefined record';
3936
        return;
3937
    }
3938
    my $filter = $arguments->{filter}
3939
      or return $new_record;
3940
3941
    my $log   = $arguments->{log} || [];
3942
    my $nolog = $arguments->{nolog};
3943
3944
    my $dbh = C4::Context->dbh;
3945
3946
    my $is_regex = sub {
3947
        my ( $tag, $m ) = @_;
3948
        # tag is not exactly same as possible regex
3949
        $tag ne $m &&
3950
3951
        # wildcard
3952
        $m ne '*' &&
3953
3954
        # valid tagDataType
3955
        $m !~ /^(0[1-9A-z][\dA-Z]) |
3956
        ([1-9A-z][\dA-z]{2})$/x &&
3957
3958
        # nor valid controltagDataType
3959
        $m !~ /00[1-9A-Za-z]{1}/ &&
3960
3961
        # so we try it as a regex
3962
        $tag =~ /^$m$/
3963
    };
3964
3965
    my $old_record = GetMarcBiblio($biblionumber);
3966
    if ( $old_record ) {
3967
        my $ret_record      = MARC::Record->new();
3968
        my $perm            = GetMarcPermissions() or return $new_record;
3969
        my $marc_struct     = GetMarcStructure(1, $frameworkcode);
3970
        my $similarity_pref = C4::Context->preference("MARCPermissionsCorrectionSimilarity");
3971
        $similarity_pref    = defined $similarity_pref &&
3972
                              $similarity_pref >= 0 &&
3973
                              $similarity_pref <= 100 ?
3974
                              $similarity_pref/100.0 : undef;
3975
3976
        # First came the leader ...
3977
        $ret_record->leader($old_record->leader());
3978
3979
        # ... and then came all the tags in the framework
3980
        for my $tag (sort keys %{$marc_struct}) {
3981
            my @old_fields = $old_record->field($tag);
3982
            my @new_fields = $new_record->field($tag);
3983
            next unless @old_fields or @new_fields;
3984
3985
            my @perms = (
3986
                $perm->{'*'},
3987
                (   # regex tags
3988
                    map { $perm->{$_} }
3989
                      grep { $is_regex->( $tag, $_ ) } sort keys %{$perm}
3990
                ),
3991
                $perm->{$tag}
3992
            );
3993
3994
            # There can be more than one field for each tag, so we have to
3995
            # iterate all fields and distinguish which are new, removed or
3996
            # modified
3997
            my $max_fields = ($#old_fields, $#new_fields)
3998
                             [$#old_fields< $#new_fields];
3999
            for ( my $i_field = 0; $i_field <= $max_fields; $i_field++ ) {
4000
                my $old_field = $old_fields[$i_field];
4001
                my $new_field = $new_fields[$i_field];
4002
4003
                # Existing field
4004
                if ( $old_field and $new_field ) {
4005
                    # Control fields
4006
                    if ( $old_field->is_control_field() ) {
4007
                        # Existing control field
4008
                        if ( $old_field and $new_field ) {
4009
                            my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @perms);
4010
                            if ( defined $on_existing->{action} ) {
4011
                                push @{$log},
4012
                                  {
4013
                                    rule         => $on_existing->{rule},
4014
                                    event        => "existing",
4015
                                    action       => $on_existing->{action},
4016
                                    tag          => $tag,
4017
                                    subfieldcode => undef,
4018
                                    filter       => $filter
4019
                                  };
4020
                                if ( $on_existing->{action} eq 'skip' ) {
4021
                                    $ret_record->insert_fields_ordered($old_field);
4022
                                    next;
4023
                                } elsif ( $on_existing->{action} eq 'overwrite' ) {
4024
                                    $ret_record->insert_fields_ordered($new_field);
4025
                                    next;
4026
                                } elsif ( $on_existing->{action} eq 'add' ) {
4027
                                    $ret_record->insert_fields_ordered($old_field);
4028
                                    $ret_record->insert_fields_ordered($new_field);
4029
                                    next;
4030
                                } elsif ( $on_existing->{action} eq 'add_or_correct' ) {
4031
                                    if ( $similarity_pref ) {
4032
                                        my $similarity = similarity $old_field->data(), $new_field->data();
4033
                                        if ( $similarity >= $similarity_pref ) {
4034
                                            $ret_record->insert_fields_ordered($new_field);
4035
                                        } else {
4036
                                            $ret_record->insert_fields_ordered($old_field);
4037
                                            $ret_record->insert_fields_ordered($new_field);
4038
                                        }
4039
                                    } else {
4040
                                        $ret_record->insert_fields_ordered($old_field);
4041
                                    }
4042
                                }
4043
                            } else { # default to skip
4044
                                $ret_record->insert_fields_ordered($old_field);
4045
                                next;
4046
                            }
4047
                        # New control field
4048
                        } elsif ( not $old_field and $new_field ) {
4049
                            my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms);
4050
                            if ( defined $on_new->{action} ) {
4051
                                push @{$log},
4052
                                  {
4053
                                    rule         => $on_new->{rule},
4054
                                    event        => "new",
4055
                                    action       => $on_new->{action},
4056
                                    tag          => $tag,
4057
                                    subfieldcode => undef,
4058
                                    filter       => $filter
4059
                                  };
4060
                                if ( $on_new->{action} eq 'skip' ) {
4061
                                    next;
4062
                                } elsif ( $on_new->{action} eq 'add' ) {
4063
                                    $ret_record->insert_fields_ordered($new_field);
4064
                                    next;
4065
                                }
4066
                            }
4067
                        # Removed control field
4068
                        } elsif ( $old_field and not $new_field ) {
4069
                            my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms);
4070
                            if ( defined $on_removed->{action} ) {
4071
                                push @{$log},
4072
                                  {
4073
                                    rule         => $on_removed->{rule},
4074
                                    event        => "removed",
4075
                                    action       => $on_removed->{action},
4076
                                    tag          => $tag,
4077
                                    subfieldcode => undef
4078
                                  };
4079
                                if ( $on_removed->{action} eq 'skip' ) {
4080
                                    $ret_record->insert_fields_ordered($old_field);
4081
                                    next;
4082
                                } elsif ( $on_removed->{action} eq 'remove' ) {
4083
                                    next;
4084
                                }
4085
                            } else { # default to skip
4086
                                $ret_record->insert_fields_ordered($old_field);
4087
                                next;
4088
                            }
4089
                        }
4090
                    # Indicators and subfields
4091
                    } else {
4092
                        # Indicators
4093
                        my @old_ind = map { $old_field->indicator($_) } (1,2);
4094
                        my @new_ind = map { $new_field->indicator($_) } (1,2);
4095
                        my @ind = ('','');
4096
4097
                        for my $i ((0,1)) {
4098
                            my @ind_perms = (
4099
                                @perms,
4100
                                $perm->{$tag}->{subfields}->{ 'i' . ( $i + 1 ) }
4101
                            );
4102
4103
                            # Existing indicator
4104
                            if ( defined $old_ind[$i] and defined $new_ind[$i] ) {
4105
                                my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @ind_perms);
4106
                                if ( defined $on_existing->{action} ) {
4107
                                    push @{$log},
4108
                                      {
4109
                                        rule         => $on_existing->{rule},
4110
                                        event        => "existing",
4111
                                        action       => $on_existing->{action},
4112
                                        tag          => $tag,
4113
                                        subfieldcode => 'i' . ( $i + 1 ),
4114
                                        filter       => $filter
4115
                                      };
4116
                                    if ( $on_existing->{action} eq 'skip' ) {
4117
                                        $ind[$i] = $old_ind[$i];
4118
                                    } elsif ( $on_existing->{action} eq 'overwrite' ) {
4119
                                        $ind[$i] = $new_ind[$i];
4120
                                    }
4121
                                } else { # default to skip
4122
                                    $ind[$i] = $old_ind[$i];
4123
                                }
4124
                            # New indicator
4125
                            } elsif ( not defined $old_ind[$i] and defined $new_ind[$i] ) {
4126
                                my $on_new = GetMarcPermissionsAction('on_new', $filter, @ind_perms);
4127
                                if ( defined $on_new->{action} ) {
4128
                                    push @{$log},
4129
                                      {
4130
                                        rule         => $on_new->{rule},
4131
                                        event        => "new",
4132
                                        action       => $on_new->{action},
4133
                                        tag          => $tag,
4134
                                        subfieldcode => 'i' . ( $i + 1 ),
4135
                                        filter       => $filter
4136
                                      };
4137
                                    if ( $on_new->{action} eq 'skip' ) {
4138
                                        $ind[$i] = $old_ind[$i];
4139
                                    } elsif ( $on_new->{action} eq 'add' ) {
4140
                                        $ind[$i] = $new_ind[$i];
4141
                                    }
4142
                                }
4143
                            # Removed indicator
4144
                            } elsif ( defined $old_ind[$i] and not defined $new_ind[$i] ) {
4145
                                my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @ind_perms);
4146
                                if ( defined $on_removed->{action} ) {
4147
                                    push @{$log},
4148
                                      {
4149
                                        rule         => $on_removed->{rule},
4150
                                        event        => "removed",
4151
                                        action       => $on_removed->{action},
4152
                                        tag          => $tag,
4153
                                        subfieldcode => 'i' . ( $i + 1 ),
4154
                                        filter       => $filter
4155
                                      };
4156
                                    if ( $on_removed->{action} eq 'skip' ) {
4157
                                        $ind[$i] = $old_ind[$i];
4158
                                    } elsif ( $on_removed->{action} eq 'remove' ) {
4159
                                        $ind[$i] = '';
4160
                                    }
4161
                                } else { # default to skip
4162
                                    $ind[$i] = $old_ind[$i];
4163
                                }
4164
                            }
4165
                        }
4166
4167
                        # Subfields
4168
                        my @subfields = ();
4169
                        my %proccessed_subcodes = ();
4170
4171
                        # Try to preserve subfield order by first processing
4172
                        # subfields from the old record, and then subfields from
4173
                        # the framework structure unless include in old record.
4174
                        my @sorted_subfields = (
4175
                            map { shift @{$_} } $old_field->subfields(),
4176
                            () = sort keys %{ $marc_struct->{$tag} }
4177
                        );
4178
                        for my $subcode ( @sorted_subfields ) {
4179
                            next if $proccessed_subcodes{$subcode};
4180
                            $proccessed_subcodes{$subcode} = 1;
4181
                            next unless ref $marc_struct->{$tag}{$subcode} eq 'HASH';
4182
                            my @old_subfields = $old_field->subfield($subcode);
4183
                            my @new_subfields = $new_field->subfield($subcode);
4184
                            next unless @old_subfields or @new_subfields;
4185
4186
                            my @subfield_perms = (
4187
                                @perms,
4188
                                $perm->{'*'}->{subfields}->{'*'},
4189
                                $perm->{$tag}->{subfields}->{'*'},
4190
                                (    # tag->regex
4191
                                    map { $perm->{$tag}->{subfields}->{$_} }
4192
                                      grep {
4193
                                        # subcode is not exactly same as
4194
                                        # possible regex
4195
                                        $subcode ne $_ &&
4196
4197
                                        # wildcard, not checking for valid
4198
                                        # subfieldcodeDataType since it
4199
                                        # contains too many regex characters
4200
                                        $_ !~ /^(\*)$/ &&
4201
4202
                                        # so we try it as a regex
4203
                                        $subcode =~ /$_/
4204
                                      } sort
4205
                                      keys %{ $perm->{$tag}->{subfields} }
4206
                                ),
4207
                                (    # regex->*
4208
                                    map { $perm->{$_}->{subfields}->{'*'} }
4209
                                      grep { $is_regex->( $tag, $_ ) }
4210
                                      sort keys %{$perm}
4211
                                ),
4212
                                $perm->{'*'}->{subfields}->{$subcode},
4213
                                (    # regex->subcode
4214
                                    map { $perm->{$_}->{subfields}->{$subcode} }
4215
                                      grep { $is_regex->( $tag, $_ ) }
4216
                                      sort keys %{$perm}
4217
                                ),
4218
                                $perm->{$tag}->{subfields}->{$subcode}
4219
                            );
4220
4221
                            # Existing subfield
4222
                            if ( @old_subfields and @new_subfields ) {
4223
                                my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @subfield_perms);
4224
                                if ( defined $on_existing->{action} ) {
4225
                                    push @{$log},
4226
                                      {
4227
                                        rule         => $on_existing->{rule},
4228
                                        event        => "existing",
4229
                                        action       => $on_existing->{action},
4230
                                        tag          => $tag,
4231
                                        subfieldcode => $subcode,
4232
                                        filter       => $filter
4233
                                      };
4234
                                    if ( $on_existing->{action} eq 'skip' ) {
4235
                                        push(@subfields, map {($subcode,$_)} @old_subfields);
4236
                                        next;
4237
                                    } elsif ( $on_existing->{action} eq 'overwrite' ) {
4238
                                        push(@subfields, map {($subcode,$_)} @new_subfields);
4239
                                        next;
4240
                                    } elsif ( $on_existing->{action} eq 'add' ) {
4241
                                        push(@subfields, map {($subcode,$_)} @old_subfields);
4242
                                        push(@subfields, map {($subcode,$_)} @new_subfields);
4243
                                        next;
4244
                                    } elsif ( $on_existing->{action} eq 'add_or_correct' ) {
4245
                                        if ( $similarity_pref ) {
4246
                                            my @corrected_vals = ();
4247
4248
                                            # correct all old subfields
4249
                                            for ( my $i_new = 0; $i_new <= $#new_subfields; $i_new++ ) {
4250
                                                my $new_val = $new_subfields[$i_new];
4251
                                                for ( my $i_old = 0; $i_old <= $#old_subfields; $i_old++ ) {
4252
                                                    my $old_val = $old_subfields[$i_old];
4253
                                                    next if not defined $old_val or not defined $new_val;
4254
                                                    my $similarity = similarity $old_val, $new_val;
4255
                                                    if ( $similarity >= $similarity_pref ) {
4256
                                                        $corrected_vals[$i_old] = $new_val;
4257
                                                        $new_subfields[$i_new] = undef;
4258
                                                        $old_subfields[$i_old] = undef;
4259
                                                        last;
4260
                                                    }
4261
                                                }
4262
                                            }
4263
4264
                                            # insert all unchanged old subfields
4265
                                            map {
4266
                                                $corrected_vals[$_] = $old_subfields[$_]
4267
                                                    if defined $old_subfields[$_]
4268
                                                } 0 .. $#old_subfields;
4269
4270
4271
                                            # append all remaning new subfields
4272
                                            map {push @corrected_vals, $_ if defined} @new_subfields;
4273
4274
                                            push(@subfields, map {($subcode,$_)} @corrected_vals);
4275
                                        } else {
4276
                                            push(@subfields, map {($subcode,$_)} @old_subfields);
4277
                                        }
4278
                                    }
4279
                                } else { # default to skip
4280
                                    push(@subfields, map {($subcode,$_)} @old_subfields);
4281
                                    next;
4282
                                }
4283
                            # New subfield
4284
                            } elsif ( not @old_subfields and @new_subfields ) {
4285
                                my $on_new = GetMarcPermissionsAction('on_new', $filter, @subfield_perms);
4286
                                if ( defined $on_new->{action} ) {
4287
                                    push @{$log},
4288
                                      {
4289
                                        rule         => $on_new->{rule},
4290
                                        event        => "new",
4291
                                        action       => $on_new->{action},
4292
                                        tag          => $tag,
4293
                                        subfieldcode => $subcode,
4294
                                        filter       => $filter
4295
                                      };
4296
                                    if ( $on_new->{action} eq 'skip' ) {
4297
                                        next;
4298
                                    } elsif ( $on_new->{action} eq 'add' ) {
4299
                                        push(@subfields, map {($subcode,$_)} @new_subfields);
4300
                                        next;
4301
                                    }
4302
                                }
4303
                            # Removed subfield
4304
                            } elsif ( @old_subfields and not @new_subfields ) {
4305
                                my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @subfield_perms);
4306
                                if ( defined $on_removed->{action} ) {
4307
                                    push @{$log},
4308
                                      {
4309
                                        rule         => $on_removed->{rule},
4310
                                        event        => "removed",
4311
                                        action       => $on_removed->{action},
4312
                                        tag          => $tag,
4313
                                        subfieldcode => $subcode,
4314
                                        filter       => $filter
4315
                                      };
4316
                                    if ( $on_removed->{action} eq 'skip' ) {
4317
                                        push(@subfields, ($subcode => @old_subfields));
4318
                                        next;
4319
                                    } elsif ( $on_removed->{action} eq 'remove' ) {
4320
                                        next;
4321
                                    }
4322
                                } else { # default to skip
4323
                                    push(@subfields, ($subcode => @old_subfields));
4324
                                    next;
4325
                                }
4326
                            }
4327
                        } # / for each subfield
4328
                        $ret_record->insert_grouped_field(MARC::Field->new($tag, $ind[0], $ind[1], @subfields));
4329
                    }
4330
                # New field
4331
                } elsif ( not $old_field and $new_field ) {
4332
                    my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms);
4333
                    if ( defined $on_new->{action} ) {
4334
                        push @{$log},
4335
                          {
4336
                            rule         => $on_new->{rule},
4337
                            event        => "new",
4338
                            action       => $on_new->{action},
4339
                            tag          => $tag,
4340
                            subfieldcode => undef,
4341
                            filter       => $filter
4342
                          };
4343
                        if ( $on_new->{action} eq 'skip' ) {
4344
                            next;
4345
                        } elsif ( $on_new->{action} eq 'add' ) {
4346
                            $ret_record->insert_fields_ordered($new_field);
4347
                            next;
4348
                        }
4349
                    }
4350
                # Removed field
4351
                } elsif ( $old_field and not $new_field ) {
4352
                    my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms);
4353
                    if ( defined $on_removed->{action} ) {
4354
                        push @{$log},
4355
                          {
4356
                            rule         => $on_removed->{rule},
4357
                            event        => "removed",
4358
                            action       => $on_removed->{action},
4359
                            tag          => $tag,
4360
                            subfieldcode => undef,
4361
                            filter       => $filter
4362
                          };
4363
                        if ( $on_removed->{action} eq 'skip' ) {
4364
                            $ret_record->insert_grouped_field($old_field);
4365
                            next;
4366
                        } elsif ( $on_removed->{action} eq 'remove' ) {
4367
                            next;
4368
                        }
4369
                    } else { # default to skip
4370
                        $ret_record->insert_grouped_field($old_field);
4371
                        next;
4372
                    }
4373
                }
4374
            } # / for each field
4375
        } # / for each tag
4376
        if ( !$nolog && C4::Context->preference("MARCPermissionsLog") ) {
4377
            my $log_str = '';
4378
            my $n       = $#{$log};
4379
            for my $l ( @{$log} ) {
4380
                $log_str .= "{\n";
4381
                my $kn = keys %{$l};
4382
                for my $k ( sort keys %{$l} ) {
4383
                    if ( $k eq 'filter' ) {
4384
                        $log_str .= "  filter => {\n";
4385
                        my $fkn = keys %{ $l->{$k} };
4386
                        for my $fk ( sort keys %{ $l->{$k} } ) {
4387
                            $log_str .= '    '
4388
                              . $fk . ' => '
4389
                              . $l->{$k}->{$fk}
4390
                              . ( --$fkn ? ',' : '' ) . "\n";
4391
                        }
4392
                        $log_str .= "  }" . ( --$kn ? ',' : '' ) . "\n";
4393
                    }
4394
                    else {
4395
                        $log_str .= '  '
4396
                          . $k . ' => '
4397
                          . $l->{$k}
4398
                          . ( --$kn ? ',' : '' ) . "\n"
4399
                          if defined $l->{$k};
4400
                    }
4401
                }
4402
                $log_str .= '}' . ( $n-- ? ",\n" : '' );
4403
            }
4404
            logaction( "CATALOGUING", "MODIFY", $biblionumber, $log_str );
4405
        }
4406
        return $ret_record;
4407
    }
4408
    return $new_record;
4409
}
4410
4411
4412
=head2 GetMarcPermissions
4413
4414
    my $marc_permissions = GetMarcPermissions()
4415
4416
Loads MARC field permissions from the marc_permissions table.
4417
4418
Returns:
4419
4420
=over 4
4421
4422
=item C<$marc_permissions>
4423
4424
hashref with permissions structure for use with GetMarcPermissionsAction.
4425
4426
=back
4427
4428
=cut
4429
4430
sub GetMarcPermissions {
4431
    my $dbh = C4::Context->dbh;
4432
    my $rule_count = 0;
4433
    my %perms = ();
4434
4435
    my $query = '
4436
    SELECT `marc_permissions`.*,
4437
           `marc_permissions_modules`.`name`,
4438
           `marc_permissions_modules`.`description`,
4439
           `marc_permissions_modules`.`specificity`
4440
    FROM `marc_permissions`
4441
    LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id`
4442
    ORDER BY `marc_permissions_modules`.`specificity`, `id`
4443
    ';
4444
    my $sth = $dbh->prepare($query);
4445
    $sth->execute();
4446
    while ( my $row = $sth->fetchrow_hashref ) {
4447
        $rule_count++;
4448
        if ( defined $row->{tagsubfield} and $row->{tagsubfield} ) {
4449
            $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} }
4450
              ->{on_existing}->{ $row->{name} }->{ $row->{filter} } =
4451
              { action => $row->{on_existing}, rule => $row->{'id'} };
4452
            $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} }
4453
              ->{on_new}->{ $row->{name} }->{ $row->{filter} } =
4454
              { action => $row->{on_new}, rule => $row->{'id'} };
4455
            $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} }
4456
              ->{on_removed}->{ $row->{name} }->{ $row->{filter} } =
4457
              { action => $row->{on_removed}, rule => $row->{'id'} };
4458
        }
4459
        else {
4460
            $perms{ $row->{tagfield} }->{on_existing}->{ $row->{name} }
4461
              ->{ $row->{filter} } =
4462
              { action => $row->{on_existing}, rule => $row->{'id'} };
4463
            $perms{ $row->{tagfield} }->{on_new}->{ $row->{name} }
4464
              ->{ $row->{filter} } =
4465
              { action => $row->{on_new}, rule => $row->{'id'} };
4466
            $perms{ $row->{tagfield} }->{on_removed}->{ $row->{name} }
4467
              ->{ $row->{filter} } =
4468
              { action => $row->{on_removed}, rule => $row->{'id'} };
4469
        }
4470
    }
4471
4472
    return unless $rule_count;
4473
    return \%perms;
4474
}
4475
4476
=head2 GetMarcPermissionsAction
4477
4478
    my $action = GetMarcPermissionsAction($event, $filter, @permissions)
4479
4480
Gets action based on C<$event>, C<$filter> and C<@permissions>.
4481
4482
=over 4
4483
4484
=item C<$event>
4485
4486
which event: 'on_existing', 'on_new' or 'on_removed'
4487
4488
=item C<$filter>
4489
4490
hashref containing at least one filter module from the marc_permissions_modules
4491
table in form {module => filter}. Three predefined filter modules exists:
4492
4493
    * source
4494
    * category
4495
    * borrower
4496
4497
=item C<@permissions>
4498
4499
list of permission structures in order of specificity from least to most
4500
specific.
4501
4502
=back
4503
4504
Returns:
4505
4506
=over 4
4507
4508
=item C<$action>
4509
4510
hashref defining matching action.
4511
4512
=back
4513
4514
=cut
4515
4516
sub GetMarcPermissionsAction {
4517
    my $what = shift or return;
4518
    my $filter = shift or return;
4519
    my @perms = @_;
4520
4521
    my $modules = GetMarcPermissionsModules();
4522
4523
    my $action = undef;
4524
    for my $perm (@perms) {
4525
        next if not defined $perm;
4526
        next if not defined $perm->{$what};
4527
        my $tmp_action = undef;
4528
4529
        for my $module ( @{$modules} ) {
4530
            if (defined $perm->{$what}->{ $module->{'name'} }
4531
                and
4532
                defined $perm->{$what}->{ $module->{'name'} }->{'*'}->{action} )
4533
            {
4534
                $tmp_action = $perm->{$what}->{ $module->{'name'} }->{'*'};
4535
            }
4536
            if (    defined $filter->{ $module->{'name'} }
4537
                and defined $perm->{$what}->{ $module->{'name'} }
4538
                and defined $perm->{$what}->{ $module->{'name'} }
4539
                ->{ $filter->{ $module->{'name'} } }->{action} )
4540
            {
4541
                $tmp_action = $perm->{$what}->{ $module->{'name'} }
4542
                  ->{ $filter->{ $module->{'name'} } };
4543
            }
4544
        }
4545
4546
        $action = $tmp_action if defined $tmp_action;
4547
    }
4548
4549
    return $action;
4550
}
4551
4552
=head2 GetMarcPermissionsRules
4553
4554
    my $rules = GetMarcPermissionsRules()
4555
4556
Returns:
4557
4558
=over 4
4559
4560
=item C<$rules>
4561
4562
array (in list context, arrayref otherwise) of hashrefs from marc_permissions
4563
table in order of module specificity and rule id.
4564
4565
=back
4566
4567
=cut
4568
4569
sub GetMarcPermissionsRules {
4570
    my $dbh = C4::Context->dbh;
4571
    my @rules = ();
4572
4573
    my $query = '
4574
    SELECT `marc_permissions`.`id`,
4575
           `marc_permissions`.`tagfield`,
4576
           `marc_permissions`.`tagsubfield`,
4577
           `marc_permissions`.`filter`,
4578
           `marc_permissions`.`on_existing`,
4579
           `marc_permissions`.`on_new`,
4580
           `marc_permissions`.`on_removed`,
4581
           `marc_permissions_modules`.`name` as  `module`,
4582
           `marc_permissions_modules`.`description`,
4583
           `marc_permissions_modules`.`specificity`
4584
    FROM `marc_permissions`
4585
    LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id`
4586
    ORDER BY `marc_permissions_modules`.`specificity`, `id`
4587
    ';
4588
    my $sth = $dbh->prepare($query);
4589
    $sth->execute();
4590
    while ( my $row = $sth->fetchrow_hashref ) {
4591
        push(@rules, $row);
4592
    }
4593
4594
    return wantarray ? @rules : \@rules;
4595
}
4596
4597
=head2 GetMarcPermissionsModules
4598
4599
    my $modules = GetMarcPermissionsModules()
4600
4601
Returns:
4602
4603
=over 4
4604
4605
=item C<$modules>
4606
4607
array (in list context, arrayref otherwise) of hashrefs from
4608
marc_permissions_modules table in order of specificity.
4609
4610
=back
4611
4612
=cut
4613
4614
sub GetMarcPermissionsModules {
4615
    my $dbh = C4::Context->dbh;
4616
    my @modules = ();
4617
4618
    my $query = '
4619
    SELECT *
4620
    FROM `marc_permissions_modules`
4621
    ORDER BY `specificity`
4622
    ';
4623
    my $sth = $dbh->prepare($query);
4624
    $sth->execute();
4625
    while ( my $row = $sth->fetchrow_hashref ) {
4626
        push(@modules, $row);
4627
    }
4628
4629
    return wantarray ? @modules : \@modules;
4630
}
4631
4632
=head2 ModMarcPermissionsRule
4633
4634
    my $success = ModMarcPermissionsRule($id, $fields)
4635
4636
Modifies rule in the marc_permissions table.
4637
4638
=over 4
4639
4640
=item C<$id>
4641
4642
rule id to modify
4643
4644
=item C<$fields>
4645
4646
hashref defining the table fields
4647
4648
      * tagfield - required
4649
      * tagsubfield
4650
      * module - required
4651
      * filter - required
4652
      * on_existing - required
4653
      * on_new - required
4654
      * on_removed - required
4655
4656
=back
4657
4658
Returns:
4659
4660
=over 4
4661
4662
=item C<$success>
4663
4664
undef if an error occurs, otherwise true.
4665
4666
=back
4667
4668
=cut
4669
4670
sub ModMarcPermissionsRule {
4671
    my ($id, $f) = @_;
4672
    my $dbh = C4::Context->dbh;
4673
    my $query = '
4674
    UPDATE `marc_permissions`
4675
    SET
4676
      tagfield = ?,
4677
      tagsubfield = ?,
4678
      module = ?,
4679
      filter = ?,
4680
      on_existing = ?,
4681
      on_new = ?,
4682
      on_removed = ?
4683
    WHERE
4684
      id = ?
4685
    ';
4686
    my $sth = $dbh->prepare($query);
4687
    return $sth->execute (
4688
                      $f->{tagfield},
4689
                      $f->{tagsubfield},
4690
                      $f->{module},
4691
                      $f->{filter},
4692
                      $f->{on_existing},
4693
                      $f->{on_new},
4694
                      $f->{on_removed},
4695
                      $id
4696
                  );
4697
}
4698
4699
=head2 AddMarcPermissionsRule
4700
4701
    my $success = AddMarcPermissionsRule($fields)
4702
4703
Add rule to the marc_permissions table.
4704
4705
=over 4
4706
4707
=item C<$fields>
4708
4709
hashref defining the table fields
4710
4711
      tagfield - required
4712
      tagsubfield
4713
      module - required
4714
      filter - required
4715
      on_existing - required
4716
      on_new - required
4717
      on_removed - required
4718
4719
=back
4720
4721
Returns:
4722
4723
=over 4
4724
4725
=item C<$success>
4726
4727
undef if an error occurs, otherwise true.
4728
4729
=back
4730
4731
=cut
4732
4733
sub AddMarcPermissionsRule {
4734
    my $f = shift;
4735
    my $dbh = C4::Context->dbh;
4736
    my $query = '
4737
    INSERT INTO `marc_permissions`
4738
    (
4739
      tagfield,
4740
      tagsubfield,
4741
      module,
4742
      filter,
4743
      on_existing,
4744
      on_new,
4745
      on_removed
4746
    )
4747
    VALUES (?, ?, ?, ?, ?, ?, ?)
4748
    ';
4749
    my $sth = $dbh->prepare($query);
4750
    return $sth->execute (
4751
                      $f->{tagfield},
4752
                      $f->{tagsubfield},
4753
                      $f->{module},
4754
                      $f->{filter},
4755
                      $f->{on_existing},
4756
                      $f->{on_new},
4757
                      $f->{on_removed}
4758
                  );
4759
}
4760
4761
=head2 DelMarcPermissionsRule
4762
4763
    my $success = DelMarcPermissionsRule($id)
4764
4765
Deletes rule from the marc_permissions table.
4766
4767
=over 4
4768
4769
=item C<$id>
4770
4771
rule id to delete
4772
4773
=back
4774
4775
Returns:
4776
4777
=over 4
4778
4779
=item C<$success>
4780
4781
undef if an error occurs, otherwise true.
4782
4783
=back
4784
4785
=cut
4786
4787
sub DelMarcPermissionsRule {
4788
    my $id = shift;
4789
    my $dbh = C4::Context->dbh;
4790
    my $query = '
4791
    DELETE FROM `marc_permissions`
4792
    WHERE
4793
      id = ?
4794
    ';
4795
    my $sth = $dbh->prepare($query);
4796
    return $sth->execute($id);
4797
}
4798
3823
1;
4799
1;
3824
4800
3825
4801
(-)a/admin/marc-permissions.pl (+123 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use strict;
19
use warnings;
20
21
# standard or CPAN modules used
22
use CGI qw ( -utf8 );
23
use CGI::Cookie;
24
use MARC::File::USMARC;
25
26
# Koha modules used
27
use C4::Context;
28
use C4::Koha;
29
use C4::Auth;
30
use C4::AuthoritiesMarc;
31
use C4::Output;
32
use C4::Biblio;
33
use C4::ImportBatch;
34
use C4::Matcher;
35
use C4::BackgroundJob;
36
use C4::Labels::Batch;
37
38
my $script_name = "/cgi-bin/koha/admin/marc-permissions.pl";
39
40
my $input = new CGI;
41
my $op = $input->param('op') || '';
42
43
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
44
    {
45
        template_name   => "admin/marc-permissions.tt",
46
        query           => $input,
47
        type            => "intranet",
48
        authnotrequired => 0,
49
        flagsrequired   => { parameters => 'parameters_remaining_permissions' },
50
        debug           => 1,
51
    }
52
);
53
54
my %cookies = parse CGI::Cookie($cookie);
55
our $sessionID = $cookies{'CGISESSID'}->value;
56
57
my $rules;
58
if ( $op eq "remove" ) {
59
    $template->{VARS}->{removeConfirm} = 1;
60
    my @removeIDs = $input->multi_param('batchremove');
61
    push( @removeIDs, scalar $input->param('id') ) if $input->param('id');
62
63
    $rules = GetMarcPermissionsRules();
64
    for my $removeID (@removeIDs) {
65
        map { $_->{'remove'} = 1 if $_->{'id'} == $removeID } @{$rules};
66
    }
67
68
}
69
elsif ( $op eq "doremove" ) {
70
    my @removeIDs = $input->multi_param('batchremove');
71
    push( @removeIDs, scalar $input->param('id') ) if $input->param('id');
72
    for my $removeID (@removeIDs) {
73
        DelMarcPermissionsRule($removeID);
74
    }
75
76
    $rules = GetMarcPermissionsRules();
77
78
}
79
elsif ( $op eq "edit" ) {
80
    $template->{VARS}->{edit} = 1;
81
    my $id = $input->param('id');
82
    $rules = GetMarcPermissionsRules();
83
    map { $_->{'edit'} = 1 if $_->{'id'} == $id } @{$rules};
84
85
}
86
elsif ( $op eq "doedit" ) {
87
    my $id     = $input->param('id');
88
    my $fields = {
89
        module      => scalar $input->param('module'),
90
        tagfield    => scalar $input->param('tagfield'),
91
        tagsubfield => scalar $input->param('tagsubfield'),
92
        filter      => scalar $input->param('filter'),
93
        on_existing => scalar $input->param('on_existing'),
94
        on_new      => scalar $input->param('on_new'),
95
        on_removed  => scalar $input->param('on_removed')
96
    };
97
98
    ModMarcPermissionsRule( $id, $fields );
99
    $rules = GetMarcPermissionsRules();
100
101
}
102
elsif ( $op eq "add" ) {
103
    my $fields = {
104
        module      => scalar $input->param('module'),
105
        tagfield    => scalar $input->param('tagfield'),
106
        tagsubfield => scalar $input->param('tagsubfield'),
107
        filter      => scalar $input->param('filter'),
108
        on_existing => scalar $input->param('on_existing'),
109
        on_new      => scalar $input->param('on_new'),
110
        on_removed  => scalar $input->param('on_removed')
111
    };
112
113
    AddMarcPermissionsRule($fields);
114
    $rules = GetMarcPermissionsRules();
115
116
}
117
else {
118
    $rules = GetMarcPermissionsRules();
119
}
120
my $modules = GetMarcPermissionsModules();
121
$template->param( rules => $rules, modules => $modules );
122
123
output_html_with_http_headers $input, $cookie, $template->output;
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+2 lines)
Lines 89-94 Link Here
89
                        <dt><a href="/cgi-bin/koha/admin/searchengine/elasticsearch/mappings.pl">Search engine configuration</a></dt>
89
                        <dt><a href="/cgi-bin/koha/admin/searchengine/elasticsearch/mappings.pl">Search engine configuration</a></dt>
90
                        <dd>Manage indexes, facets, and their mappings to MARC fields and subfields.</dd>
90
                        <dd>Manage indexes, facets, and their mappings to MARC fields and subfields.</dd>
91
                    [% END %]
91
                    [% END %]
92
                    <dt><a href="/cgi-bin/koha/admin/marc-permissions.pl">MARC field permissions</a></dt>
93
                    <dd>Managed MARC field permissions</dd>
92
                </dl>
94
                </dl>
93
95
94
                <h3>Acquisition parameters</h3>
96
                <h3>Acquisition parameters</h3>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/marc-permissions.tt (+485 lines)
Line 0 Link Here
1
[% USE Koha %]
2
[% INCLUDE 'doc-head-open.inc' %]
3
<title>Koha &rsaquo; Administration &rsaquo; MARC field permissions</title>
4
[% INCLUDE 'doc-head-close.inc' %]
5
<link rel="stylesheet" type="text/css" href="[% themelang %]/css/datatables.css" />
6
[% INCLUDE 'datatables.inc' %]
7
8
<style type="text/css">
9
    .required {
10
        background-color: #C00;
11
    }
12
</style>
13
14
<script type="text/javascript">
15
//<![CDATA[
16
17
function doSubmit(op, id) {
18
    $('<input type="hidden"/>')
19
    .attr('name', 'op')
20
    .attr('value', op)
21
    .appendTo('#marc-permissions-form');
22
23
    if(id) {
24
        $('<input type="hidden"/>')
25
        .attr('name', 'id')
26
        .attr('value', id)
27
        .appendTo('#marc-permissions-form');
28
    }
29
30
    var valid = true;
31
    if( op == 'add' || op == 'edit') {
32
        var validate = [
33
                        $('#marc-permissions-form input[name="filter"]'),
34
                        $('#marc-permissions-form input[name="tagfield"]')
35
                       ];
36
        for(var i=0; i < validate.length; i++) {
37
            if(validate[i].val().length == 0) {
38
                validate[i].addClass('required');
39
                valid = false;
40
            } else {
41
                validate[i].removeClass('required');
42
            }
43
        }
44
    }
45
46
    if(valid ) {
47
        $('#marc-permissions-form').submit();
48
    }
49
50
    return valid;
51
}
52
53
$(document).ready(function(){
54
    $('#btn-help').click(function() {
55
        $('#help').toggle();
56
    });
57
58
    /* disable some options if subfield is indicator */
59
    $('input[name="tagsubfield"]').change(function() {
60
        if( /i[0-9]/.test($(this).val()) ) {
61
            $('select[name="on_existing"] option[value="add"]').attr('disabled', 'disabled')
62
            $('select[name="on_existing"] option[value="add_or_correct"]').attr('disabled', 'disabled')
63
        } else {
64
            $('select[name="on_existing"] option[value="add"]').removeAttr('disabled')
65
            $('select[name="on_existing"] option[value="add_or_correct"]').removeAttr('disabled')
66
        }
67
    });
68
69
    /* disable batch remove unless one or more checkboxes are checked */
70
    $('input[name="batchremove"]').change(function() {
71
        if($('input[name="batchremove"]:checked').length > 0) {
72
            $('#btn_batchremove').removeAttr('disabled');
73
        } else {
74
            $('#btn_batchremove').attr('disabled', 'disabled');
75
        }
76
    });
77
78
    /* check validity of regexes in field and subfield inputs */
79
    $('input[name="tagfield"], input[name="tagsubfield"]').change(function() {
80
        $(this).removeClass('required');
81
        $(this).attr('title', '');
82
        if($(this).val() != '*') {
83
            try {
84
                new RegExp($(this).val())
85
            } catch ( e ) {
86
                $(this).addClass('required');
87
                $(this).attr('title', 'Invalid regular expression: ' + e.message);
88
            }
89
        }
90
    });
91
92
    $.fn.dataTable.ext.order['dom-input'] = function (settings, col) {
93
        return this.api().column(col, { order: 'index' }).nodes()
94
            .map(function (td, i) {
95
                if($('input', td).val() != undefined) {
96
                    return $('input', td).val();
97
                } else if($('select', td).val() != undefined) {
98
                    return $('option[selected="selected"]', td).val();
99
                } else {
100
                    return $(td).html();
101
                }
102
            });
103
    }
104
105
    $('#marc-permissions').dataTable($.extend(true, {}, dataTablesDefaults, {
106
        "aoColumns": [
107
            {"bSearchable": false, "bSortable": false},
108
            {"sSortDataType": "dom-input"},
109
            {"sSortDataType": "dom-input"},
110
            {"bSearchable": false, "sSortDataType": "dom-input"},
111
            {"bSearchable": false, "sSortDataType": "dom-input"},
112
            {"bSearchable": false, "sSortDataType": "dom-input"},
113
            {"bSearchable": false, "sSortDataType": "dom-input"},
114
            {"bSearchable": false, "sSortDataType": "dom-input"},
115
            {"bSearchable": false, "bSortable": false},
116
            {"bSearchable": false, "bSortable": false}
117
        ],
118
        "sPaginationType": "four_button"
119
    } ));
120
121
});
122
//]]>
123
</script>
124
</head>
125
<body id="admin_marc-permissions" class="admin">
126
[% INCLUDE 'header.inc' %]
127
[% INCLUDE 'cat-search.inc' %]
128
129
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a>
130
 &rsaquo; MARC field permissions
131
</div>
132
133
<div id="doc3" class="yui-t2">
134
   <div id="bd">
135
    <div id="yui-main">
136
    <div class="yui-b">
137
138
<h1>Manage MARC field permissions <a href="#" id="btn-help"><button type="button" class="btn btn-small"><i class="icon-question-sign"></i></button></a></h1>
139
[% UNLESS Koha.Preference( 'MARCPermissions' ) %]
140
<div class="dialog message">
141
The <b>MARCPermissions</b> preference is not set, don't forget to enable it for rules to take effect.
142
</div>
143
[% END %]
144
<div id="help" style="display:none;" class="well">
145
    <h3>Rule evaluation</h3>
146
    <p>
147
    Rules are evaluated from least specific to most specific. This means that a
148
    more specific rule will override a less specific rule.
149
150
    <b>*</b> is less specific than a regular expression. A regular expression is
151
    less specific than a normal field name (e.g. <b>245</b>).
152
153
    A <i>Subfield tag</i> is more specific than a <i>Tag</i>.
154
155
    <p>
156
    To add a field-specific rule (i.e. not a subfield), leave the <i>Subfield
157
    tag</i> field blank.
158
    </p>
159
    </p>
160
    <h4>Defaults</h4>
161
    <p>
162
    Default action when no rules exist is to replace the old record with the new
163
    record. Same as if <b>MARCPermissions</b> is disabled.
164
    </p>
165
    <p>
166
    Default action when no matching rule is found is to leave a field
167
    unchanged (<b>skip</b>). If you wish to changed the default actions for
168
    fields and subfields, please add wildcard rules.
169
    </p>
170
171
    <h4>Wildcards</h4>
172
    <p>
173
    <b>*</b> can be used as a wildcard for <i>Tag</i>, <i>Subfield tag</i> and
174
    <i>Filter</i>. <b>*</b> is considered less specific than a non wildcard value,
175
    and thus will be overridden by a non wildcard value (e.g. "100", "a", etc).
176
    </p>
177
178
    <h4>Regular expressions</h4>
179
    Regular expressions can be used in both the <i>Tag</i> and <i>Subfield
180
    tag</i> fields. Beware though, using regular expressions may create
181
    overlapping matches, in which case they will be applied in a sorted order.
182
183
    <h4>Example rules</h4>
184
    <p>
185
    Following is an example rule set in order of specificity.
186
    </p>
187
    <table>
188
        <thead><tr>
189
            <th>Tag</th>
190
            <th>Subfield tag</th>
191
            <th>Module</th>
192
            <th>Filter</th>
193
            <th>Description</th>
194
        </tr></thead>
195
        <tbody>
196
        <tr>
197
            <td>*</td>
198
            <td></td>
199
            <td>[% modules.0.name %]</td>
200
            <td>*</td>
201
            <td><i>Match any field regardless of [% modules.0.name %]</i></td>
202
        </tr>
203
        <tr>
204
            <td>*</td>
205
            <td>*</td>
206
            <td>[% modules.0.name %]</td>
207
            <td>*</td>
208
            <td><i>Match any subfield regardless of [% modules.0.name %]</i></td>
209
        </tr>
210
        <tr>
211
            <td>245</td>
212
            <td>*</td>
213
            <td>[% modules.0.name %]</td>
214
            <td>z39.50</td>
215
            <td><i>Match any subfield under <b>245</b> when [% modules.0.name %]
216
            is <b>z39.50</b></i></td>
217
        </tr>
218
        <tr>
219
            <td>*</td>
220
            <td>b</td>
221
            <td>[% modules.0.name %]</td>
222
            <td>z39.50</td>
223
            <td><i>Match subfield <b>b</b> regardless of field when [% modules.0.name %]
224
            is <b>z39.50</b></i></td>
225
        </tr>
226
        <tr>
227
            <td>500</td>
228
            <td>[a-d]</td>
229
            <td>[% modules.0.name %]</td>
230
            <td>z39.50</td>
231
            <td><i>Match subfields <b>a, b, c, d</b> when field is 500 and [%
232
            modules.0.name %] is <b>z39.50</b></i></td>
233
        </tr>
234
        <tr>
235
            <td>5..</td>
236
            <td>a</td>
237
            <td>[% modules.0.name %]</td>
238
            <td>z39.50</td>
239
            <td><i>Match subfield <b>a</b> when field matches the regular
240
            expression <b>5..</b> (500-599) and [% modules.0.name %] is <b>z39.50</b></i></td>
241
        </tr>
242
        <tr>
243
            <td>245</td>
244
            <td>a</td>
245
            <td>[% modules.0.name %]</td>
246
            <td>z39.50</td>
247
            <td><i>Match subfield <b>a</b> when field is <b>500</b> and [%
248
            modules.0.name %] is <b>z39.50</b></i></td>
249
        </tr>
250
        </tbody>
251
    </table>
252
253
    <h3>Available filter modules</h3>
254
    Filters cannot be regular expressions. Please use a single <b>*</b> as a
255
    wildcard if need.
256
    <table>
257
        <thead>
258
            <tr>
259
                <th>Specificity</th>
260
                <th>Module</th>
261
                <th>Description</th>
262
            </tr>
263
        </thead>
264
        <tbody>
265
        [% FOREACH module IN modules %]
266
            <tr>
267
                <td>[% module.specificity %]</td>
268
                <td>[% module.name %]</td>
269
                <td>[% module.description %]</td>
270
            </tr>
271
        [% END %]
272
        </tbody>
273
    </table>
274
275
    <h3>Available sources</h3>
276
    The following sources currently implement MARCPermissions.
277
278
    <table>
279
        <thead>
280
            <tr>
281
                <th>Name</th>
282
                <th>Description</th>
283
            </tr>
284
        </thead>
285
        <tbody>
286
            <tr>
287
                <td>bulkmarcimport</td>
288
                <td>bin/migration_tools/bulkmarcimport.pl</td>
289
            </tr>
290
            <tr>
291
                <td>import_lexile</td>
292
                <td>bin/migration_tools/import_lexile.pl</td>
293
            </tr>
294
            <tr>
295
                <td>z39.50</td>
296
                <td>Import from Z39.50 search in browser</td>
297
            </tr>
298
            <tr>
299
                <td>intranet</td>
300
                <td>Modifications from intranet in browser</td>
301
            </tr>
302
            <tr>
303
                <td>batchmod</td>
304
                <td>Batch record modification in browser</td>
305
            </tr>
306
        </tbody>
307
    </table>
308
309
310
311
    <h3>Indicators</h3>
312
    <p>
313
    Indicators can be addressed as <b>i1</b> and <b>i2</b> in the <i>Subfield
314
    tag</i> field. Some actions might not be available for indicators, in which
315
    case they will be disabled.
316
    </p>
317
318
    <h3>Logging</h3>
319
    <p>If <b>MARCPermissionsLog</b> is enabled, log entries for each record
320
    modification will be available in the <b>Modification log</b> in the
321
    <b>Catalog</b> module under the <b>Modify</b> action. This can be very
322
    helpful when debugging rule sets.</p>
323
</div>
324
325
[% IF removeConfirm %]
326
<div class="dialog alert">
327
<h3>Remove rule?</h3>
328
<p>Are you sure you want to remove the selected rule(s)?</p>
329
330
<form action="[% script_name %]" method="GET">
331
    <input type="submit" value="No, do not remove" class="deny"/>
332
</form>
333
<input type="button" value="Yes, remove" class="approve" onClick="doSubmit('doremove');"/>
334
</div>
335
[% END %]
336
337
<form action="[% script_name %]" method="POST" id="marc-permissions-form">
338
<table id="marc-permissions">
339
    <thead><tr>
340
        <th>Rule</th>
341
        <th>Tag</th>
342
        <th>Subfield tag</th>
343
        <th>Module</th>
344
        <th>Filter</th>
345
        <th>On Existing</th>
346
        <th>On New</th>
347
        <th>On Removed</th>
348
        <th>&nbsp;</th>
349
        <th>&nbsp;</th>
350
    </tr></thead>
351
    [% UNLESS edit %]
352
    <tfoot>
353
        <tr>
354
            <th>&nbsp;</th>
355
            <th><input type="text" size="5" name="tagfield"/></th>
356
            <th><input type="text" size="5" name="tagsubfield"/></th>
357
            <th>
358
                <select name="module">
359
                    [% FOREACH module IN modules %]
360
                    <option value="[% module.id %]">[% module.name %]</option>
361
                    [% END %]
362
                </select>
363
            </th>
364
            <th><input type="text" size="5" name="filter"/></th>
365
            <th>
366
                <select name="on_existing">
367
                [% FOR on_ex IN ['skip', 'overwrite', 'add', 'add_or_correct'] %]
368
                    <option value="[% on_ex %]">[% on_ex %]</option>
369
                [% END %]
370
                </select>
371
            </th>
372
            <th>
373
                <select name="on_new">
374
                [% FOR on_new IN ['skip', 'add'] %]
375
                    <option value="[% on_new %]">[% on_new %]</option>
376
                [% END %]
377
                </select>
378
            </th>
379
            <th>
380
                <select name="on_removed">
381
                [% FOR on_removed IN ['skip', 'remove'] %]
382
                    <option value="[% on_removed %]">[% on_removed %]</option>
383
                [% END %]
384
                </select>
385
            </th>
386
            <th><button class="btn btn-small" type="button" title="Add" onClick="doSubmit('add');" ><i class="icon-plus"></i></button></th>
387
            <th><button id="btn_batchremove" disabled="disabled" class="btn btn-small" type="button" title="Batch remove" onClick="doSubmit('remove');" ><i class="icon-trash"></i></button></th>
388
        </tr>
389
    </tfoot>
390
    [% END %]
391
    <tbody>
392
        [% FOREACH rule IN rules %]
393
            <tr id="[% rule.id %]">
394
            [% IF rule.edit %]
395
                <td>[% rule.id %]</td>
396
                <td><input type="text" size="3" name="tagfield" value="[% rule.tagfield %]"/></td>
397
                <td><input type="text" size="1" name="tagsubfield" value="[% rule.tagsubfield %]"/></td>
398
                <td>
399
                    <select name="module">
400
                        [% FOREACH module IN modules %]
401
                            [% IF module.name == rule.module %]
402
                                <option value="[% module.id %]" selected="selected">[% module.name %]</option>
403
                            [% ELSE %]
404
                                <option value="[% module.id %]">[% module.name %]</option>
405
                            [% END %]
406
                        [% END %]
407
                    </select>
408
                </td>
409
                <td><input type="text" size="5" name="filter" value="[% rule.filter %]"/></td>
410
                <td>
411
                    <select name="on_existing">
412
                        [% FOR on_ex IN ['skip', 'overwrite', 'add', 'add_or_correct'] %]
413
                            [% IF on_ex == rule.on_existing %]
414
                                <option value="[% on_ex %]" selected="selected">[% on_ex %]</option>
415
                            [% ELSE %]
416
                                <option value="[% on_ex %]">[% on_ex %]</option>
417
                            [% END %]
418
                        [% END %]
419
                    </select>
420
                </td>
421
                <td>
422
                    <select name="on_new">
423
                        [% FOR on_new IN ['skip', 'add'] %]
424
                            [% IF on_new == rule.on_new %]
425
                                <option value="[% on_new %]" selected="selected">[% on_new %]</option>
426
                            [% ELSE %]
427
                                <option value="[% on_new %]">[% on_new %]</option>
428
                            [% END %]
429
                        [% END %]
430
                    </select>
431
                </td>
432
                <td>
433
                    <select name="on_removed">
434
                        [% FOR on_removed IN ['skip', 'remove'] %]
435
                            [% IF on_removed == rule.on_removed %]
436
                                <option value="[% on_removed %]" selected="selected">[% on_removed %]</option>
437
                            [% ELSE %]
438
                                <option value="[% on_removed %]">[% on_removed %]</option>
439
                            [% END %]
440
                        [% END %]
441
                    </select>
442
                </td>
443
                <td>
444
                    <button class="btn btn-small" type="button" title="Save" onClick="doSubmit('doedit', [% rule.id %]);"><i class="icon-ok"></i></button>
445
                    <a href="?"><button class="btn btn-small" type="button" title="Cancel" ><i class="icon-ban-circle"></i></button></a>
446
                    </td>
447
                <td></td>
448
            [% ELSE %]
449
                <td>[% rule.id %]</td>
450
                <td>[% rule.tagfield %]</td>
451
                <td>[% rule.tagsubfield%]</td>
452
                <td>[% rule.module %]</td>
453
                <td>[% rule.filter %]</td>
454
                <td>[% rule.on_existing %]</td>
455
                <td>[% rule.on_new %]</td>
456
                <td>[% rule.on_removed %]</td>
457
                <td>
458
                    <a href="?op=remove&id=[% rule.id %]" title="Remove"><i class="icon-remove"></i></a>
459
                    <a href="?op=edit&id=[% rule.id %]" title="Edit"><i class="icon-pencil"></i></a>
460
                </td>
461
                <td>
462
                    [% IF rule.remove %]
463
                    <input type="checkbox" name="batchremove" value="[% rule.id %]" checked="checked"/>
464
                    [% ELSE %]
465
                    <input type="checkbox" name="batchremove" value="[% rule.id %]"/>
466
                    [% END %]
467
                </td>
468
            [% END %]
469
            </tr>
470
        [% END %]
471
    </tbody>
472
</table>
473
</form>
474
475
<form action="[% script_name %]" method="post">
476
<input type="hidden" name="op" value="redo-matching" />
477
</form>
478
479
</div>
480
</div>
481
<div class="yui-b">
482
[% INCLUDE 'admin-menu.inc' %]
483
</div>
484
</div>
485
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/cataloguing.pref (-22 / +9 lines)
Lines 224-249 Cataloging: Link Here
224
                  yes: "do"
224
                  yes: "do"
225
                  no: "don't"
225
                  no: "don't"
226
            - attempt to match aggressively by trying all variations of the ISBNs in the imported record as a phrase in the ISBN fields of already cataloged records.  Note that this preference has no effect if UseQueryParser is on.
226
            - attempt to match aggressively by trying all variations of the ISBNs in the imported record as a phrase in the ISBN fields of already cataloged records.  Note that this preference has no effect if UseQueryParser is on.
227
    Exporting:
228
        -
227
        -
229
            - Include following fields when exporting BibTeX,
228
            - When importing records
230
            - pref: BibtexExportAdditionalFields
229
            - pref: MARCPermissions
231
              type: textarea
230
              choices:
232
            - "Use one line per tag in the format BT_TAG: TAG$SUBFIELD ( e.g. lccn: 010$a )"
231
                  yes: "use"
233
            - "<br/>"
232
                  no: "don't use"
234
            - "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] )"
233
            - MARC permissions rules to decide which action to take for each field.
235
            - "<br/>"
234
            - When <b>add_or_correct</b>, consider a field modification to be a correction if the old and new value has a similarity of
236
            - "All values of repeating tags and subfields will be printed with the given BibTeX tag."
235
            - pref: MARCPermissionsCorrectionSimilarity
237
            - "<br/>"
236
            - %. If similarity falls below this value, the new value will be treated as a new field.
238
            - "Use '@' ( with quotes ) as the BT_TAG to replace the bibtex record type with a field value of your choosing."
239
        -
240
            - Include following fields when exporting RIS,
241
            - pref: RisExportAdditionalFields
242
              type: textarea
243
            - "Use one line per tag in the format RIS_TAG: TAG$SUBFIELD ( e.g. LC: 010$a )"
244
            - "<br/>"
245
            - "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] )"
246
            - "<br/>"
247
            - "All values of repeating tags and subfields will be printed with the given RIS tag."
248
            - "<br/>"
249
            - "Use of TY ( record type ) as a key will <i>replace</i> the default TY with the field value of your choosing."
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/preferences/logs.pref (+6 lines)
Lines 66-71 Logging: Link Here
66
                  on: Log
66
                  on: Log
67
                  off: "Don't log"
67
                  off: "Don't log"
68
            - when reports are added, deleted or changed.
68
            - when reports are added, deleted or changed.
69
        -
70
            - pref: MARCPermissionsLog
71
              choices:
72
                  on: Log
73
                  off: "Don't log"
74
            - MARC permissions rule evaluations when applying rules for MARC field modifications.
69
    Debugging:
75
    Debugging:
70
        -
76
        -
71
            - pref: DumpTemplateVarsIntranet
77
            - pref: DumpTemplateVarsIntranet
(-)a/t/db_dependent/Biblio/MARCPermissions.t (-1 / +284 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use Test::More tests => 16;
21
use Test::MockModule;
22
23
use MARC::Record;
24
use Data::Dumper;
25
26
BEGIN {
27
    use_ok('C4::Biblio');
28
}
29
30
# Start transaction
31
my $dbh = C4::Context->dbh;
32
$dbh->{AutoCommit} = 0;
33
$dbh->{RaiseError} = 1;
34
35
# Undef C4::Biblio::inverted_field_map to avoid problems introduced
36
# by caching in TransformMarcToKoha
37
undef $C4::Biblio::inverted_field_map;
38
39
C4::Context->set_preference( "MARCPermissions", 1);
40
C4::Context->set_preference( "MARCPermissionsLog", 1);
41
C4::Context->set_preference( "MARCPermissionsCorrectionSimilarity", 90);
42
43
# Create a record
44
my $record = MARC::Record->new();
45
$record->append_fields (
46
    MARC::Field->new('008', '12345'),
47
    MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'),
48
    MARC::Field->new('250', '','', 'a' => '250 bottles of beer on the wall'),
49
    MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'),
50
    MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'),
51
    MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'),
52
);
53
54
# Add record to DB
55
my ($biblionumber, $biblioitemnumber) = AddBiblio($record, '');
56
57
my $modules = GetMarcPermissionsModules();
58
59
##############################################################################
60
# Test overwrite rule
61
my $mod_record = MARC::Record->new();
62
$mod_record->append_fields (
63
    MARC::Field->new('008', '12345'),
64
    MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'),
65
    MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'),
66
    MARC::Field->new('500', '1','1', 'a' => 'this field has now been changed'),
67
    MARC::Field->new('500', '2','2', 'a' => 'and so have this field'),
68
);
69
70
# Clear MARC permission rules from DB
71
DelMarcPermissionsRule($_->{id}) for GetMarcPermissionsRules();
72
73
# Add MARC permission rules to DB
74
AddMarcPermissionsRule({
75
    module => $modules->[0]->{'id'},
76
    tagfield => '*',
77
    tagsubfield => '',
78
    filter => '*',
79
    on_existing => 'overwrite',
80
    on_new => 'add',
81
    on_removed => 'remove'
82
});
83
84
my @log = ();
85
my $new_record = ApplyMarcPermissions({
86
        biblionumber => $biblionumber,
87
        record => $mod_record,
88
        frameworkcode => '',
89
        filter => {$modules->[0]->{'name'} => 'foo'},
90
        log => \@log
91
    });
92
93
my @a500 = $new_record->field('500');
94
is ($a500[0]->subfield('a'), 'this field has now been changed', 'old field is replaced when overwrite');
95
is ($a500[1]->subfield('a'), 'and so have this field', 'old field is replaced when overwrite');
96
97
##############################################################################
98
# Test remove rule
99
is ($new_record->field('250'), undef, 'removed field is removed');
100
101
##############################################################################
102
# Test skip rule
103
$mod_record = MARC::Record->new();
104
$mod_record->append_fields (
105
    MARC::Field->new('008', '12345'),
106
    MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'),
107
    MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'),
108
    MARC::Field->new('500', '1','1', 'a' => 'this should not show'),
109
    MARC::Field->new('500', '2','2', 'a' => 'and neither should this'),
110
);
111
112
AddMarcPermissionsRule({
113
    module => $modules->[0]->{'id'},
114
    tagfield => '500',
115
    tagsubfield => '*',
116
    filter => '*',
117
    on_existing => 'skip',
118
    on_new => 'skip',
119
    on_removed => 'skip'
120
});
121
122
@log = ();
123
$new_record = ApplyMarcPermissions({
124
        biblionumber => $biblionumber,
125
        record => $mod_record,
126
        frameworkcode => '',
127
        filter => {$modules->[0]->{'name'} => 'foo'},
128
        log => \@log
129
    });
130
131
@a500 = $new_record->field('500');
132
is ($a500[0]->subfield('a'), 'the lazy programmer jumps over the quick brown tests', 'old field is kept when skip');
133
is ($a500[1]->subfield('a'), 'the quick brown test jumps over the lazy programmers', 'old field is kept when skip');
134
135
##############################################################################
136
# Test add rule
137
$mod_record = MARC::Record->new();
138
$mod_record->append_fields (
139
    MARC::Field->new('008', '12345'),
140
    MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'),
141
    MARC::Field->new('250', '','', 'a' => '250 bottles of beer on the wall'),
142
    #MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'),
143
    MARC::Field->new('245', '1','2', 'a' => 'some new fun value'),
144
    MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'),
145
    MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'),
146
);
147
148
AddMarcPermissionsRule({
149
    module => $modules->[0]->{'id'},
150
    tagfield => '245',
151
    tagsubfield => '*',
152
    filter => '*',
153
    on_existing => 'add',
154
    on_new => 'add',
155
    on_removed => 'skip'
156
});
157
158
159
@log = ();
160
$new_record = ApplyMarcPermissions({
161
        biblionumber => $biblionumber,
162
        record => $mod_record,
163
        frameworkcode => '',
164
        filter => {$modules->[0]->{'name'} => 'foo'},
165
        log => \@log
166
    });
167
168
my @a245 = $new_record->field('245')->subfield('a');
169
is ($a245[0], 'field data for 245 a with indicators 12', 'old field is kept when adding new');
170
is ($a245[1], 'some new fun value', 'new field is added');
171
172
##############################################################################
173
# Test add_or_correct rule
174
$mod_record = MARC::Record->new();
175
$mod_record->append_fields (
176
    MARC::Field->new('008', '12345'),
177
    #MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'),
178
    MARC::Field->new('100', '','', 'a' => 'a very different value'),
179
    MARC::Field->new('250', '','', 'a' => '250 bottles of beer on the wall'),
180
    #MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'),
181
    MARC::Field->new('245', '1','2', 'a' => 'Field data for 245 a with indicators 12', 'a' => 'some very different value'),
182
    MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'),
183
    MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'),
184
);
185
186
AddMarcPermissionsRule({
187
    module => $modules->[0]->{'id'},
188
    tagfield => '(100|245)',
189
    tagsubfield => '*',
190
    filter => '*',
191
    on_existing => 'add_or_correct',
192
    on_new => 'add',
193
    on_removed => 'skip'
194
});
195
196
@log = ();
197
$new_record = ApplyMarcPermissions({
198
        biblionumber => $biblionumber,
199
        record => $mod_record,
200
        frameworkcode => '',
201
        filter => {$modules->[0]->{'name'} => 'foo'},
202
        log => \@log
203
    });
204
205
@a245 = $new_record->field('245')->subfield('a');
206
is ($a245[0], 'Field data for 245 a with indicators 12', 'add_or_correct modifies field when a correction');
207
is ($a245[1], 'some very different value', 'add_or_correct adds field when not a correction');
208
209
my @a100 = $new_record->field('100')->subfield('a');
210
is ($a100[0], 'field data for 100 a without indicators', 'add_or_correct keeps old field when not a correction');
211
is ($a100[1], 'a very different value', 'add_or_correct adds field when not a correction');
212
213
##############################################################################
214
# Test rule evaluation order
215
$mod_record = MARC::Record->new();
216
$mod_record->append_fields (
217
    MARC::Field->new('008', '12345'),
218
    MARC::Field->new('100', '','', 'a' => 'field data for 100 a without indicators'),
219
    MARC::Field->new('250', '','', 'a' => 'take one down, pass it around'),
220
    MARC::Field->new('245', '1','2', 'a' => 'field data for 245 a with indicators 12'),
221
    MARC::Field->new('500', '1','1', 'a' => 'the lazy programmer jumps over the quick brown tests'),
222
    MARC::Field->new('500', '2','2', 'a' => 'the quick brown test jumps over the lazy programmers'),
223
);
224
225
226
DelMarcPermissionsRule($_->{id}) for GetMarcPermissionsRules();
227
228
AddMarcPermissionsRule({
229
    module => $modules->[0]->{'id'},
230
    tagfield => '*',
231
    tagsubfield => '*',
232
    filter => '*',
233
    on_existing => 'skip',
234
    on_new => 'skip',
235
    on_removed => 'skip'
236
});
237
AddMarcPermissionsRule({
238
    module => $modules->[0]->{'id'},
239
    tagfield => '250',
240
    tagsubfield => '*',
241
    filter => '*',
242
    on_existing => 'overwrite',
243
    on_new => 'skip',
244
    on_removed => 'skip'
245
});
246
AddMarcPermissionsRule({
247
    module => $modules->[0]->{'id'},
248
    tagfield => '*',
249
    tagsubfield => 'a',
250
    filter => '*',
251
    on_existing => 'add_or_correct',
252
    on_new => 'skip',
253
    on_removed => 'skip'
254
});
255
AddMarcPermissionsRule({
256
    module => $modules->[0]->{'id'},
257
    tagfield => '250',
258
    tagsubfield => 'a',
259
    filter => '*',
260
    on_existing => 'add',
261
    on_new => 'skip',
262
    on_removed => 'skip'
263
});
264
265
@log = ();
266
$new_record = ApplyMarcPermissions({
267
        biblionumber => $biblionumber,
268
        record => $mod_record,
269
        frameworkcode => '',
270
        filter => {$modules->[0]->{'name'} => 'foo'},
271
        log => \@log
272
    });
273
274
my @rule = grep { $_->{tag} eq '250' and $_->{subfieldcode} eq 'a' } @log;
275
is(scalar @rule, 1, 'only one rule applied');
276
is($rule[0]->{event}.':'.$rule[0]->{action}, 'existing:add', 'most specific rule used');
277
278
my @a250 = $new_record->field('250')->subfield('a');
279
is ($a250[0], '250 bottles of beer on the wall', 'most specific rule is applied, original field kept');
280
is ($a250[1], 'take one down, pass it around', 'most specific rule is applied, new field added');
281
282
$dbh->rollback;
283
284
1;

Return to bug 14957