|
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 |
|