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.marcxml>
243
C<defer_marc_save>
236
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<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 3466-3472 sub _koha_delete_biblioitems { Link Here
3466
3506
3467
=head2 ModBiblioMarc
3507
=head2 ModBiblioMarc
3468
3508
3469
  &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3509
  &ModBiblioMarc($newrec,$biblionumber,$frameworkcode,$filter);
3470
3510
3471
Add MARC XML data for a biblio to koha
3511
Add MARC XML data for a biblio to koha
3472
3512
Lines 3477-3483 Function exported, but should NOT be used, unless you really know what you're do Link Here
3477
sub ModBiblioMarc {
3517
sub ModBiblioMarc {
3478
    # pass the MARC::Record to this function, and it will create the records in
3518
    # pass the MARC::Record to this function, and it will create the records in
3479
    # the marcxml field
3519
    # the marcxml field
3480
    my ( $record, $biblionumber, $frameworkcode ) = @_;
3520
    my ( $record, $biblionumber, $frameworkcode, $filter ) = @_;
3521
3481
    if ( !$record ) {
3522
    if ( !$record ) {
3482
        carp 'ModBiblioMarc passed an undefined record';
3523
        carp 'ModBiblioMarc passed an undefined record';
3483
        return;
3524
        return;
Lines 3523-3528 sub ModBiblioMarc { Link Here
3523
      $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3564
      $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3524
    }
3565
    }
3525
3566
3567
    # apply permissions
3568
    if ( C4::Context->preference('MARCPermissions') ) {
3569
        $record = ApplyMarcPermissions({
3570
                biblionumber => $biblionumber,
3571
                record => $record,
3572
                frameworkcode => $frameworkcode,
3573
                filter => $filter
3574
            });
3575
    }
3576
3526
    $sth = $dbh->prepare("UPDATE biblioitems SET marcxml=? WHERE biblionumber=?");
3577
    $sth = $dbh->prepare("UPDATE biblioitems SET marcxml=? WHERE biblionumber=?");
3527
    $sth->execute( $record->as_xml_record($encoding), $biblionumber );
3578
    $sth->execute( $record->as_xml_record($encoding), $biblionumber );
3528
    $sth->finish;
3579
    $sth->finish;
Lines 3819-3824 sub RemoveAllNsb { Link Here
3819
    return $record;
3870
    return $record;
3820
}
3871
}
3821
3872
3873
=head2 ApplyMarcPermissions
3874
3875
    my $record = ApplyMarcPermissions($arguments)
3876
3877
Applies marc permission rules to a record.
3878
3879
C<$arguments> is expected to be a hashref with below keys defined.
3880
3881
=over 4
3882
3883
=item C<biblionumber>
3884
biblionumber of old record
3885
3886
=item C<record>
3887
record that will modify old record
3888
3889
=item C<frameworkcode>
3890
only tags included in framework will be processed
3891
3892
=item C<filter>
3893
hashref containing at least one filter module from the marc_permissions_modules
3894
table in form {module => filter}. Three predefined filter modules exists:
3895
3896
    * source
3897
    * category
3898
    * borrower
3899
3900
=item C<log>
3901
optional reference to array that will be filled with rule evaluation log
3902
entries.
3903
3904
=item C<nolog>
3905
optional boolean which when true disables logging to action log.
3906
3907
=back
3908
3909
Returns:
3910
3911
=over 4
3912
3913
=item C<$record>
3914
3915
new MARC record based on C<record> with C<filter> applied. If no old
3916
record for C<biblionumber> can be found, C<record> is returned unchanged.
3917
Default action when no matching filter found is to leave old record unchanged.
3918
3919
=back
3920
3921
=cut
3922
3923
sub ApplyMarcPermissions {
3924
    my $arguments     = shift;
3925
    my $biblionumber  = $arguments->{biblionumber};
3926
    my $new_record    = $arguments->{record};
3927
    my $frameworkcode = $arguments->{frameworkcode} || '';
3928
3929
    if ( !$biblionumber ) {
3930
        carp 'ApplyMarcPermissions called on undefined biblionumber';
3931
        return;
3932
    }
3933
    if ( !$new_record ) {
3934
        carp 'ApplyMarcPermissions called on undefined record';
3935
        return;
3936
    }
3937
    my $filter = $arguments->{filter}
3938
      or return $new_record;
3939
3940
    my $log   = $arguments->{log} || [];
3941
    my $nolog = $arguments->{nolog};
3942
3943
    my $dbh = C4::Context->dbh;
3944
3945
    my $is_regex = sub {
3946
        my ( $tag, $m ) = @_;
3947
        # tag is not exactly same as possible regex
3948
        $tag ne $m &&
3949
3950
        # wildcard
3951
        $m ne '*' &&
3952
3953
        # valid tagDataType
3954
        $m !~ /^(0[1-9A-z][\dA-Z]) |
3955
        ([1-9A-z][\dA-z]{2})$/x &&
3956
3957
        # nor valid controltagDataType
3958
        $m !~ /00[1-9A-Za-z]{1}/ &&
3959
3960
        # so we try it as a regex
3961
        $tag =~ /^$m$/
3962
    };
3963
3964
    my $old_record = GetMarcBiblio($biblionumber);
3965
    if ( $old_record ) {
3966
        my $ret_record      = MARC::Record->new();
3967
        my $perm            = GetMarcPermissions() or return $new_record;
3968
        my $marc_struct     = GetMarcStructure(1, $frameworkcode);
3969
        my $similarity_pref = C4::Context->preference("MARCPermissionsCorrectionSimilarity");
3970
        $similarity_pref    = defined $similarity_pref &&
3971
                              $similarity_pref >= 0 &&
3972
                              $similarity_pref <= 100 ?
3973
                              $similarity_pref/100.0 : undef;
3974
3975
        # First came the leader ...
3976
        $ret_record->leader($old_record->leader());
3977
3978
        # ... and then came all the tags in the framework
3979
        for my $tag (sort keys %{$marc_struct}) {
3980
            my @old_fields = $old_record->field($tag);
3981
            my @new_fields = $new_record->field($tag);
3982
            next unless @old_fields or @new_fields;
3983
3984
            my @perms = (
3985
                $perm->{'*'},
3986
                (   # regex tags
3987
                    map { $perm->{$_} }
3988
                      grep { $is_regex->( $tag, $_ ) } sort keys %{$perm}
3989
                ),
3990
                $perm->{$tag}
3991
            );
3992
3993
            # There can be more than one field for each tag, so we have to
3994
            # iterate all fields and distinguish which are new, removed or
3995
            # modified
3996
            my $max_fields = ($#old_fields, $#new_fields)
3997
                             [$#old_fields< $#new_fields];
3998
            for ( my $i_field = 0; $i_field <= $max_fields; $i_field++ ) {
3999
                my $old_field = $old_fields[$i_field];
4000
                my $new_field = $new_fields[$i_field];
4001
4002
                # Existing field
4003
                if ( $old_field and $new_field ) {
4004
                    # Control fields
4005
                    if ( $old_field->is_control_field() ) {
4006
                        # Existing control field
4007
                        if ( $old_field and $new_field ) {
4008
                            my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @perms);
4009
                            if ( defined $on_existing->{action} ) {
4010
                                push @{$log},
4011
                                  {
4012
                                    rule         => $on_existing->{rule},
4013
                                    event        => "existing",
4014
                                    action       => $on_existing->{action},
4015
                                    tag          => $tag,
4016
                                    subfieldcode => undef,
4017
                                    filter       => $filter
4018
                                  };
4019
                                if ( $on_existing->{action} eq 'skip' ) {
4020
                                    $ret_record->insert_fields_ordered($old_field);
4021
                                    next;
4022
                                } elsif ( $on_existing->{action} eq 'overwrite' ) {
4023
                                    $ret_record->insert_fields_ordered($new_field);
4024
                                    next;
4025
                                } elsif ( $on_existing->{action} eq 'add' ) {
4026
                                    $ret_record->insert_fields_ordered($old_field);
4027
                                    $ret_record->insert_fields_ordered($new_field);
4028
                                    next;
4029
                                } elsif ( $on_existing->{action} eq 'add_or_correct' ) {
4030
                                    if ( $similarity_pref ) {
4031
                                        my $similarity = similarity $old_field->data(), $new_field->data();
4032
                                        if ( $similarity >= $similarity_pref ) {
4033
                                            $ret_record->insert_fields_ordered($new_field);
4034
                                        } else {
4035
                                            $ret_record->insert_fields_ordered($old_field);
4036
                                            $ret_record->insert_fields_ordered($new_field);
4037
                                        }
4038
                                    } else {
4039
                                        $ret_record->insert_fields_ordered($old_field);
4040
                                    }
4041
                                }
4042
                            } else { # default to skip
4043
                                $ret_record->insert_fields_ordered($old_field);
4044
                                next;
4045
                            }
4046
                        # New control field
4047
                        } elsif ( not $old_field and $new_field ) {
4048
                            my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms);
4049
                            if ( defined $on_new->{action} ) {
4050
                                push @{$log},
4051
                                  {
4052
                                    rule         => $on_new->{rule},
4053
                                    event        => "new",
4054
                                    action       => $on_new->{action},
4055
                                    tag          => $tag,
4056
                                    subfieldcode => undef,
4057
                                    filter       => $filter
4058
                                  };
4059
                                if ( $on_new->{action} eq 'skip' ) {
4060
                                    next;
4061
                                } elsif ( $on_new->{action} eq 'add' ) {
4062
                                    $ret_record->insert_fields_ordered($new_field);
4063
                                    next;
4064
                                }
4065
                            }
4066
                        # Removed control field
4067
                        } elsif ( $old_field and not $new_field ) {
4068
                            my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms);
4069
                            if ( defined $on_removed->{action} ) {
4070
                                push @{$log},
4071
                                  {
4072
                                    rule         => $on_removed->{rule},
4073
                                    event        => "removed",
4074
                                    action       => $on_removed->{action},
4075
                                    tag          => $tag,
4076
                                    subfieldcode => undef
4077
                                  };
4078
                                if ( $on_removed->{action} eq 'skip' ) {
4079
                                    $ret_record->insert_fields_ordered($old_field);
4080
                                    next;
4081
                                } elsif ( $on_removed->{action} eq 'remove' ) {
4082
                                    next;
4083
                                }
4084
                            } else { # default to skip
4085
                                $ret_record->insert_fields_ordered($old_field);
4086
                                next;
4087
                            }
4088
                        }
4089
                    # Indicators and subfields
4090
                    } else {
4091
                        # Indicators
4092
                        my @old_ind = map { $old_field->indicator($_) } (1,2);
4093
                        my @new_ind = map { $new_field->indicator($_) } (1,2);
4094
                        my @ind = ('','');
4095
4096
                        for my $i ((0,1)) {
4097
                            my @ind_perms = (
4098
                                @perms,
4099
                                $perm->{$tag}->{subfields}->{ 'i' . ( $i + 1 ) }
4100
                            );
4101
4102
                            # Existing indicator
4103
                            if ( defined $old_ind[$i] and defined $new_ind[$i] ) {
4104
                                my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @ind_perms);
4105
                                if ( defined $on_existing->{action} ) {
4106
                                    push @{$log},
4107
                                      {
4108
                                        rule         => $on_existing->{rule},
4109
                                        event        => "existing",
4110
                                        action       => $on_existing->{action},
4111
                                        tag          => $tag,
4112
                                        subfieldcode => 'i' . ( $i + 1 ),
4113
                                        filter       => $filter
4114
                                      };
4115
                                    if ( $on_existing->{action} eq 'skip' ) {
4116
                                        $ind[$i] = $old_ind[$i];
4117
                                    } elsif ( $on_existing->{action} eq 'overwrite' ) {
4118
                                        $ind[$i] = $new_ind[$i];
4119
                                    }
4120
                                } else { # default to skip
4121
                                    $ind[$i] = $old_ind[$i];
4122
                                }
4123
                            # New indicator
4124
                            } elsif ( not defined $old_ind[$i] and defined $new_ind[$i] ) {
4125
                                my $on_new = GetMarcPermissionsAction('on_new', $filter, @ind_perms);
4126
                                if ( defined $on_new->{action} ) {
4127
                                    push @{$log},
4128
                                      {
4129
                                        rule         => $on_new->{rule},
4130
                                        event        => "new",
4131
                                        action       => $on_new->{action},
4132
                                        tag          => $tag,
4133
                                        subfieldcode => 'i' . ( $i + 1 ),
4134
                                        filter       => $filter
4135
                                      };
4136
                                    if ( $on_new->{action} eq 'skip' ) {
4137
                                        $ind[$i] = $old_ind[$i];
4138
                                    } elsif ( $on_new->{action} eq 'add' ) {
4139
                                        $ind[$i] = $new_ind[$i];
4140
                                    }
4141
                                }
4142
                            # Removed indicator
4143
                            } elsif ( defined $old_ind[$i] and not defined $new_ind[$i] ) {
4144
                                my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @ind_perms);
4145
                                if ( defined $on_removed->{action} ) {
4146
                                    push @{$log},
4147
                                      {
4148
                                        rule         => $on_removed->{rule},
4149
                                        event        => "removed",
4150
                                        action       => $on_removed->{action},
4151
                                        tag          => $tag,
4152
                                        subfieldcode => 'i' . ( $i + 1 ),
4153
                                        filter       => $filter
4154
                                      };
4155
                                    if ( $on_removed->{action} eq 'skip' ) {
4156
                                        $ind[$i] = $old_ind[$i];
4157
                                    } elsif ( $on_removed->{action} eq 'remove' ) {
4158
                                        $ind[$i] = '';
4159
                                    }
4160
                                } else { # default to skip
4161
                                    $ind[$i] = $old_ind[$i];
4162
                                }
4163
                            }
4164
                        }
4165
4166
                        # Subfields
4167
                        my @subfields = ();
4168
                        my %proccessed_subcodes = ();
4169
4170
                        # Try to preserve subfield order by first processing
4171
                        # subfields from the old record, and then subfields from
4172
                        # the framework structure unless include in old record.
4173
                        my @sorted_subfields = (
4174
                            map { shift @{$_} } $old_field->subfields(),
4175
                            () = sort keys %{ $marc_struct->{$tag} }
4176
                        );
4177
                        for my $subcode ( @sorted_subfields ) {
4178
                            next if $proccessed_subcodes{$subcode};
4179
                            $proccessed_subcodes{$subcode} = 1;
4180
                            next unless ref $marc_struct->{$tag}{$subcode} eq 'HASH';
4181
                            my @old_subfields = $old_field->subfield($subcode);
4182
                            my @new_subfields = $new_field->subfield($subcode);
4183
                            next unless @old_subfields or @new_subfields;
4184
4185
                            my @subfield_perms = (
4186
                                @perms,
4187
                                $perm->{'*'}->{subfields}->{'*'},
4188
                                $perm->{$tag}->{subfields}->{'*'},
4189
                                (    # tag->regex
4190
                                    map { $perm->{$tag}->{subfields}->{$_} }
4191
                                      grep {
4192
                                        # subcode is not exactly same as
4193
                                        # possible regex
4194
                                        $subcode ne $_ &&
4195
4196
                                        # wildcard, not checking for valid
4197
                                        # subfieldcodeDataType since it
4198
                                        # contains too many regex characters
4199
                                        $_ !~ /^(\*)$/ &&
4200
4201
                                        # so we try it as a regex
4202
                                        $subcode =~ /$_/
4203
                                      } sort
4204
                                      keys %{ $perm->{$tag}->{subfields} }
4205
                                ),
4206
                                (    # regex->*
4207
                                    map { $perm->{$_}->{subfields}->{'*'} }
4208
                                      grep { $is_regex->( $tag, $_ ) }
4209
                                      sort keys %{$perm}
4210
                                ),
4211
                                $perm->{'*'}->{subfields}->{$subcode},
4212
                                (    # regex->subcode
4213
                                    map { $perm->{$_}->{subfields}->{$subcode} }
4214
                                      grep { $is_regex->( $tag, $_ ) }
4215
                                      sort keys %{$perm}
4216
                                ),
4217
                                $perm->{$tag}->{subfields}->{$subcode}
4218
                            );
4219
4220
                            # Existing subfield
4221
                            if ( @old_subfields and @new_subfields ) {
4222
                                my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @subfield_perms);
4223
                                if ( defined $on_existing->{action} ) {
4224
                                    push @{$log},
4225
                                      {
4226
                                        rule         => $on_existing->{rule},
4227
                                        event        => "existing",
4228
                                        action       => $on_existing->{action},
4229
                                        tag          => $tag,
4230
                                        subfieldcode => $subcode,
4231
                                        filter       => $filter
4232
                                      };
4233
                                    if ( $on_existing->{action} eq 'skip' ) {
4234
                                        push(@subfields, map {($subcode,$_)} @old_subfields);
4235
                                        next;
4236
                                    } elsif ( $on_existing->{action} eq 'overwrite' ) {
4237
                                        push(@subfields, map {($subcode,$_)} @new_subfields);
4238
                                        next;
4239
                                    } elsif ( $on_existing->{action} eq 'add' ) {
4240
                                        push(@subfields, map {($subcode,$_)} @old_subfields);
4241
                                        push(@subfields, map {($subcode,$_)} @new_subfields);
4242
                                        next;
4243
                                    } elsif ( $on_existing->{action} eq 'add_or_correct' ) {
4244
                                        if ( $similarity_pref ) {
4245
                                            my @corrected_vals = ();
4246
4247
                                            # correct all old subfields
4248
                                            for ( my $i_new = 0; $i_new <= $#new_subfields; $i_new++ ) {
4249
                                                my $new_val = $new_subfields[$i_new];
4250
                                                for ( my $i_old = 0; $i_old <= $#old_subfields; $i_old++ ) {
4251
                                                    my $old_val = $old_subfields[$i_old];
4252
                                                    next if not defined $old_val or not defined $new_val;
4253
                                                    my $similarity = similarity $old_val, $new_val;
4254
                                                    if ( $similarity >= $similarity_pref ) {
4255
                                                        $corrected_vals[$i_old] = $new_val;
4256
                                                        $new_subfields[$i_new] = undef;
4257
                                                        $old_subfields[$i_old] = undef;
4258
                                                        last;
4259
                                                    }
4260
                                                }
4261
                                            }
4262
4263
                                            # insert all unchanged old subfields
4264
                                            map {
4265
                                                $corrected_vals[$_] = $old_subfields[$_]
4266
                                                    if defined $old_subfields[$_]
4267
                                                } 0 .. $#old_subfields;
4268
4269
4270
                                            # append all remaning new subfields
4271
                                            map {push @corrected_vals, $_ if defined} @new_subfields;
4272
4273
                                            push(@subfields, map {($subcode,$_)} @corrected_vals);
4274
                                        } else {
4275
                                            push(@subfields, map {($subcode,$_)} @old_subfields);
4276
                                        }
4277
                                    }
4278
                                } else { # default to skip
4279
                                    push(@subfields, map {($subcode,$_)} @old_subfields);
4280
                                    next;
4281
                                }
4282
                            # New subfield
4283
                            } elsif ( not @old_subfields and @new_subfields ) {
4284
                                my $on_new = GetMarcPermissionsAction('on_new', $filter, @subfield_perms);
4285
                                if ( defined $on_new->{action} ) {
4286
                                    push @{$log},
4287
                                      {
4288
                                        rule         => $on_new->{rule},
4289
                                        event        => "new",
4290
                                        action       => $on_new->{action},
4291
                                        tag          => $tag,
4292
                                        subfieldcode => $subcode,
4293
                                        filter       => $filter
4294
                                      };
4295
                                    if ( $on_new->{action} eq 'skip' ) {
4296
                                        next;
4297
                                    } elsif ( $on_new->{action} eq 'add' ) {
4298
                                        push(@subfields, map {($subcode,$_)} @new_subfields);
4299
                                        next;
4300
                                    }
4301
                                }
4302
                            # Removed subfield
4303
                            } elsif ( @old_subfields and not @new_subfields ) {
4304
                                my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @subfield_perms);
4305
                                if ( defined $on_removed->{action} ) {
4306
                                    push @{$log},
4307
                                      {
4308
                                        rule         => $on_removed->{rule},
4309
                                        event        => "removed",
4310
                                        action       => $on_removed->{action},
4311
                                        tag          => $tag,
4312
                                        subfieldcode => $subcode,
4313
                                        filter       => $filter
4314
                                      };
4315
                                    if ( $on_removed->{action} eq 'skip' ) {
4316
                                        push(@subfields, ($subcode => @old_subfields));
4317
                                        next;
4318
                                    } elsif ( $on_removed->{action} eq 'remove' ) {
4319
                                        next;
4320
                                    }
4321
                                } else { # default to skip
4322
                                    push(@subfields, ($subcode => @old_subfields));
4323
                                    next;
4324
                                }
4325
                            }
4326
                        } # / for each subfield
4327
                        $ret_record->insert_grouped_field(MARC::Field->new($tag, $ind[0], $ind[1], @subfields));
4328
                    }
4329
                # New field
4330
                } elsif ( not $old_field and $new_field ) {
4331
                    my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms);
4332
                    if ( defined $on_new->{action} ) {
4333
                        push @{$log},
4334
                          {
4335
                            rule         => $on_new->{rule},
4336
                            event        => "new",
4337
                            action       => $on_new->{action},
4338
                            tag          => $tag,
4339
                            subfieldcode => undef,
4340
                            filter       => $filter
4341
                          };
4342
                        if ( $on_new->{action} eq 'skip' ) {
4343
                            next;
4344
                        } elsif ( $on_new->{action} eq 'add' ) {
4345
                            $ret_record->insert_fields_ordered($new_field);
4346
                            next;
4347
                        }
4348
                    }
4349
                # Removed field
4350
                } elsif ( $old_field and not $new_field ) {
4351
                    my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms);
4352
                    if ( defined $on_removed->{action} ) {
4353
                        push @{$log},
4354
                          {
4355
                            rule         => $on_removed->{rule},
4356
                            event        => "removed",
4357
                            action       => $on_removed->{action},
4358
                            tag          => $tag,
4359
                            subfieldcode => undef,
4360
                            filter       => $filter
4361
                          };
4362
                        if ( $on_removed->{action} eq 'skip' ) {
4363
                            $ret_record->insert_grouped_field($old_field);
4364
                            next;
4365
                        } elsif ( $on_removed->{action} eq 'remove' ) {
4366
                            next;
4367
                        }
4368
                    } else { # default to skip
4369
                        $ret_record->insert_grouped_field($old_field);
4370
                        next;
4371
                    }
4372
                }
