Lines 29-34
use MARC::File::USMARC;
Link Here
|
29 |
use MARC::File::XML; |
29 |
use MARC::File::XML; |
30 |
use POSIX qw(strftime); |
30 |
use POSIX qw(strftime); |
31 |
use Module::Load::Conditional qw(can_load); |
31 |
use Module::Load::Conditional qw(can_load); |
|
|
32 |
use String::Similarity; |
32 |
|
33 |
|
33 |
use C4::Koha; |
34 |
use C4::Koha; |
34 |
use C4::Log; # logaction |
35 |
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 1255-1261
$frameworkcode is optional. If not given, then the default framework is used.
Link Here
|
1255 |
sub GetMarcSubfieldStructureFromKohaField { |
1284 |
sub GetMarcSubfieldStructureFromKohaField { |
1256 |
my ($kohafield, $frameworkcode) = @_; |
1285 |
my ($kohafield, $frameworkcode) = @_; |
1257 |
|
1286 |
|
1258 |
return undef unless $kohafield; |
1287 |
return unless $kohafield; |
1259 |
$frameworkcode //= ''; |
1288 |
$frameworkcode //= ''; |
1260 |
|
1289 |
|
1261 |
my $dbh = C4::Context->dbh; |
1290 |
my $dbh = C4::Context->dbh; |
Lines 2611-2617
our $inverted_field_map;
Link Here
|
2611 |
|
2640 |
|
2612 |
=head2 TransformMarcToKoha |
2641 |
=head2 TransformMarcToKoha |
2613 |
|
2642 |
|
2614 |
$result = TransformMarcToKoha( $record, $frameworkcode ) |
2643 |
$result = TransformMarcToKoha( $record, $frameworkcode, $biblionumber, $filter ) |
2615 |
|
2644 |
|
2616 |
Extract data from a MARC bib record into a hashref representing |
2645 |
Extract data from a MARC bib record into a hashref representing |
2617 |
Koha biblio, biblioitems, and items fields. |
2646 |
Koha biblio, biblioitems, and items fields. |
Lines 2622-2628
hash_ref
Link Here
|
2622 |
=cut |
2651 |
=cut |
2623 |
|
2652 |
|
2624 |
sub TransformMarcToKoha { |
2653 |
sub TransformMarcToKoha { |
2625 |
my ( $record, $frameworkcode, $limit_table ) = @_; |
2654 |
my ( $record, $frameworkcode, $limit_table, $biblionumber, $filter ) = @_; |
2626 |
|
2655 |
|
2627 |
my $result = {}; |
2656 |
my $result = {}; |
2628 |
if (!defined $record) { |
2657 |
if (!defined $record) { |
Lines 2645-2650
sub TransformMarcToKoha {
Link Here
|
2645 |
$tables{'biblioitems'} = 1; |
2674 |
$tables{'biblioitems'} = 1; |
2646 |
} |
2675 |
} |
2647 |
|
2676 |
|
|
|
2677 |
# apply permissions |
2678 |
if ( C4::Context->preference('MARCPermissions') && $biblionumber && $filter) { |
2679 |
$record = ApplyMarcPermissions({ |
2680 |
biblionumber => $biblionumber, |
2681 |
record => $record, |
2682 |
frameworkcode => $frameworkcode, |
2683 |
filter => $filter, |
2684 |
nolog => 1 |
2685 |
}); |
2686 |
} |
2687 |
|
2648 |
# traverse through record |
2688 |
# traverse through record |
2649 |
MARCFIELD: foreach my $field ( $record->fields() ) { |
2689 |
MARCFIELD: foreach my $field ( $record->fields() ) { |
2650 |
my $tag = $field->tag(); |
2690 |
my $tag = $field->tag(); |
Lines 2941-2950
sub ModZebra {
Link Here
|
2941 |
# replaced by a zebraqueue table, that is filled with ModZebra to run. |
2981 |
# replaced by a zebraqueue table, that is filled with ModZebra to run. |
2942 |
# the table is emptied by rebuild_zebra.pl script (using the -z switch) |
2982 |
# the table is emptied by rebuild_zebra.pl script (using the -z switch) |
2943 |
my $check_sql = "SELECT COUNT(*) FROM zebraqueue |
2983 |
my $check_sql = "SELECT COUNT(*) FROM zebraqueue |
2944 |
WHERE server = ? |
2984 |
WHERE server = ? |
2945 |
AND biblio_auth_number = ? |
2985 |
AND biblio_auth_number = ? |
2946 |
AND operation = ? |
2986 |
AND operation = ? |
2947 |
AND done = 0"; |
2987 |
AND done = 0"; |
2948 |
my $check_sth = $dbh->prepare_cached($check_sql); |
2988 |
my $check_sth = $dbh->prepare_cached($check_sql); |
2949 |
$check_sth->execute( $server, $biblionumber, $op ); |
2989 |
$check_sth->execute( $server, $biblionumber, $op ); |
2950 |
my ($count) = $check_sth->fetchrow_array; |
2990 |
my ($count) = $check_sth->fetchrow_array; |
Lines 3440-3446
sub _koha_delete_biblioitems {
Link Here
|
3440 |
|
3480 |
|
3441 |
=head2 ModBiblioMarc |
3481 |
=head2 ModBiblioMarc |
3442 |
|
3482 |
|
3443 |
&ModBiblioMarc($newrec,$biblionumber,$frameworkcode); |
3483 |
&ModBiblioMarc($newrec,$biblionumber,$frameworkcode,$filter); |
3444 |
|
3484 |
|
3445 |
Add MARC data for a biblio to koha |
3485 |
Add MARC data for a biblio to koha |
3446 |
|
3486 |
|
Lines 3451-3457
Function exported, but should NOT be used, unless you really know what you're do
Link Here
|
3451 |
sub ModBiblioMarc { |
3491 |
sub ModBiblioMarc { |
3452 |
# pass the MARC::Record to this function, and it will create the records in |
3492 |
# pass the MARC::Record to this function, and it will create the records in |
3453 |
# the marc field |
3493 |
# the marc field |
3454 |
my ( $record, $biblionumber, $frameworkcode ) = @_; |
3494 |
my ( $record, $biblionumber, $frameworkcode, $filter ) = @_; |
|
|
3495 |
|
3455 |
if ( !$record ) { |
3496 |
if ( !$record ) { |
3456 |
carp 'ModBiblioMarc passed an undefined record'; |
3497 |
carp 'ModBiblioMarc passed an undefined record'; |
3457 |
return; |
3498 |
return; |
Lines 3497-3502
sub ModBiblioMarc {
Link Here
|
3497 |
$f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005; |
3538 |
$f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005; |
3498 |
} |
3539 |
} |
3499 |
|
3540 |
|
|
|
3541 |
# apply permissions |
3542 |
if ( C4::Context->preference('MARCPermissions') ) { |
3543 |
$record = ApplyMarcPermissions({ |
3544 |
biblionumber => $biblionumber, |
3545 |
record => $record, |
3546 |
frameworkcode => $frameworkcode, |
3547 |
filter => $filter |
3548 |
}); |
3549 |
} |
3550 |
|
3500 |
$sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?"); |
3551 |
$sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?"); |
3501 |
$sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber ); |
3552 |
$sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber ); |
3502 |
$sth->finish; |
3553 |
$sth->finish; |
Lines 3793-3798
sub RemoveAllNsb {
Link Here
|
3793 |
return $record; |
3844 |
return $record; |
3794 |
} |
3845 |
} |
3795 |
|
3846 |
|
|
|
3847 |
=head2 ApplyMarcPermissions |
3848 |
|
3849 |
my $record = ApplyMarcPermissions($arguments) |
3850 |
|
3851 |
Applies marc permission rules to a record. |
3852 |
|
3853 |
C<$arguments> is expected to be a hashref with below keys defined. |
3854 |
|
3855 |
=over 4 |
3856 |
|
3857 |
=item C<biblionumber> |
3858 |
biblionumber of old record |
3859 |
|
3860 |
=item C<record> |
3861 |
record that will modify old record |
3862 |
|
3863 |
=item C<frameworkcode> |
3864 |
only tags included in framework will be processed |
3865 |
|
3866 |
=item C<filter> |
3867 |
hashref containing at least one filter module from the marc_permissions_modules |
3868 |
table in form {module => filter}. Three predefined filter modules exists: |
3869 |
|
3870 |
* source |
3871 |
* category |
3872 |
* borrower |
3873 |
|
3874 |
=item C<log> |
3875 |
optional reference to array that will be filled with rule evaluation log |
3876 |
entries. |
3877 |
|
3878 |
=item C<nolog> |
3879 |
optional boolean which when true disables logging to action log. |
3880 |
|
3881 |
=back |
3882 |
|
3883 |
Returns: |
3884 |
|
3885 |
=over 4 |
3886 |
|
3887 |
=item C<$record> |
3888 |
|
3889 |
new MARC record based on C<record> with C<filter> applied. If no old |
3890 |
record for C<biblionumber> can be found, C<record> is returned unchanged. |
3891 |
Default action when no matching filter found is to leave old record unchanged. |
3892 |
|
3893 |
=back |
3894 |
|
3895 |
=cut |
3896 |
|
3897 |
sub ApplyMarcPermissions { |
3898 |
my $arguments = shift; |
3899 |
my $biblionumber = $arguments->{biblionumber}; |
3900 |
my $new_record = $arguments->{record}; |
3901 |
my $frameworkcode = $arguments->{frameworkcode} || ''; |
3902 |
|
3903 |
if ( !$biblionumber ) { |
3904 |
carp 'ApplyMarcPermissions called on undefined biblionumber'; |
3905 |
return; |
3906 |
} |
3907 |
if ( !$new_record ) { |
3908 |
carp 'ApplyMarcPermissions called on undefined record'; |
3909 |
return; |
3910 |
} |
3911 |
my $filter = $arguments->{filter} |
3912 |
or return $new_record; |
3913 |
|
3914 |
my $log = $arguments->{log} || []; |
3915 |
my $nolog = $arguments->{nolog}; |
3916 |
|
3917 |
my $dbh = C4::Context->dbh; |
3918 |
|
3919 |
my $is_regex = sub { |
3920 |
my ( $tag, $m ) = @_; |
3921 |
# tag is not exactly same as possible regex |
3922 |
$tag ne $m && |
3923 |
|
3924 |
# wildcard |
3925 |
$m ne '*' && |
3926 |
|
3927 |
# valid tagDataType |
3928 |
$m !~ /^(0[1-9A-z][\dA-Z]) | |
3929 |
([1-9A-z][\dA-z]{2})$/x && |
3930 |
|
3931 |
# nor valid controltagDataType |
3932 |
$m !~ /00[1-9A-Za-z]{1}/ && |
3933 |
|
3934 |
# so we try it as a regex |
3935 |
$tag =~ /^$m$/ |
3936 |
}; |
3937 |
|
3938 |
my $old_record = GetMarcBiblio($biblionumber); |
3939 |
if ( $old_record ) { |
3940 |
my $ret_record = MARC::Record->new(); |
3941 |
my $perm = GetMarcPermissions() or return $new_record; |
3942 |
my $marc_struct = GetMarcStructure(1, $frameworkcode); |
3943 |
my $similarity_pref = C4::Context->preference("MARCPermissionsCorrectionSimilarity"); |
3944 |
$similarity_pref = defined $similarity_pref && |
3945 |
$similarity_pref >= 0 && |
3946 |
$similarity_pref <= 100 ? |
3947 |
$similarity_pref/100.0 : undef; |
3948 |
|
3949 |
# First came the leader ... |
3950 |
$ret_record->leader($old_record->leader()); |
3951 |
|
3952 |
# ... and then came all the tags in the framework |
3953 |
for my $tag (sort keys %{$marc_struct}) { |
3954 |
my @old_fields = $old_record->field($tag); |
3955 |
my @new_fields = $new_record->field($tag); |
3956 |
next unless @old_fields or @new_fields; |
3957 |
|
3958 |
my @perms = ( |
3959 |
$perm->{'*'}, |
3960 |
( # regex tags |
3961 |
map { $perm->{$_} } |
3962 |
grep { $is_regex->( $tag, $_ ) } sort keys %{$perm} |
3963 |
), |
3964 |
$perm->{$tag} |
3965 |
); |
3966 |
|
3967 |
# There can be more than one field for each tag, so we have to |
3968 |
# iterate all fields and distinguish which are new, removed or |
3969 |
# modified |
3970 |
my $max_fields = ($#old_fields, $#new_fields) |
3971 |
[$#old_fields< $#new_fields]; |
3972 |
for ( my $i_field = 0; $i_field <= $max_fields; $i_field++ ) { |
3973 |
my $old_field = $old_fields[$i_field]; |
3974 |
my $new_field = $new_fields[$i_field]; |
3975 |
|
3976 |
# Existing field |
3977 |
if ( $old_field and $new_field ) { |
3978 |
# Control fields |
3979 |
if ( $old_field->is_control_field() ) { |
3980 |
# Existing control field |
3981 |
if ( $old_field and $new_field ) { |
3982 |
my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @perms); |
3983 |
if ( defined $on_existing->{action} ) { |
3984 |
push @{$log}, |
3985 |
{ |
3986 |
rule => $on_existing->{rule}, |
3987 |
event => "existing", |
3988 |
action => $on_existing->{action}, |
3989 |
tag => $tag, |
3990 |
subfieldcode => undef, |
3991 |
filter => $filter |
3992 |
}; |
3993 |
if ( $on_existing->{action} eq 'skip' ) { |
3994 |
$ret_record->insert_fields_ordered($old_field); |
3995 |
next; |
3996 |
} elsif ( $on_existing->{action} eq 'overwrite' ) { |
3997 |
$ret_record->insert_fields_ordered($new_field); |
3998 |
next; |
3999 |
} elsif ( $on_existing->{action} eq 'add' ) { |
4000 |
$ret_record->insert_fields_ordered($old_field); |
4001 |
$ret_record->insert_fields_ordered($new_field); |
4002 |
next; |
4003 |
} elsif ( $on_existing->{action} eq 'add_or_correct' ) { |
4004 |
if ( $similarity_pref ) { |
4005 |
my $similarity = similarity $old_field->data(), $new_field->data(); |
4006 |
if ( $similarity >= $similarity_pref ) { |
4007 |
$ret_record->insert_fields_ordered($new_field); |
4008 |
} else { |
4009 |
$ret_record->insert_fields_ordered($old_field); |
4010 |
$ret_record->insert_fields_ordered($new_field); |
4011 |
} |
4012 |
} else { |
4013 |
$ret_record->insert_fields_ordered($old_field); |
4014 |
} |
4015 |
} |
4016 |
} else { # default to skip |
4017 |
$ret_record->insert_fields_ordered($old_field); |
4018 |
next; |
4019 |
} |
4020 |
# New control field |
4021 |
} elsif ( not $old_field and $new_field ) { |
4022 |
my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms); |
4023 |
if ( defined $on_new->{action} ) { |
4024 |
push @{$log}, |
4025 |
{ |
4026 |
rule => $on_new->{rule}, |
4027 |
event => "new", |
4028 |
action => $on_new->{action}, |
4029 |
tag => $tag, |
4030 |
subfieldcode => undef, |
4031 |
filter => $filter |
4032 |
}; |
4033 |
if ( $on_new->{action} eq 'skip' ) { |
4034 |
next; |
4035 |
} elsif ( $on_new->{action} eq 'add' ) { |
4036 |
$ret_record->insert_fields_ordered($new_field); |
4037 |
next; |
4038 |
} |
4039 |
} |
4040 |
# Removed control field |
4041 |
} elsif ( $old_field and not $new_field ) { |
4042 |
my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms); |
4043 |
if ( defined $on_removed->{action} ) { |
4044 |
push @{$log}, |
4045 |
{ |
4046 |
rule => $on_removed->{rule}, |
4047 |
event => "removed", |
4048 |
action => $on_removed->{action}, |
4049 |
tag => $tag, |
4050 |
subfieldcode => undef |
4051 |
}; |
4052 |
if ( $on_removed->{action} eq 'skip' ) { |
4053 |
$ret_record->insert_fields_ordered($old_field); |
4054 |
next; |
4055 |
} elsif ( $on_removed->{action} eq 'remove' ) { |
4056 |
next; |
4057 |
} |
4058 |
} else { # default to skip |
4059 |
$ret_record->insert_fields_ordered($old_field); |
4060 |
next; |
4061 |
} |
4062 |
} |
4063 |
# Indicators and subfields |
4064 |
} else { |
4065 |
# Indicators |
4066 |
my @old_ind = map { $old_field->indicator($_) } (1,2); |
4067 |
my @new_ind = map { $new_field->indicator($_) } (1,2); |
4068 |
my @ind = ('',''); |
4069 |
|
4070 |
for my $i ((0,1)) { |
4071 |
my @ind_perms = ( |
4072 |
@perms, |
4073 |
$perm->{$tag}->{subfields}->{ 'i' . ( $i + 1 ) } |
4074 |
); |
4075 |
|
4076 |
# Existing indicator |
4077 |
if ( defined $old_ind[$i] and defined $new_ind[$i] ) { |
4078 |
my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @ind_perms); |
4079 |
if ( defined $on_existing->{action} ) { |
4080 |
push @{$log}, |
4081 |
{ |
4082 |
rule => $on_existing->{rule}, |
4083 |
event => "existing", |
4084 |
action => $on_existing->{action}, |
4085 |
tag => $tag, |
4086 |
subfieldcode => 'i' . ( $i + 1 ), |
4087 |
filter => $filter |
4088 |
}; |
4089 |
if ( $on_existing->{action} eq 'skip' ) { |
4090 |
$ind[$i] = $old_ind[$i]; |
4091 |
} elsif ( $on_existing->{action} eq 'overwrite' ) { |
4092 |
$ind[$i] = $new_ind[$i]; |
4093 |
} |
4094 |
} else { # default to skip |
4095 |
$ind[$i] = $old_ind[$i]; |
4096 |
} |
4097 |
# New indicator |
4098 |
} elsif ( not defined $old_ind[$i] and defined $new_ind[$i] ) { |
4099 |
my $on_new = GetMarcPermissionsAction('on_new', $filter, @ind_perms); |
4100 |
if ( defined $on_new->{action} ) { |
4101 |
push @{$log}, |
4102 |
{ |
4103 |
rule => $on_new->{rule}, |
4104 |
event => "new", |
4105 |
action => $on_new->{action}, |
4106 |
tag => $tag, |
4107 |
subfieldcode => 'i' . ( $i + 1 ), |
4108 |
filter => $filter |
4109 |
}; |
4110 |
if ( $on_new->{action} eq 'skip' ) { |
4111 |
$ind[$i] = $old_ind[$i]; |
4112 |
} elsif ( $on_new->{action} eq 'add' ) { |
4113 |
$ind[$i] = $new_ind[$i]; |
4114 |
} |
4115 |
} |
4116 |
# Removed indicator |
4117 |
} elsif ( defined $old_ind[$i] and not defined $new_ind[$i] ) { |
4118 |
my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @ind_perms); |
4119 |
if ( defined $on_removed->{action} ) { |
4120 |
push @{$log}, |
4121 |
{ |
4122 |
rule => $on_removed->{rule}, |
4123 |
event => "removed", |
4124 |
action => $on_removed->{action}, |
4125 |
tag => $tag, |
4126 |
subfieldcode => 'i' . ( $i + 1 ), |
4127 |
filter => $filter |
4128 |
}; |
4129 |
if ( $on_removed->{action} eq 'skip' ) { |
4130 |
$ind[$i] = $old_ind[$i]; |
4131 |
} elsif ( $on_removed->{action} eq 'remove' ) { |
4132 |
$ind[$i] = ''; |
4133 |
} |
4134 |
} else { # default to skip |
4135 |
$ind[$i] = $old_ind[$i]; |
4136 |
} |
4137 |
} |
4138 |
} |
4139 |
|
4140 |
# Subfields |
4141 |
my @subfields = (); |
4142 |
my %proccessed_subcodes = (); |
4143 |
|
4144 |
# Try to preserve subfield order by first processing |
4145 |
# subfields from the old record, and then subfields from |
4146 |
# the framework structure unless include in old record. |
4147 |
my @sorted_subfields = ( |
4148 |
map { shift @{$_} } $old_field->subfields(), |
4149 |
() = sort keys %{ $marc_struct->{$tag} } |
4150 |
); |
4151 |
for my $subcode ( @sorted_subfields ) { |
4152 |
next if $proccessed_subcodes{$subcode}; |
4153 |
$proccessed_subcodes{$subcode} = 1; |
4154 |
next unless ref $marc_struct->{$tag}{$subcode} eq 'HASH'; |
4155 |
my @old_subfields = $old_field->subfield($subcode); |
4156 |
my @new_subfields = $new_field->subfield($subcode); |
4157 |
next unless @old_subfields or @new_subfields; |
4158 |
|
4159 |
my @subfield_perms = ( |
4160 |
@perms, |
4161 |
$perm->{'*'}->{subfields}->{'*'}, |
4162 |
$perm->{$tag}->{subfields}->{'*'}, |
4163 |
( # tag->regex |
4164 |
map { $perm->{$tag}->{subfields}->{$_} } |
4165 |
grep { |
4166 |
# subcode is not exactly same as |
4167 |
# possible regex |
4168 |
$subcode ne $_ && |
4169 |
|
4170 |
# wildcard, not checking for valid |
4171 |
# subfieldcodeDataType since it |
4172 |
# contains too many regex characters |
4173 |
$_ !~ /^(\*)$/ && |
4174 |
|
4175 |
# so we try it as a regex |
4176 |
$subcode =~ /$_/ |
4177 |
} sort |
4178 |
keys %{ $perm->{$tag}->{subfields} } |
4179 |
), |
4180 |
( # regex->* |
4181 |
map { $perm->{$_}->{subfields}->{'*'} } |
4182 |
grep { $is_regex->( $tag, $_ ) } |
4183 |
sort keys %{$perm} |
4184 |
), |
4185 |
$perm->{'*'}->{subfields}->{$subcode}, |
4186 |
( # regex->subcode |
4187 |
map { $perm->{$_}->{subfields}->{$subcode} } |
4188 |
grep { $is_regex->( $tag, $_ ) } |
4189 |
sort keys %{$perm} |
4190 |
), |
4191 |
$perm->{$tag}->{subfields}->{$subcode} |
4192 |
); |
4193 |
|
4194 |
# Existing subfield |
4195 |
if ( @old_subfields and @new_subfields ) { |
4196 |
my $on_existing = GetMarcPermissionsAction('on_existing', $filter, @subfield_perms); |
4197 |
if ( defined $on_existing->{action} ) { |
4198 |
push @{$log}, |
4199 |
{ |
4200 |
rule => $on_existing->{rule}, |
4201 |
event => "existing", |
4202 |
action => $on_existing->{action}, |
4203 |
tag => $tag, |
4204 |
subfieldcode => $subcode, |
4205 |
filter => $filter |
4206 |
}; |
4207 |
if ( $on_existing->{action} eq 'skip' ) { |
4208 |
push(@subfields, map {($subcode,$_)} @old_subfields); |
4209 |
next; |
4210 |
} elsif ( $on_existing->{action} eq 'overwrite' ) { |
4211 |
push(@subfields, map {($subcode,$_)} @new_subfields); |
4212 |
next; |
4213 |
} elsif ( $on_existing->{action} eq 'add' ) { |
4214 |
push(@subfields, map {($subcode,$_)} @old_subfields); |
4215 |
push(@subfields, map {($subcode,$_)} @new_subfields); |
4216 |
next; |
4217 |
} elsif ( $on_existing->{action} eq 'add_or_correct' ) { |
4218 |
if ( $similarity_pref ) { |
4219 |
my @corrected_vals = (); |
4220 |
|
4221 |
# correct all old subfields |
4222 |
for ( my $i_new = 0; $i_new <= $#new_subfields; $i_new++ ) { |
4223 |
my $new_val = $new_subfields[$i_new]; |
4224 |
for ( my $i_old = 0; $i_old <= $#old_subfields; $i_old++ ) { |
4225 |
my $old_val = $old_subfields[$i_old]; |
4226 |
next if not defined $old_val or not defined $new_val; |
4227 |
my $similarity = similarity $old_val, $new_val; |
4228 |
if ( $similarity >= $similarity_pref ) { |
4229 |
$corrected_vals[$i_old] = $new_val; |
4230 |
$new_subfields[$i_new] = undef; |
4231 |
$old_subfields[$i_old] = undef; |
4232 |
last; |
4233 |
} |
4234 |
} |
4235 |
} |
4236 |
|
4237 |
# insert all unchanged old subfields |
4238 |
map { |
4239 |
$corrected_vals[$_] = $old_subfields[$_] |
4240 |
if defined $old_subfields[$_] |
4241 |
} 0 .. $#old_subfields; |
4242 |
|
4243 |
|
4244 |
# append all remaning new subfields |
4245 |
map {push @corrected_vals, $_ if defined} @new_subfields; |
4246 |
|
4247 |
push(@subfields, map {($subcode,$_)} @corrected_vals); |
4248 |
} else { |
4249 |
push(@subfields, map {($subcode,$_)} @old_subfields); |
4250 |
} |
4251 |
} |
4252 |
} else { # default to skip |
4253 |
push(@subfields, map {($subcode,$_)} @old_subfields); |
4254 |
next; |
4255 |
} |
4256 |
# New subfield |
4257 |
} elsif ( not @old_subfields and @new_subfields ) { |
4258 |
my $on_new = GetMarcPermissionsAction('on_new', $filter, @subfield_perms); |
4259 |
if ( defined $on_new->{action} ) { |
4260 |
push @{$log}, |
4261 |
{ |
4262 |
rule => $on_new->{rule}, |
4263 |
event => "new", |
4264 |
action => $on_new->{action}, |
4265 |
tag => $tag, |
4266 |
subfieldcode => $subcode, |
4267 |
filter => $filter |
4268 |
}; |
4269 |
if ( $on_new->{action} eq 'skip' ) { |
4270 |
next; |
4271 |
} elsif ( $on_new->{action} eq 'add' ) { |
4272 |
push(@subfields, map {($subcode,$_)} @new_subfields); |
4273 |
next; |
4274 |
} |
4275 |
} |
4276 |
# Removed subfield |
4277 |
} elsif ( @old_subfields and not @new_subfields ) { |
4278 |
my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @subfield_perms); |
4279 |
if ( defined $on_removed->{action} ) { |
4280 |
push @{$log}, |
4281 |
{ |
4282 |
rule => $on_removed->{rule}, |
4283 |
event => "removed", |
4284 |
action => $on_removed->{action}, |
4285 |
tag => $tag, |
4286 |
subfieldcode => $subcode, |
4287 |
filter => $filter |
4288 |
}; |
4289 |
if ( $on_removed->{action} eq 'skip' ) { |
4290 |
push(@subfields, ($subcode => @old_subfields)); |
4291 |
next; |
4292 |
} elsif ( $on_removed->{action} eq 'remove' ) { |
4293 |
next; |
4294 |
} |
4295 |
} else { # default to skip |
4296 |
push(@subfields, ($subcode => @old_subfields)); |
4297 |
next; |
4298 |
} |
4299 |
} |
4300 |
} # / for each subfield |
4301 |
$ret_record->insert_grouped_field(MARC::Field->new($tag, $ind[0], $ind[1], @subfields)); |
4302 |
} |
4303 |
# New field |
4304 |
} elsif ( not $old_field and $new_field ) { |
4305 |
my $on_new = GetMarcPermissionsAction('on_new', $filter, @perms); |
4306 |
if ( defined $on_new->{action} ) { |
4307 |
push @{$log}, |
4308 |
{ |
4309 |
rule => $on_new->{rule}, |
4310 |
event => "new", |
4311 |
action => $on_new->{action}, |
4312 |
tag => $tag, |
4313 |
subfieldcode => undef, |
4314 |
filter => $filter |
4315 |
}; |
4316 |
if ( $on_new->{action} eq 'skip' ) { |
4317 |
next; |
4318 |
} elsif ( $on_new->{action} eq 'add' ) { |
4319 |
$ret_record->insert_fields_ordered($new_field); |
4320 |
next; |
4321 |
} |
4322 |
} |
4323 |
# Removed field |
4324 |
} elsif ( $old_field and not $new_field ) { |
4325 |
my $on_removed = GetMarcPermissionsAction('on_removed', $filter, @perms); |
4326 |
if ( defined $on_removed->{action} ) { |
4327 |
push @{$log}, |
4328 |
{ |
4329 |
rule => $on_removed->{rule}, |
4330 |
event => "removed", |
4331 |
action => $on_removed->{action}, |
4332 |
tag => $tag, |
4333 |
subfieldcode => undef, |
4334 |
filter => $filter |
4335 |
}; |
4336 |
if ( $on_removed->{action} eq 'skip' ) { |
4337 |
$ret_record->insert_grouped_field($old_field); |
4338 |
next; |
4339 |
} elsif ( $on_removed->{action} eq 'remove' ) { |
4340 |
next; |
4341 |
} |
4342 |
} else { # default to skip |
4343 |
$ret_record->insert_grouped_field($old_field); |
4344 |
next; |
4345 |
} |
4346 |
} |
4347 |
} # / for each field |
4348 |
} # / for each tag |
4349 |
if ( !$nolog && C4::Context->preference("MARCPermissionsLog") ) { |
4350 |
my $log_str = ''; |
4351 |
my $n = $#{$log}; |
4352 |
for my $l ( @{$log} ) { |
4353 |
$log_str .= "{\n"; |
4354 |
my $kn = keys %{$l}; |
4355 |
for my $k ( sort keys %{$l} ) { |
4356 |
if ( $k eq 'filter' ) { |
4357 |
$log_str .= " filter => {\n"; |
4358 |
my $fkn = keys %{ $l->{$k} }; |
4359 |
for my $fk ( sort keys %{ $l->{$k} } ) { |
4360 |
$log_str .= ' ' |
4361 |
. $fk . ' => ' |
4362 |
. $l->{$k}->{$fk} |
4363 |
. ( --$fkn ? ',' : '' ) . "\n"; |
4364 |
} |
4365 |
$log_str .= " }" . ( --$kn ? ',' : '' ) . "\n"; |
4366 |
} |
4367 |
else { |
4368 |
$log_str .= ' ' |
4369 |
. $k . ' => ' |
4370 |
. $l->{$k} |
4371 |
. ( --$kn ? ',' : '' ) . "\n" |
4372 |
if defined $l->{$k}; |
4373 |
} |
4374 |
} |
4375 |
$log_str .= '}' . ( $n-- ? ",\n" : '' ); |
4376 |
} |
4377 |
logaction( "CATALOGUING", "MODIFY", $biblionumber, $log_str ); |
4378 |
} |
4379 |
return $ret_record; |
4380 |
} |
4381 |
return $new_record; |
4382 |
} |
4383 |
|
4384 |
|
4385 |
=head2 GetMarcPermissions |
4386 |
|
4387 |
my $marc_permissions = GetMarcPermissions() |
4388 |
|
4389 |
Loads MARC field permissions from the marc_permissions table. |
4390 |
|
4391 |
Returns: |
4392 |
|
4393 |
=over 4 |
4394 |
|
4395 |
=item C<$marc_permissions> |
4396 |
|
4397 |
hashref with permissions structure for use with GetMarcPermissionsAction. |
4398 |
|
4399 |
=back |
4400 |
|
4401 |
=cut |
4402 |
|
4403 |
sub GetMarcPermissions { |
4404 |
my $dbh = C4::Context->dbh; |
4405 |
my $rule_count = 0; |
4406 |
my %perms = (); |
4407 |
|
4408 |
my $query = ' |
4409 |
SELECT `marc_permissions`.*, |
4410 |
`marc_permissions_modules`.`name`, |
4411 |
`marc_permissions_modules`.`description`, |
4412 |
`marc_permissions_modules`.`specificity` |
4413 |
FROM `marc_permissions` |
4414 |
LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` |
4415 |
ORDER BY `marc_permissions_modules`.`specificity`, `id` |
4416 |
'; |
4417 |
my $sth = $dbh->prepare($query); |
4418 |
$sth->execute(); |
4419 |
while ( my $row = $sth->fetchrow_hashref ) { |
4420 |
$rule_count++; |
4421 |
if ( defined $row->{tagsubfield} and $row->{tagsubfield} ) { |
4422 |
$perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} } |
4423 |
->{on_existing}->{ $row->{name} }->{ $row->{filter} } = |
4424 |
{ action => $row->{on_existing}, rule => $row->{'id'} }; |
4425 |
$perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} } |
4426 |
->{on_new}->{ $row->{name} }->{ $row->{filter} } = |
4427 |
{ action => $row->{on_new}, rule => $row->{'id'} }; |
4428 |
$perms{ $row->{tagfield} }->{subfields}->{ $row->{tagsubfield} } |
4429 |
->{on_removed}->{ $row->{name} }->{ $row->{filter} } = |
4430 |
{ action => $row->{on_removed}, rule => $row->{'id'} }; |
4431 |
} |
4432 |
else { |
4433 |
$perms{ $row->{tagfield} }->{on_existing}->{ $row->{name} } |
4434 |
->{ $row->{filter} } = |
4435 |
{ action => $row->{on_existing}, rule => $row->{'id'} }; |
4436 |
$perms{ $row->{tagfield} }->{on_new}->{ $row->{name} } |
4437 |
->{ $row->{filter} } = |
4438 |
{ action => $row->{on_new}, rule => $row->{'id'} }; |
4439 |
$perms{ $row->{tagfield} }->{on_removed}->{ $row->{name} } |
4440 |
->{ $row->{filter} } = |
4441 |
{ action => $row->{on_removed}, rule => $row->{'id'} }; |
4442 |
} |
4443 |
} |
4444 |
|
4445 |
return unless $rule_count; |
4446 |
return \%perms; |
4447 |
} |
4448 |
|
4449 |
=head2 GetMarcPermissionsAction |
4450 |
|
4451 |
my $action = GetMarcPermissionsAction($event, $filter, @permissions) |
4452 |
|
4453 |
Gets action based on C<$event>, C<$filter> and C<@permissions>. |
4454 |
|
4455 |
=over 4 |
4456 |
|
4457 |
=item C<$event> |
4458 |
|
4459 |
which event: 'on_existing', 'on_new' or 'on_removed' |
4460 |
|
4461 |
=item C<$filter> |
4462 |
|
4463 |
hashref containing at least one filter module from the marc_permissions_modules |
4464 |
table in form {module => filter}. Three predefined filter modules exists: |
4465 |
|
4466 |
* source |
4467 |
* category |
4468 |
* borrower |
4469 |
|
4470 |
=item C<@permissions> |
4471 |
|
4472 |
list of permission structures in order of specificity from least to most |
4473 |
specific. |
4474 |
|
4475 |
=back |
4476 |
|
4477 |
Returns: |
4478 |
|
4479 |
=over 4 |
4480 |
|
4481 |
=item C<$action> |
4482 |
|
4483 |
hashref defining matching action. |
4484 |
|
4485 |
=back |
4486 |
|
4487 |
=cut |
4488 |
|
4489 |
sub GetMarcPermissionsAction { |
4490 |
my $what = shift or return; |
4491 |
my $filter = shift or return; |
4492 |
my @perms = @_; |
4493 |
|
4494 |
my $modules = GetMarcPermissionsModules(); |
4495 |
|
4496 |
my $action = undef; |
4497 |
for my $perm (@perms) { |
4498 |
next if not defined $perm; |
4499 |
next if not defined $perm->{$what}; |
4500 |
my $tmp_action = undef; |
4501 |
|
4502 |
for my $module ( @{$modules} ) { |
4503 |
if (defined $perm->{$what}->{ $module->{'name'} } |
4504 |
and |
4505 |
defined $perm->{$what}->{ $module->{'name'} }->{'*'}->{action} ) |
4506 |
{ |
4507 |
$tmp_action = $perm->{$what}->{ $module->{'name'} }->{'*'}; |
4508 |
} |
4509 |
if ( defined $filter->{ $module->{'name'} } |
4510 |
and defined $perm->{$what}->{ $module->{'name'} } |
4511 |
and defined $perm->{$what}->{ $module->{'name'} } |
4512 |
->{ $filter->{ $module->{'name'} } }->{action} ) |
4513 |
{ |
4514 |
$tmp_action = $perm->{$what}->{ $module->{'name'} } |
4515 |
->{ $filter->{ $module->{'name'} } }; |
4516 |
} |
4517 |
} |
4518 |
|
4519 |
$action = $tmp_action if defined $tmp_action; |
4520 |
} |
4521 |
|
4522 |
return $action; |
4523 |
} |
4524 |
|
4525 |
=head2 GetMarcPermissionsRules |
4526 |
|
4527 |
my $rules = GetMarcPermissionsRules() |
4528 |
|
4529 |
Returns: |
4530 |
|
4531 |
=over 4 |
4532 |
|
4533 |
=item C<$rules> |
4534 |
|
4535 |
array (in list context, arrayref otherwise) of hashrefs from marc_permissions |
4536 |
table in order of module specificity and rule id. |
4537 |
|
4538 |
=back |
4539 |
|
4540 |
=cut |
4541 |
|
4542 |
sub GetMarcPermissionsRules { |
4543 |
my $dbh = C4::Context->dbh; |
4544 |
my @rules = (); |
4545 |
|
4546 |
my $query = ' |
4547 |
SELECT `marc_permissions`.`id`, |
4548 |
`marc_permissions`.`tagfield`, |
4549 |
`marc_permissions`.`tagsubfield`, |
4550 |
`marc_permissions`.`filter`, |
4551 |
`marc_permissions`.`on_existing`, |
4552 |
`marc_permissions`.`on_new`, |
4553 |
`marc_permissions`.`on_removed`, |
4554 |
`marc_permissions_modules`.`name` as `module`, |
4555 |
`marc_permissions_modules`.`description`, |
4556 |
`marc_permissions_modules`.`specificity` |
4557 |
FROM `marc_permissions` |
4558 |
LEFT JOIN `marc_permissions_modules` ON `module` = `marc_permissions_modules`.`id` |
4559 |
ORDER BY `marc_permissions_modules`.`specificity`, `id` |
4560 |
'; |
4561 |
my $sth = $dbh->prepare($query); |
4562 |
$sth->execute(); |
4563 |
while ( my $row = $sth->fetchrow_hashref ) { |
4564 |
push(@rules, $row); |
4565 |
} |
4566 |
|
4567 |
return wantarray ? @rules : \@rules; |
4568 |
} |
4569 |
|
4570 |
=head2 GetMarcPermissionsModules |
4571 |
|
4572 |
my $modules = GetMarcPermissionsModules() |
4573 |
|
4574 |
Returns: |
4575 |
|
4576 |
=over 4 |
4577 |
|
4578 |
=item C<$modules> |
4579 |
|
4580 |
array (in list context, arrayref otherwise) of hashrefs from |
4581 |
marc_permissions_modules table in order of specificity. |
4582 |
|
4583 |
=back |
4584 |
|
4585 |
=cut |
4586 |
|
4587 |
sub GetMarcPermissionsModules { |
4588 |
my $dbh = C4::Context->dbh; |
4589 |
my @modules = (); |
4590 |
|
4591 |
my $query = ' |
4592 |
SELECT * |
4593 |
FROM `marc_permissions_modules` |
4594 |
ORDER BY `specificity` |
4595 |
'; |
4596 |
my $sth = $dbh->prepare($query); |
4597 |
$sth->execute(); |
4598 |
while ( my $row = $sth->fetchrow_hashref ) { |
4599 |
push(@modules, $row); |
4600 |
} |
4601 |
|
4602 |
return wantarray ? @modules : \@modules; |
4603 |
} |
4604 |
|
4605 |
=head2 ModMarcPermissionsRule |
4606 |
|
4607 |
my $success = ModMarcPermissionsRule($id, $fields) |
4608 |
|
4609 |
Modifies rule in the marc_permissions table. |
4610 |
|
4611 |
=over 4 |
4612 |
|
4613 |
=item C<$id> |
4614 |
|
4615 |
rule id to modify |
4616 |
|
4617 |
=item C<$fields> |
4618 |
|
4619 |
hashref defining the table fields |
4620 |
|
4621 |
* tagfield - required |
4622 |
* tagsubfield |
4623 |
* module - required |
4624 |
* filter - required |
4625 |
* on_existing - required |
4626 |
* on_new - required |
4627 |
* on_removed - required |
4628 |
|
4629 |
=back |
4630 |
|
4631 |
Returns: |
4632 |
|
4633 |
=over 4 |
4634 |
|
4635 |
=item C<$success> |
4636 |
|
4637 |
undef if an error occurs, otherwise true. |
4638 |
|
4639 |
=back |
4640 |
|
4641 |
=cut |
4642 |
|
4643 |
sub ModMarcPermissionsRule { |
4644 |
my ($id, $f) = @_; |
4645 |
my $dbh = C4::Context->dbh; |
4646 |
my $query = ' |
4647 |
UPDATE `marc_permissions` |
4648 |
SET |
4649 |
tagfield = ?, |
4650 |
tagsubfield = ?, |
4651 |
module = ?, |
4652 |
filter = ?, |
4653 |
on_existing = ?, |
4654 |
on_new = ?, |
4655 |
on_removed = ? |
4656 |
WHERE |
4657 |
id = ? |
4658 |
'; |
4659 |
my $sth = $dbh->prepare($query); |
4660 |
return $sth->execute ( |
4661 |
$f->{tagfield}, |
4662 |
$f->{tagsubfield}, |
4663 |
$f->{module}, |
4664 |
$f->{filter}, |
4665 |
$f->{on_existing}, |
4666 |
$f->{on_new}, |
4667 |
$f->{on_removed}, |
4668 |
$id |
4669 |
); |
4670 |
} |
4671 |
|
4672 |
=head2 AddMarcPermissionsRule |
4673 |
|
4674 |
my $success = AddMarcPermissionsRule($fields) |
4675 |
|
4676 |
Add rule to the marc_permissions table. |
4677 |
|
4678 |
=over 4 |
4679 |
|
4680 |
=item C<$fields> |
4681 |
|
4682 |
hashref defining the table fields |
4683 |
|
4684 |
tagfield - required |
4685 |
tagsubfield |
4686 |
module - required |
4687 |
filter - required |
4688 |
on_existing - required |
4689 |
on_new - required |
4690 |
on_removed - required |
4691 |
|
4692 |
=back |
4693 |
|
4694 |
Returns: |
4695 |
|
4696 |
=over 4 |
4697 |
|
4698 |
=item C<$success> |
4699 |
|
4700 |
undef if an error occurs, otherwise true. |
4701 |
|
4702 |
=back |
4703 |
|
4704 |
=cut |
4705 |
|
4706 |
sub AddMarcPermissionsRule { |
4707 |
my $f = shift; |
4708 |
my $dbh = C4::Context->dbh; |
4709 |
my $query = ' |
4710 |
INSERT INTO `marc_permissions` |
4711 |
( |
4712 |
tagfield, |
4713 |
tagsubfield, |
4714 |
module, |
4715 |
filter, |
4716 |
on_existing, |
4717 |
on_new, |
4718 |
on_removed |
4719 |
) |
4720 |
VALUES (?, ?, ?, ?, ?, ?, ?) |
4721 |
'; |
4722 |
my $sth = $dbh->prepare($query); |
4723 |
return $sth->execute ( |
4724 |
$f->{tagfield}, |
4725 |
$f->{tagsubfield}, |
4726 |
$f->{module}, |
4727 |
$f->{filter}, |
4728 |
$f->{on_existing}, |
4729 |
$f->{on_new}, |
4730 |
$f->{on_removed} |
4731 |
); |
4732 |
} |
4733 |
|
4734 |
=head2 DelMarcPermissionsRule |
4735 |
|
4736 |
my $success = DelMarcPermissionsRule($id) |
4737 |
|
4738 |
Deletes rule from the marc_permissions table. |
4739 |
|
4740 |
=over 4 |
4741 |
|
4742 |
=item C<$id> |
4743 |
|
4744 |
rule id to delete |
4745 |
|
4746 |
=back |
4747 |
|
4748 |
Returns: |
4749 |
|
4750 |
=over 4 |
4751 |
|
4752 |
=item C<$success> |
4753 |
|
4754 |
undef if an error occurs, otherwise true. |
4755 |
|
4756 |
=back |
4757 |
|
4758 |
=cut |
4759 |
|
4760 |
sub DelMarcPermissionsRule { |
4761 |
my $id = shift; |
4762 |
my $dbh = C4::Context->dbh; |
4763 |
my $query = ' |
4764 |
DELETE FROM `marc_permissions` |
4765 |
WHERE |
4766 |
id = ? |
4767 |
'; |
4768 |
my $sth = $dbh->prepare($query); |
4769 |
return $sth->execute($id); |
4770 |
} |
4771 |
|
3796 |
1; |
4772 |
1; |
3797 |
|
4773 |
|
3798 |
|
4774 |
|