4373
            } # / for each field
4374
        } # / for each tag
4375
        if ( !$nolog && C4::Context->preference("MARCPermissionsLog") ) {
4376
            my $log_str = '';
4377
            my $n       = $#{$log};
4378
            for my $l ( @{$log} ) {
4379
                $log_str .= "{\n";
4380
                my $kn = keys %{$l};
4381
                for my $k ( sort keys %{$l} ) {
4382
                    if ( $k eq 'filter' ) {
4383
                        $log_str .= "  filter => {\n";
4384
                        my $fkn = keys %{ $l->{$k} };
4385
                        for my $fk ( sort keys %{ $l->{$k} } ) {
4386
                            $log_str .= '    '
4387
                              . $fk . ' => '
4388
                              . $l->{$k}->{$fk}
4389
                              . ( --$fkn ? ',' : '' ) . "\n";
4390
                        }
4391
                        $log_str .= "  }" . ( --$kn ? ',' : '' ) . "\n";
4392
                    }
4393
                    else {
4394
                        $log_str .= '  '
4395
                          . $k . ' => '
4396
                          . $l->{$k}
4397
                          . ( --$kn ? ',' : '' ) . "\n"
4398
                          if defined $l->{$k};
4399
                    }
4400
                }
4401
                $log_str .= '}' . ( $n-- ? ",\n" : '' );
4402
            }
4403
            logaction( "CATALOGUING", "MODIFY", $biblionumber, $log_str );
4404
        }
4405
        return $ret_record;
4406
    }
4407
    return $new_record;
4408
}
4409
4410
4411
=head2 GetMarcPermissions
4412
4413
    my $marc_permissions = GetMarcPermissions()
4414
4415
Loads MARC field permissions from the marc_permissions table.
4416
4417
Returns:
4418
4419
=over 4
4420
4421
=item C<$marc_permissions>
4422
4423
hashref with permissions structure for use with GetMarcPermissionsAction.
4424
4425
=back
4426
4427
=cut
4428
4429
sub GetMarcPermissions {
4430
    my $dbh = C4::Context->dbh;
4431
    my $rule_count = 0;
4432
    my %perms = ();
4433
4434
    my $query = '
4435
    SELECT `marc_permissions`.*,
4436
           `marc_permissions_modules`.`name`,
4437
           `marc_permissions_modules`.`description`,
4438
           `marc_permissions_modules`.`specificity`
4439
    FROM `marc_permissions`
4440
    LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id`
4441
    ORDER BY `marc_permissions_modules`.`specificity`, `id`
4442
    ';
4443
    my $sth = $dbh->prepare($query);
4444
    $sth->execute();
4445
    while ( my $row = $sth->fetchrow_hashref ) {
4446
        $rule_count++;
4447
        if ( defined $row->{tagsubfield} and $row->{tagsubfield} ) {
4448
            $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} }
4449
              ->{on_existing}->{ $row->{name} }->{ $row->{filter} } =
4450
              { action => $row->{on_existing}, rule => $row->{'id'} };
4451
            $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} }
4452
              ->{on_new}->{ $row->{name} }->{ $row->{filter} } =
4453
              { action => $row->{on_new}, rule => $row->{'id'} };
4454
            $perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} }
4455
              ->{on_removed}->{ $row->{name} }->{ $row->{filter} } =
4456
              { action => $row->{on_removed}, rule => $row->{'id'} };
4457
        }
4458
        else {
4459
            $perms{ $row->{tagfield} }->{on_existing}->{ $row->{name} }
4460
              ->{ $row->{filter} } =
4461
              { action => $row->{on_existing}, rule => $row->{'id'} };
4462
            $perms{ $row->{tagfield} }->{on_new}->{ $row->{name} }
4463
              ->{ $row->{filter} } =
4464
              { action => $row->{on_new}, rule => $row->{'id'} };
4465
            $perms{ $row->{tagfield} }->{on_removed}->{ $row->{name} }
4466
              ->{ $row->{filter} } =
4467
              { action => $row->{on_removed}, rule => $row->{'id'} };
4468
        }
4469
    }
4470
4471
    return unless $rule_count;
4472
    return \%perms;
4473
}
4474
4475
=head2 GetMarcPermissionsAction
4476
4477
    my $action = GetMarcPermissionsAction($event, $filter, @permissions)
4478
4479
Gets action based on C<$event>, C<$filter> and C<@permissions>.
4480
4481
=over 4
4482
4483
=item C<$event>
4484
4485
which event: 'on_existing', 'on_new' or 'on_removed'
4486
4487
=item C<$filter>
4488
4489
hashref containing at least one filter module from the marc_permissions_modules
4490
table in form {module => filter}. Three predefined filter modules exists:
4491
4492
    * source
4493
    * category
4494
    * borrower
4495
4496
=item C<@permissions>
4497
4498
list of permission structures in order of specificity from least to most
4499
specific.
4500
4501
=back
4502
4503
Returns:
4504
4505
=over 4
4506
4507
=item C<$action>
4508
4509
hashref defining matching action.
4510
4511
=back
4512
4513
=cut
4514
4515
sub GetMarcPermissionsAction {
4516
    my $what = shift or return;
4517
    my $filter = shift or return;
4518
    my @perms = @_;
4519
4520
    my $modules = GetMarcPermissionsModules();
4521
4522
    my $action = undef;
4523
    for my $perm (@perms) {
4524
        next if not defined $perm;
4525
        next if not defined $perm->{$what};
4526
        my $tmp_action = undef;
4527
4528
        for my $module ( @{$modules} ) {
4529
            if (defined $perm->{$what}->{ $module->{'name'} }
4530
                and
4531
                defined $perm->{$what}->{ $module->{'name'} }->{'*'}->{action} )
4532
            {
4533
                $tmp_action = $perm->{$what}->{ $module->{'name'} }->{'*'};
4534
            }
4535
            if (    defined $filter->{ $module->{'name'} }
4536
                and defined $perm->{$what}->{ $module->{'name'} }
4537
                and defined $perm->{$what}->{ $module->{'name'} }
4538
                ->{ $filter->{ $module->{'name'} } }->{action} )
4539
            {
4540
                $tmp_action = $perm->{$what}->{ $module->{'name'} }
4541
                  ->{ $filter->{ $module->{'name'} } };
4542
            }
4543
        }
4544
4545
        $action = $tmp_action if defined $tmp_action;
4546
    }
4547
4548
    return $action;
4549
}
4550
4551
=head2 GetMarcPermissionsRules
4552
4553
    my $rules = GetMarcPermissionsRules()
4554
4555
Returns:
4556
4557
=over 4
4558
4559
=item C<$rules>
4560
4561
array (in list context, arrayref otherwise) of hashrefs from marc_permissions
4562
table in order of module specificity and rule id.
4563
4564
=back
4565
4566
=cut
4567
4568
sub GetMarcPermissionsRules {
4569
    my $dbh = C4::Context->dbh;
4570
    my @rules = ();
4571
4572
    my $query = '
4573
    SELECT `marc_permissions`.`id`,
4574
           `marc_permissions`.`tagfield`,
4575
           `marc_permissions`.`tagsubfield`,
4576
           `marc_permissions`.`filter`,
4577
           `marc_permissions`.`on_existing`,
4578
           `marc_permissions`.`on_new`,
4579
           `marc_permissions`.`on_removed`,
4580
           `marc_permissions_modules`.`name` as  `module`,
4581
           `marc_permissions_modules`.`description`,
4582
           `marc_permissions_modules`.`specificity`
4583
    FROM `marc_permissions`
4584
    LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id`
4585
    ORDER BY `marc_permissions_modules`.`specificity`, `id`
4586
    ';
4587
    my $sth = $dbh->prepare($query);
4588
    $sth->execute();
4589
    while ( my $row = $sth->fetchrow_hashref ) {
4590
        push(@rules, $row);
4591
    }
4592
4593
    return wantarray ? @rules : \@rules;
4594
}
4595
4596
=head2 GetMarcPermissionsModules
4597
4598
    my $modules = GetMarcPermissionsModules()
4599
4600
Returns:
4601
4602
=over 4
4603
4604
=item C<$modules>
4605
4606
array (in list context, arrayref otherwise) of hashrefs from
4607
marc_permissions_modules table in order of specificity.
4608
4609
=back
4610
4611
=cut
4612
4613
sub GetMarcPermissionsModules {
4614
    my $dbh = C4::Context->dbh;
4615
    my @modules = ();
4616
4617
    my $query = '
4618
    SELECT *
4619
    FROM `marc_permissions_modules`
4620
    ORDER BY `specificity`
4621
    ';
4622
    my $sth = $dbh->prepare($query);
4623
    $sth->execute();
4624
    while ( my $row = $sth->fetchrow_hashref ) {
4625
        push(@modules, $row);
4626
    }
4627
4628
    return wantarray ? @modules : \@modules;
4629
}
4630
4631
=head2 ModMarcPermissionsRule
4632
4633
    my $success = ModMarcPermissionsRule($id, $fields)
4634
4635
Modifies rule in the marc_permissions table.
4636
4637
=over 4
4638
4639
=item C<$id>
4640
4641
rule id to modify
4642
4643
=item C<$fields>
4644
4645
hashref defining the table fields
4646
4647
      * tagfield - required
4648
      * tagsubfield
4649
      * module - required
4650
      * filter - required
4651
      * on_existing - required
4652
      * on_new - required
4653
      * on_removed - required
4654
4655
=back
4656
4657
Returns:
4658
4659
=over 4
4660
4661
=item C<$success>
4662
4663
undef if an error occurs, otherwise true.
4664
4665
=back
4666
4667
=cut
4668
4669
sub ModMarcPermissionsRule {
4670
    my ($id, $f) = @_;
4671
    my $dbh = C4::Context->dbh;
4672
    my $query = '
4673
    UPDATE `marc_permissions`
4674
    SET
4675
      tagfield = ?,
4676
      tagsubfield = ?,
4677
      module = ?,
4678
      filter = ?,
4679
      on_existing = ?,
4680
      on_new = ?,
4681
      on_removed = ?
4682
    WHERE
4683
      id = ?
4684
    ';
4685
    my $sth = $dbh->prepare($query);
4686
    return $sth->execute (
4687
                      $f->{tagfield},
4688
                      $f->{tagsubfield},
4689
                      $f->{module},
4690
                      $f->{filter},
4691
                      $f->{on_existing},
4692
                      $f->{on_new},
4693
                      $f->{on_removed},
4694
                      $id
4695
                  );
4696
}
4697
4698
=head2 AddMarcPermissionsRule
4699
4700
    my $success = AddMarcPermissionsRule($fields)
4701
4702
Add rule to the marc_permissions table.
4703
4704
=over 4
4705
4706
=item C<$fields>
4707
4708
hashref defining the table fields
4709
4710
      tagfield - required
4711
      tagsubfield
4712
      module - required
4713
      filter - required
4714
      on_existing - required
4715
      on_new - required
4716
      on_removed - required
4717
4718
=back
4719
4720
Returns:
4721
4722
=over 4
4723
4724
=item C<$success>
4725
4726
undef if an error occurs, otherwise true.
4727
4728
=back
4729
4730
=cut
4731
4732
sub AddMarcPermissionsRule {
4733
    my $f = shift;
4734
    my $dbh = C4::Context->dbh;
4735
    my $query = '
4736
    INSERT INTO `marc_permissions`
4737
    (
4738
      tagfield,
4739
      tagsubfield,
4740
      module,
4741
      filter,
4742
      on_existing,
4743
      on_new,
4744
      on_removed
4745
    )
4746
    VALUES (?, ?, ?, ?, ?, ?, ?)
4747
    ';
4748
    my $sth = $dbh->prepare($query);
4749
    return $sth->execute (
4750
                      $f->{tagfield},
4751
                      $f->{tagsubfield},
4752
                      $f->{module},
4753
                      $f->{filter},
4754
                      $f->{on_existing},
4755
                      $f->{on_new},
4756
                      $f->{on_removed}
4757
                  );
4758
}
4759
4760
=head2 DelMarcPermissionsRule
4761
4762
    my $success = DelMarcPermissionsRule($id)
4763
4764
Deletes rule from the marc_permissions table.
4765
4766
=over 4
4767
4768
=item C<$id>
4769
4770
rule id to delete
4771
4772
=back
4773
4774
Returns:
4775
4776
=over 4
4777
4778
=item C<$success>
4779
4780
undef if an error occurs, otherwise true.
4781
4782
=back
4783
4784
=cut
4785
4786
sub DelMarcPermissionsRule {
4787
    my $id = shift;
4788
    my $dbh = C4::Context->dbh;
4789
    my $query = '
4790
    DELETE FROM `marc_permissions`
4791
    WHERE
4792
      id = ?
4793
    ';
4794
    my $sth = $dbh->prepare($query);
4795
    return $sth->execute($id);
4796
}
4797
3822
1;
4798
1;
3823
4799
3824
4800
(-)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 (-21 / +9 lines)
Lines 234-257 Cataloging: Link Here
234
234
235
    Exporting:
235
    Exporting:
236
        -
236
        -
237
            - Include following fields when exporting BibTeX,
237
            - When importing records
238
            - pref: BibtexExportAdditionalFields
238
            - pref: MARCPermissions
239
              type: textarea
239
              choices:
240
            - "Use one line per tag in the format BT_TAG: TAG$SUBFIELD ( e.g. lccn: 010$a )"
240
                  yes: "use"
241
            - "<br/>"
241
                  no: "don't use"
242
            - "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] )"
242
            - MARC permissions rules to decide which action to take for each field.
243
            - "<br/>"
243
            - When <b>add_or_correct</b>, consider a field modification to be a correction if the old and new value has a similarity of
244
            - "All values of repeating tags and subfields will be printed with the given BibTeX tag."
244
            - pref: MARCPermissionsCorrectionSimilarity
245
            - "<br/>"
245
            - %. If similarity falls below this value, the new value will be treated as a new field.
246
            - "Use '@' ( with quotes ) as the BT_TAG to replace the bibtex record type with a field value of your choosing."
247
        -
248
            - Include following fields when exporting RIS,
249
            - pref: RisExportAdditionalFields
250
              type: textarea
251
            - "Use one line per tag in the format RIS_TAG: TAG$SUBFIELD ( e.g. LC: 010$a )"
252
            - "<br/>"
253
            - "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] )"
254
            - "<br/>"
255
            - "All values of repeating tags and subfields will be printed with the given RIS tag."
256
            - "<br/>"
257
            - "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